#!/usr/bin/env perl
## infobash: Copyright (C) 2005-2007 Michiel de Boer aka locsmif
## inxi: Copyright (C) 2008-2020 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 File::stat; # needed for Xorg.0.log file mtime comparisons
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.1.01';
my $self_date='2020-05-31';
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.
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,%debugger,%dl,%files,%rows,%system_files);
## Arrays
# ps_aux is full output, ps_cmd is only the last 10 columns to last
my (@app,@dmesg_boot,@devices_audio,@devices_graphics,@devices_network,
@devices_hwraid,@devices_timer,@dmi,@gpudata,@ifs,@ifs_bsd,
@paths,@proc_partitions,@ps_aux,@ps_cmd,@ps_gui,
@sysctl,@sysctl_battery,@sysctl_sensors,@sysctl_machine,@uname,@usb);
## Disk arrays
my (@dm_boot_disk,@dm_boot_optical,@glabel,@gpart,@hardware_raid,@labels,
@lsblk,@partitions,@raid,@swaps,@sysctl_disks,@uuids);
my @test = (0,0,0,0,0);
## Booleans
my ($b_admin,$b_arm,$b_bb_ps,$b_block_tool,$b_console_irc,
$b_display,$b_dmesg_boot_check,$b_dmi,$b_dmidecode_force,
$b_fake_bsd,$b_fake_dboot,$b_fake_dmidecode,$b_fake_pciconf,$b_fake_sysctl,
$b_fake_usbdevs,$b_force_display,$b_gpudata,$b_irc,
$b_log,$b_log_colors,$b_log_full,$b_man,$b_mem,$b_mips,$b_no_sudo,
$b_pci,$b_pci_tool,$b_ppc,$b_proc_partitions,$b_ps_gui,
$b_root,$b_running_in_display,$b_skip_dig,
$b_slot_tool,$b_soc_audio,$b_soc_gfx,$b_soc_net,$b_soc_timer,$b_sparc,
$b_sudo,$b_swaps,$b_sysctl,$b_usb,$b_usb_check,$b_usb_sys,$b_usb_tool,
$b_wmctrl);
## Disk checks
my ($b_dm_boot_disk,$b_dm_boot_optical,$b_glabel,$b_hardware_raid,
$b_label_uuid,$b_lsblk,$b_partitions,$b_raid,$b_smartctl);
# initialize basic use features
my %use = (
'sysctl_disk' => 1, # unused currently
'update' => 1, # switched off/on with maintainer config ALLOW_UPDATE
'weather' => 1, # switched off/on with maintainer config ALLOW_WEATHER
);
## System
my ($bsd_type,$device_vm,$language,$os,$pci_tool,$wan_url) = ('','','','','','');
my ($bits_sys,$cpu_arch);
my ($cpu_sleep,$dl_timeout,$limit,$ps_cols,$ps_count) = (0.35,4,10,0,5);
my $sensors_cpu_nu = 0;
my ($dl_ua,$weather_source,$weather_unit) = ('s-tools/' . $self_name . '-',100,'mi');
## 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;
#$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
$debugger{'sys'} = 1;
$client{'test-konvi'} = 0;
########################################################################
#### STARTUP
########################################################################
#### -------------------------------------------------------------------
#### MAIN
#### -------------------------------------------------------------------
sub main {
# print Dumper \@ARGV;
eval $start if $b_log;
initialize();
## Uncomment these two values for start client debugging
# $debug = 10; # 3 prints timers
# set_debugger(); # for debugging of konvi and other start client issues
## legacy method
#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')) {
@data = grabber("$program -t chassis -t baseboard -t processor 2>&1");
if (scalar @data < 15){
if ($b_root) {
foreach (@data){
if ($_ =~ /No SMBIOS/i){
$action = 'smbios';
last;
}
elsif ($_ =~ /^\/dev\/mem: Operation/i){
$action = 'no-data';
last;
}
else {
$action = 'unknown-error';
last;
}
}
}
else {
if (grep { $_ =~ /^\/dev\/mem: Permission/i } @data){
$action = 'permissions';
}
else {
$action = 'unknown-error';
}
}
}
}
else {
$action = 'missing';
}
%hash = (
'dmidecode' => {
'action' => $action,
'missing' => 'Required program dmidecode not available',
'permissions' => 'Unable to run dmidecode. Root privileges required.',
'smbios' => 'No SMBIOS data for dmidecode to process',
'no-data' => 'dmidecode is not allowed to read /dev/mem',
'unknown-error' => 'dmidecode was unable to generate data',
},
);
%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','pcictl' => 'list', 'pcidump' => '');
%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";
$pci_tool = $_ if $_ =~ /pci/;
$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 ( $b_usb ){
%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);
}
# can't check permissions since we need to know the partition/disc
if ($b_block_tool){
%hash = (
'blockdev' => 'linux',
'lsblk' => 'linux',
);
%commands = (%commands,%hash);
}
if ($b_smartctl){
%hash = (
'smartctl' => '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 !$b_no_sudo && is_numeric($version) && $version >= 1.7;
}
set_fake_tools() if $b_fake_bsd;
}
# 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!!!
# some versions of busybox do not have tty, like openwrt
$b_irc = ( check_program('tty') && system('tty >/dev/null') ) ? 1 : 0;
# print "birc: $b_irc\n";
$b_display = ( $ENV{'DISPLAY'} ) ? 1 : 0;
$b_root = $< == 0; # root UID 0, all others > 0
$dl{'dl'} = 'curl';
$dl{'curl'} = 1;
$dl{'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;
$show{'partition-sort'} = 'id'; # sort order for partitions
}
# args: $1 - default OR override default cols max integer count. $_[0]
# is the display width override.
sub set_display_width {
my ($width) = @_;
if ( $width eq 'live' ){
## sometimes tput will trigger an error (mageia) if irc client
if ( ! $b_irc ){
if ( check_program('tput') ) {
# trips error if use qx()...
chomp($size{'term'}=qx{tput cols});
chomp($size{'term-lines'}=qx{tput lines});
$size{'term-cols'} = $size{'term'};
}
# print "tc: $size{'term'} cmc: $size{'console'}\n";
# double check, just in case it's missing functionality or whatever
if ( $size{'term'} == 0 || !is_int($size{'term'}) ){
$size{'term'}=80;
# we'll be using this for terminal dimensions later so don't set default.
# $size{'term-lines'}=100;
}
}
# this lets you set different size for in or out of display server
if ( ! $b_running_in_display && $size{'no-display'} ){
$size{'console'}=$size{'no-display'};
}
# term_cols is set in top globals, using tput cols
# print "tc: $size{'term'} cmc: $size{'console'}\n";
if ( $size{'term'} < $size{'console'} ){
$size{'console'}=$size{'term'};
}
# adjust, some terminals will wrap if output cols == term cols
$size{'console'}=( $size{'console'} - 2 );
# echo cmc: $size{'console'}
# comes after source for user set stuff
if ( ! $b_irc ){
$size{'max'}=$size{'console'};
}
else {
$size{'max'}=$size{'irc'};
}
}
else {
$size{'max'}=$width;
}
# print "tc: $size{'term'} cmc: $size{'console'} cm: $size{'max'}\n";
}
# only for dev/debugging BSD
sub set_fake_tools {
$system_files{'dmesg-boot'} = '/var/run/dmesg.boot' if $b_fake_dboot;
$alerts{'pciconf'} = ({'action' => 'use'}) if $b_fake_pciconf;
$alerts{'sysctl'} = ({'action' => 'use'}) if $b_fake_sysctl;
if ($b_fake_usbdevs ){
$alerts{'usbdevs'} = ({'action' => 'use'});
$alerts{'lsusb'} = ({
'action' => 'missing',
'missing' => 'Required program lsusb not available',
});
}
}
# NOTE: most tests internally are against !$bsd_type
sub set_os {
@uname = uname();
$os = lc($uname[0]);
$cpu_arch = lc($uname[-1]);
if ($cpu_arch =~ /arm|aarch/){$b_arm = 1}
elsif ($cpu_arch =~ /mips/) {$b_mips = 1}
elsif ($cpu_arch =~ /power|ppc/) {$b_ppc = 1}
elsif ($cpu_arch =~ /sparc/) {$b_sparc = 1}
# aarch32 mips32 intel/amd handled in cpu
if ($cpu_arch =~ /(armv[1-7]|32|sparc_v9)/){
$bits_sys = 32;
}
elsif ($cpu_arch =~ /(alpha|64|e2k)/){
$bits_sys = 64;
}
if ( $os =~ /(aix|bsd|cosix|dragonfly|darwin|hp-?ux|indiana|irix|sunos|solaris|ultrix|unix)/ ){
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);
# NOTE: recent Xorg's show error if you try /usr/bin/Xorg -version but work
# if you use the /usr/lib/xorg-server/Xorg path.
@paths = qw(/sbin /bin /usr/sbin /usr/bin /usr/local/sbin /usr/local/bin);
@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/[^\/]+$//;
# print "0: $0 sp: $self_path\n";
if ( defined $ENV{'XDG_CONFIG_HOME'} && $ENV{'XDG_CONFIG_HOME'} ){
$user_config_dir=$ENV{'XDG_CONFIG_HOME'};
$b_conf=1;
}
elsif ( -d "$ENV{'HOME'}/.config" ){
$user_config_dir="$ENV{'HOME'}/.config";
$b_conf=1;
}
else {
$user_config_dir="$ENV{'HOME'}/.$self_name";
}
if ( defined $ENV{'XDG_DATA_HOME'} && $ENV{'XDG_DATA_HOME'} ){
$user_data_dir="$ENV{'XDG_DATA_HOME'}/$self_name";
$b_data=1;
}
elsif ( -d "$ENV{'HOME'}/.local/share" ){
$user_data_dir="$ENV{'HOME'}/.local/share/$self_name";
$b_data=1;
}
else {
$user_data_dir="$ENV{'HOME'}/.$self_name";
}
# note, this used to be created/checked in specific instance, but we'll just do it
# universally so it's done at script start.
if ( ! -d $user_data_dir ){
mkdir $user_data_dir;
# system "echo", "Made: $user_data_dir";
}
if ( $b_conf && -f "$ENV{'HOME'}/.$self_name/$self_name.conf" ){
#system 'mv', "-f $ENV{'HOME'}/.$self_name/$self_name.conf", $user_config_dir;
# print "WOULD: Moved $self_name.conf from $ENV{'HOME'}/.$self_name to $user_config_dir\n";
}
if ( $b_data && -d "$ENV{'HOME'}/.$self_name" ){
#system 'mv', '-f', "$ENV{'HOME'}/.$self_name/*", $user_data_dir;
#system 'rm', '-Rf', "$ENV{'HOME'}/.$self_name";
# print "WOULD: Moved data dir $ENV{'HOME'}/.$self_name to $user_data_dir\n";
}
$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',
'cmdline' => '/proc/cmdline',
'cpuinfo' => '/proc/cpuinfo',
'dmesg-boot' => '/var/run/dmesg.boot',
'lsb-release' => '/etc/lsb-release',
'mdstat' => '/proc/mdstat',
'meminfo' => '/proc/meminfo',
'modules' => '/proc/modules',
'mounts' => '/proc/mounts',
'os-release' => '/etc/os-release',
'partitions' => '/proc/partitions',
'scsi' => '/proc/scsi/scsi',
'version' => '/proc/version',
# note: 'xorg-log' is set only if -G is triggered
);
foreach ( keys %files ){
$system_files{$_} = ( -e $files{$_} ) ? $files{$_} : '';
}
}
else {
return $system_files{$file};
}
}
sub set_xorg_log {
eval $start if $b_log;
my (@temp,@x_logs);
my ($file_holder,$time_holder,$x_mtime) = ('',0,0);
# NOTE: other variations may be /var/run/gdm3/... but not confirmed
# we are just going to get all the Xorg logs we can find, and not worry about
# which is 'right'.
@temp = globber('/var/log/Xorg.*.log');
push @x_logs, @temp if @temp;
@temp = globber('/var/lib/gdm/.local/share/xorg/Xorg.*.log');
push @x_logs, @temp if @temp;
@temp = globber($ENV{'HOME'} . '/.local/share/xorg/Xorg.*.log',);
push @x_logs, @temp if @temp;
# root will not have a /root/.local/share/xorg directory so need to use a
# user one if we can find one.
if ($b_root){
@temp = globber('/home/*/.local/share/xorg/Xorg.*.log');
push @x_logs, @temp if @temp;
}
foreach (@x_logs){
if (-r $_){
my $src_info = File::stat::stat("$_");
#print "$_\n";
if ($src_info){
$x_mtime = $src_info->mtime;
# print $_ . ": $x_time" . "\n";
if ($x_mtime > $time_holder ){
$time_holder = $x_mtime;
$file_holder = $_;
}
}
}
}
if ( !$file_holder && check_program('xset') ){
my $data = qx(xset q 2>/dev/null);
foreach ( split /\n/, $data){
if ($_ =~ /Log file/i){
$file_holder = get_piece($_,3);
last;
}
}
}
print "Xorg log file: $file_holder\nLast modified: $time_holder\n" if $test[14];
log_data('data',"Xorg log file: $file_holder") if $b_log;
$system_files{'xorg-log'} = $file_holder;
eval $end if $b_log;
}
########################################################################
#### UTILITIES
########################################################################
#### -------------------------------------------------------------------
#### COLORS
#### -------------------------------------------------------------------
## 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 (!main::is_int($response) || $response > ($count + 3) ){
@data = (
[0, '', '', "Error - Invalid Selection. You entered this: $response. Hit <ENTER> to continue."],
[0, '', '', "$line1"],
);
main::print_basic(@data);
my $response = <STDIN>;
start_selector();
create_color_selections();
get_selection();
}
else {
process_selection($response);
}
}
sub process_selection {
my $response = shift;
if ($response == ($count + 3) ){
@data = ([0, '', '', "Ok, exiting $self_name now. You can set the colors later."],);
main::print_basic(@data);
exit 0;
}
elsif ($response == ($count + 2)){
@data = (
[0, '', '', "Ok, continuing $self_name unchanged."],
[0, '', '', "$line1"],
);
main::print_basic(@data);
if ( defined $colors{'console'} && !$b_display ){
main::set_color_scheme($colors{'console'});
}
if ( defined $colors{'virt-term'} ){
main::set_color_scheme($colors{'virt-term'});
}
else {
main::set_color_scheme($colors{'default'});
}
}
elsif ($response == ($count + 1)){
@data = (
[0, '', '', "Removing all color settings from config file now..."],
[0, '', '', "$line1"],
);
main::print_basic(@data);
delete_all_config_colors();
main::set_color_scheme($colors{'default'});
}
else {
main::set_color_scheme($response);
@data = (
[0, '', '', "Updating config file for $configs{'selection'} color scheme now..."],
[0, '', '', "$line1"],
);
main::print_basic(@data);
if ($configs{'selection'} eq 'global'){
delete_all_colors();
}
else {
delete_global_color();
}
set_config_color_scheme($response);
}
}
sub delete_all_colors {
my @file_lines = main::reader( $user_config_file );
open( $w_fh, '>', $user_config_file ) or error_handler('open', $user_config_file, $!);
foreach ( @file_lines ) {
if ( $_ !~ /^(CONSOLE_COLOR_SCHEME|GLOBAL_COLOR_SCHEME|IRC_COLOR_SCHEME|IRC_CONS_COLOR_SCHEME|IRC_X_TERM_COLOR_SCHEME|VIRT_TERM_COLOR_SCHEME)/){
print {$w_fh} "$_";
}
}
close $w_fh;
}
sub delete_global_color {
my @file_lines = main::reader( $user_config_file );
open( $w_fh, '>', $user_config_file ) or error_handler('open', $user_config_file, $!);
foreach ( @file_lines ) {
if ( $_ !~ /^GLOBAL_COLOR_SCHEME/){
print {$w_fh} "$_";
}
}
close $w_fh;
}
sub set_config_color_scheme {
my $value = shift;
my @file_lines = main::reader( $user_config_file );
my $b_found = 0;
open( $w_fh, '>', $user_config_file ) or error_handler('open', $user_config_file, $!);
foreach ( @file_lines ) {
if ( $_ =~ /^$configs{'variable'}/ ){
$_ = "$configs{'variable'}=$value";
$b_found = 1;
}
print $w_fh "$_\n";
}
if (! $b_found ){
print $w_fh "$configs{'variable'}=$value\n";
}
close $w_fh;
}
sub print_irc_message {
@data = (
[ 0, '', '', "$line1"],
[ 0, '', '', "After finding the scheme number you like, simply run this again
in a terminal to set the configuration data file for your irc client. You can
set color schemes for the following: start inxi with -c plus:"],
[ 0, '', '', "94 (console,^not^in^desktop^-^$status{'console'})"],
[ 0, '', '', "95 (terminal, desktop^-^$status{'virt-term'})"],
[ 0, '', '', "96 (irc,^gui,^desktop^-^$status{'irc-gui'})"],
[ 0, '', '', "97 (irc,^desktop,^in terminal^-^$status{'irc-virt-term'})"],
[ 0, '', '', "98 (irc,^not^in^desktop^-^$status{'irc-console'})"],
[ 0, '', '', "99 (global^-^$status{'global'})"]
);
main::print_basic(@data);
exit 0;
}
}
#### -------------------------------------------------------------------
#### CONFIGS
#### -------------------------------------------------------------------
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/i; # switch to 1/0 perl boolean
s/false/0/i; # switch to 1/0 perl boolean
next unless length;
($key, $val) = split(/\s*=\s*/, $_, 2);
next unless length($val);
get_config_item($key,$val);
# print "f: $file key: $key val: $val\n";
}
close $fh;
}
}
# note: someone managed to make a config file with corrupted values, so check int
# explicitly, don't assume it was done correctly.
# args: 0: key; 1: value
sub get_config_item {
my ($key,$val) = @_;
if ($key eq 'ALLOW_UPDATE' || $key eq 'B_ALLOW_UPDATE') {$use{'update'} = $val if is_int($val)}
elsif ($key eq 'ALLOW_WEATHER' || $key eq 'B_ALLOW_WEATHER') {$use{'weather'} = $val if is_int($val)}
elsif ($key eq 'CPU_SLEEP') {$cpu_sleep = $val if is_numeric($val)}
elsif ($key eq 'DL_TIMEOUT') {$dl_timeout = $val if is_int($val)}
elsif ($key eq 'DOWNLOADER') {
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 = $val if is_int($val)}
elsif ($key eq 'OUTPUT_TYPE') {$output_type = $val if $val =~ /^(json|screen|xml)$/}
elsif ($key eq 'NO_DIG') {$b_skip_dig = $val if is_int($val)}
elsif ($key eq 'NO_SUDO') {$b_no_sudo = $val if is_int($val)}
elsif ($key eq 'PARTITION_SORT') {$show{'partition-sort'} = $val if ($val =~ /^(dev-base|fs|id|label|percent-used|size|uuid|used)$/) }
elsif ($key eq 'PS_COUNT') {$ps_count = $val if is_int($val) }
elsif ($key eq 'SENSORS_CPU_NO') {$sensors_cpu_nu = $val if is_int($val)}
elsif ($key eq 'SHOW_HOST' || $key eq 'B_SHOW_HOST') {
if (is_int($val)){
$show{'host'} = $val;
$show{'no-host'} = 1 if !$show{'host'};
}
}
elsif ($key eq 'USB_SYS') {$b_usb_sys = $val if is_int($val)}
elsif ($key eq 'WAN_IP_URL') {
if ($val =~ /^(ht|f)tp[s]?:\//i){
$wan_url = $val;
$b_skip_dig = 1;
}
}
elsif ($key eq 'WEATHER_SOURCE') {$weather_source = $val if is_int($val)}
elsif ($key eq 'WEATHER_UNIT') {
$val = lc($val) if $val;
if ($val && $val =~ /^(c|f|cf|fc|i|m|im|mi)$/){
my %units = ('c'=>'m','f'=>'i','cf'=>'mi','fc'=>'im');
$val = $units{$val} if defined $units{$val};
$weather_unit = $val;
}
}
# layout
elsif ($key eq 'CONSOLE_COLOR_SCHEME') {$colors{'console'} = $val if is_int($val)}
elsif ($key eq 'GLOBAL_COLOR_SCHEME') {$colors{'global'} = $val if is_int($val)}
elsif ($key eq 'IRC_COLOR_SCHEME') {$colors{'irc-gui'} = $val if is_int($val)}
elsif ($key eq 'IRC_CONS_COLOR_SCHEME') {$colors{'irc-console'} = $val if is_int($val)}
elsif ($key eq 'IRC_X_TERM_COLOR_SCHEME') {$colors{'irc-virt-term'} = $val if is_int($val)}
elsif ($key eq 'VIRT_TERM_COLOR_SCHEME') {$colors{'virt-term'} = $val if is_int($val)}
# note: not using the old short SEP1/SEP2
elsif ($key eq 'SEP1_IRC') {$sep{'s1-irc'} = $val}
elsif ($key eq 'SEP1_CONSOLE') {$sep{'s1-console'} = $val}
elsif ($key eq 'SEP2_IRC') {$sep{'s2-irc'} = $val}
elsif ($key eq 'SEP2_CONSOLE') {$sep{'s2-console'} = $val}
# size
elsif ($key eq 'COLS_MAX_CONSOLE') {$size{'console'} = $val if is_int($val)}
elsif ($key eq 'COLS_MAX_IRC') {$size{'irc'} = $val if is_int($val)}
elsif ($key eq 'COLS_MAX_NO_DISPLAY') {$size{'no-display'} = $val if is_int($val)}
elsif ($key eq 'INDENT') {$size{'indent'} = $val if is_int($val)}
elsif ($key eq 'INDENT_MIN') {$size{'indent-min'} = $val if is_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;
return if $debugger{'timers'};
# do the rotation if logfile exists
if ( -f $log_file ){
# copy if present second to third
if ( -f $log_file_2 ){
rename $log_file_2, $log_file_3 or error_handler('rename', "$log_file_2 -> $log_file_3", "$!");
}
# then copy initial to second
rename $log_file, $log_file_2 or error_handler('rename', "$log_file -> $log_file_2", "$!");
}
# now create the logfile
# print "Opening log file for reading: $log_file\n";
open $fh_l, '>', $log_file or error_handler(4, $log_file, "$!");
# and echo the start data
$data = $line2;
$data .= "START $self_name LOGGING:\n";
$data .= "NOTE: HiRes timer not available.\n" if !$b_hires;
$data .= "$now\n";
$data .= "Elapsed since start: $t3\n";
$data .= "n: $self_name v: $self_version p: $self_patch d: $self_date\n";
$data .= '@paths:' . joiner(\@paths, '::', 'unset') . "\n";
$data .= $line2;
print $fh_l $data;
}
# NOTE: no logging available until get_parameters is run, since that's what
# sets logging # in order to trigger earlier logging manually set $b_log
# to true in top variables.
# args: $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,$data,$timer) = ('','','');
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='';
$timer = $data if $debugger{'timers'};
}
elsif ( $one eq 'fe') {
# print 'timer:', Time::HiRes::tv_interval(\@t0, [Time::HiRes::gettimeofday()]),"\n";
#$t3 = tv_interval ($t0, [gettimeofday]);
eval '$t3 = Time::HiRes::tv_interval(\@t0, [Time::HiRes::gettimeofday()])' if $b_hires;
#print Dumper $t3;
$data = "${spacer}Elapsed: $t3\nEnd: Function: $two\n";
$spacer='';
$timer = $data if $debugger{'timers'};
}
elsif ( $one eq 'cat') {
if ( $b_log_full ){
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";
}
if ($debugger{'timers'}){
print $timer if $timer;
}
#print "d: $data";
elsif ($data){
print $fh_l "$spacer$data";
}
}
sub set_debugger {
user_debug_test_1() if $debugger{'test-1'};
if ( $debug >= 20){
error_handler('not-in-irc', 'debug data generator') if $b_irc;
my $option = ( $debug > 22 ) ? 'main-full' : 'main';
$debugger{'gz'} = 1 if ($debug == 22 || $debug == 24);
my $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();
}
elsif ($debug <= 3){
if ($debug == 3){
$b_log = 1;
$debugger{'timers'} = 1;
begin_logging();
}
else {
$end = '';
$start = '';
}
}
}
## 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 ($data_dir,$debug_dir,$debug_gz,$parse_src,$upload) = ('','','','','');
my @content = ();
my $b_debug = 0;
my $b_delete_dir = 1;
# args: 1 - type
# args: 2 - upload
sub new {
my $class = shift;
($option) = @_;
my $self = {};
# print "$f\n";
# print "$option\n";
return bless $self, $class;
}
sub run_debugger {
#require File::Find;
#import File::Find::Functions;
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){
# note: android has unreadable /sys, but -x and -r tests pass
# main::globber('/sys/*') &&
if ( main::count_dir_files('/sys') ){
build_tree('sys');
# kernel crash, not sure what creates it, for ppc, as root
sys_traverse_data() if ($debugger{'sys'} && ($debugger{'sys-force'} || !$b_root || !$b_ppc )) ;
}
else {
print "Skipping /sys data collection. /sys not present, or empty.\n";
}
print $line3;
# note: proc has some files that are apparently kernel processes, I've tried
# filtering them out but more keep appearing, so only run proc debugger if not root
if ( !$debugger{'no-proc'} && (!$b_root || $debugger{'proc'} ) && -d '/proc' && main::count_dir_files('/proc') ){
build_tree('proc');
proc_traverse_data();
}
else {
print "Skipping /proc data collection.\n";
}
print $line3;
}
run_self();
print $line3;
compress_dir();
}
sub create_debug_directory {
my $host = main::get_hostname();
$host =~ s/ /-/g;
$host = 'no-host' if !$host || $host eq 'N/A';
my ($alt_string,$bsd_string,$root_string) = ('','','');
# note: Time::Piece was introduced in perl 5.9.5
my ($sec,$min,$hour,$mday,$mon,$year) = localtime;
$year = $year+1900;
$mon += 1;
if (length($sec) == 1) {$sec = "0$sec";}
if (length($min) == 1) {$min = "0$min";}
if (length($hour) == 1) {$hour = "0$hour";}
if (length($mon) == 1) {$mon = "0$mon";}
if (length($mday) == 1) {$mday = "0$mday";}
my $today = "$year-$mon-${mday}_$hour$min$sec";
# my $date = strftime "-%Y-%m-%d_", localtime;
if ($b_root){
$root_string = '-root';
}
$bsd_string = "-BSD-$bsd_type" if $bsd_type;
if ($b_arm ){$alt_string = '-ARM'}
elsif ($b_mips) {$alt_string = '-MIPS'}
elsif ($b_ppc) {$alt_string = '-PPC'}
elsif ($b_sparc) {$alt_string = '-SPARC'}
$debug_dir = "$self_name$alt_string$bsd_string-$host-$today$root_string-$self_version";
$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 = (
['blockdev', '--report'],
['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', '-k -T -P -a'],
['df', '-P'],
['findmnt', ''],
['findmnt', '--df --no-truncate'],
['findmnt', '--list --no-truncate'],
['lsblk', '-fs'],
['lsblk', '-fsr'],
['lsblk', '-fsP'],
['lsblk', '-a'],
['lsblk', '-aP'],
['lsblk', '-ar'],
['lsblk', '-p'],
['lsblk', '-pr'],
['lsblk', '-pP'],
['lsblk', '-r'],
['lsblk', '-r --output NAME,PKNAME,TYPE,RM,FSTYPE,SIZE,LABEL,UUID,MOUNTPOINT,PHY-SEC,LOG-SEC'],
['lsblk', '-rb --output NAME,PKNAME,TYPE,RM,FSTYPE,SIZE,LABEL,UUID,MOUNTPOINT,PHY-SEC,LOG-SEC'],
['lsblk', '-Pb --output NAME,PKNAME,TYPE,RM,FSTYPE,SIZE'],
['lsblk', '-Pb --output NAME,TYPE,RM,FSTYPE,SIZE,LABEL,UUID,SERIAL,MOUNTPOINT,PHY-SEC,LOG-SEC'],
['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'],
# LSI raid https://hwraid.le-vert.net/wiki/LSIMegaRAIDSAS
['megacli', '-AdpAllInfo -aAll'],
['megacli', '-LDInfo -L0 -a0'],
['megacli', '-PDList -a0'],
['megaclisas-status', ''],
['megaraidsas-status', ''],
['megasasctl', ''],
['mount', ''],
['nvme', 'present'],
['readlink', '/dev/root'],
['swapon', '-s'],
# 3ware-raid
['tw-cli', 'info'],
['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');
}
# keep this updated to handle all possible locations we know about for Xorg.0.log
# not using $system_files{'xorg-log'} for now though it would be best to know what file is used
main::set_xorg_log();
push (@files, '/var/log/Xorg.0.log');
push (@files, '/var/lib/gdm/.local/share/xorg/Xorg.0.log');
push (@files, $ENV{'HOME'} . '/.local/share/xorg/Xorg.0.log');
push (@files, $system_files{'xorg-log'}) if $system_files{'xorg-log'};
push (@files, '/etc/X11/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'},
'kde-full-session' => $ENV{'KDE_FULL_SESSION'},
'kde-session-version' => $ENV{'KDE_SESSION_VERSION'},
'vdpau-driver' => $ENV{'VDPAU_DRIVER'},
'xdg-current-desktop' => $ENV{'XDG_CURRENT_DESKTOP'},
'xdg-session-desktop' => $ENV{'XDG_SESSION_DESKTOP'},
'xdg-vtnr' => $ENV{'XDG_VTNR'},
# wayland data collectors:
'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'],
# ['locate','/Xorg'], # for Xorg.wrap problem
['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'],
['vainfo',''],
['vdpauinfo',''],
['vulkaninfo',''],
['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'],
# only for prospective ram feature data collection: requires i2c-tools and module eeprom loaded
['decode-dimms',''],
['dmidecode',''],
['dmesg',''],
['gcc','--version'],
['hciconfig','-a'],
['initctl','list'],
['ipmi-sensors',''],
['ipmi-sensors','--output-sensor-thresholds'],
['ipmitool','sensor'],
['lscpu',''],
['lspci',''],
['lspci','-k'],
['lspci','-n'],
['lspci','-nn'],
['lspci','-nnk'],
['lspci','-nnkv'],# returns ports
['lspci','-nnv'],
['lspci','-mm'],
['lspci','-mmk'],
['lspci','-mmkv'],
['lspci','-mmv'],
['lspci','-mmnn'],
['lspci','-v'],
['lsusb',''],
['lsusb','-t'],
['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',''],
['upower','-e'],
['uptime',''],
['vcgencmd','get_mem arm'],
['vcgencmd','get_mem gpu'],
);
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,issue}*');
push (@files, '/etc/issue');
push (@files, '/etc/lsb-release');
push (@files, '/etc/os-release');
copy_files(\@files,'system-distro');
@files = main::globber('/etc/upstream[-_]{[rR]elease,[vV]ersion}/*');
copy_files(\@files,'system-distro');
@files = main::globber('/etc/calamares/branding/*/branding.desc');
copy_files(\@files,'system-distro');
@files = (
'/proc/1/comm',
'/proc/cmdline',
'/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');
@files = main::globber('/sys/devices/system/cpu/vulnerabilities/*');
copy_files(\@files,'security');
}
## SELF EXECUTE FOR LOG/OUTPUT
sub run_self {
print "Creating $self_name output file now. This can take a few seconds...\n";
print "Starting $self_name from: $self_path\n";
my $i = ($option eq 'main-full')? ' -i' : '';
my $z = ($debugger{'z'}) ? ' -z' : '';
my $iz = "$i$z";
$iz =~ s/[\s-]//g;
my $cmd = "$self_path/$self_name -FRfJrploudmaxxx$i$z --slots --debug 10 -y 120 > $data_dir/$self_name-FRfJrploudmaxxx$iz-slots-y120.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");
}
## UTILITIES COPY/CMD/WRITE
sub copy_files {
my ($files_ref,$type,$alt_dir) = @_;
my ($absent,$error,$good,$name,$unreadable);
my $directory = ($alt_dir) ? $alt_dir : $data_dir;
my $working = ($type ne 'proc') ? "$type-file-": '';
foreach (@$files_ref) {
$name = $_;
$name =~ s/^\///;
$name =~ s/\//~/g;
# print "$name\n" if $type eq 'proc';
$name = "$directory/$working$name";
$good = $name . '.txt';
$absent = $name . '-absent';
$error = $name . '-error';
$unreadable = $name . '-unreadable';
# proc have already been tested for readable/exists
if ($type eq 'proc' || -e $_ ) {
print "F:$_\n" if $type eq 'proc' && $debugger{'proc-print'};
if ($type eq 'proc' || -r $_){
copy($_,"$good") or main::toucher($error);
}
else {
main::toucher($unreadable);
}
}
else {
main::toucher($absent);
}
}
}
sub run_commands {
my ($cmds,$type) = @_;
my $holder = '';
my ($name,$cmd,$args);
foreach (@$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);
}
}
}
## TOOLS FOR DIRECTORY TREE/LS/TRAVERSE; UPLOADER
sub build_tree {
my ($which) = @_;
if ( $which eq 'sys' && main::check_program('tree') ){
print "Constructing /$which tree data...\n";
my $dirname = '/sys';
my $cmd;
system("tree -a -L 10 /sys > $data_dir/sys-data-tree-full-10.txt");
opendir my($dh), $dirname or main::error_handler('open-dir',"$dirname", "$!");
my @files = readdir $dh;
closedir $dh;
foreach (@files){
next if /^\./;
$cmd = "tree -a -L 10 $dirname/$_ > $data_dir/sys-data-tree-$_-10.txt";
#print "$cmd\n";
system($cmd);
}
}
print "Constructing /$which ls data...\n";
if ($which eq 'sys'){
directory_ls($which,1);
directory_ls($which,2);
directory_ls($which,3);
directory_ls($which,4);
}
elsif ($which eq 'proc') {
directory_ls('proc',1);
directory_ls('proc',2,'[a-z]');
# don't want the /proc/self or /proc/thread-self directories, those are
# too invasive
#directory_ls('proc',3,'[a-z]');
#directory_ls('proc',4,'[a-z]');
}
}
# include is basic regex for ls path syntax, like [a-z]
sub directory_ls {
my ( $dir,$depth,$include) = @_;
$include ||= '';
my ($exclude) = ('');
# wd do NOT want to see anything in self or thread-self!!
# $exclude = 'I self -I thread-self' if $dir eq 'proc';
my $cmd = do {
if ( $depth == 1 ){ "ls -l $exclude /$dir/$include 2>/dev/null" }
elsif ( $depth == 2 ){ "ls -l $exclude /$dir/$include*/ 2>/dev/null" }
elsif ( $depth == 3 ){ "ls -l $exclude /$dir/$include*/*/ 2>/dev/null" }
elsif ( $depth == 4 ){ "ls -l $exclude /$dir/$include*/*/*/ 2>/dev/null" }
elsif ( $depth == 5 ){ "ls -l $exclude /$dir/$include*/*/*/*/ 2>/dev/null" }
elsif ( $depth == 6 ){ "ls -l $exclude /$dir/$include*/*/*/*/*/ 2>/dev/null" }
};
my @working = ();
my $output = '';
my ($type);
my $result = qx($cmd);
open my $ch, '<', \$result or main::error_handler('open-data',"$cmd", "$!");
while ( my $line = <$ch> ){
chomp($line);
$line =~ s/^\s+|\s+$//g;
@working = split /\s+/, $line;
$working[0] ||= '';
if ( scalar @working > 7 ){
if ($working[0] =~ /^d/ ){
$type = "d - ";
}
elsif ($working[0] =~ /^l/){
$type = "l - ";
}
else {
$type = "f - ";
}
$working[9] ||= '';
$working[10] ||= '';
$output = $output . " $type$working[8] $working[9] $working[10]\n";
}
elsif ( $working[0] !~ /^total/ ){
$output = $output . $line . "\n";
}
}
close $ch;
my $file = "$data_dir/$dir-data-ls-$depth.txt";
open my $fh, '>', $file or main::error_handler('create',"$file", "$!");
print $fh $output;
close $fh;
# print "$output\n";
}
sub proc_traverse_data {
print "Building /proc file list...\n";
# get rid pointless error:Can't cd to (/sys/kernel/) debug: Permission denied
no warnings 'File::Find';
$parse_src = 'proc';
File::Find::find( \&wanted, "/proc");
proc_traverse_processor();
@content = ();
}
sub proc_traverse_processor {
my ($data,$fh,$result,$row,$sep);
my $proc_dir = "$data_dir/proc";
print "Adding /proc files...\n";
mkdir $proc_dir or main::error_handler('mkdir', "$proc_dir", "$!");
# @content = sort @content;
copy_files(\@content,'proc',$proc_dir);
# foreach (@content){
# print "$_\n";
# }
}
sub sys_traverse_data {
print "Building /sys file list...\n";
# get rid pointless error:Can't cd to (/sys/kernel/) debug: Permission denied
no warnings 'File::Find';
$parse_src = 'sys';
File::Find::find( \&wanted, "/sys");
sys_traverse_processsor();
@content = ();
}
sub sys_traverse_processsor {
my ($data,$fh,$result,$row,$sep);
my $filename = "sys-data-parse.txt";
print "Parsing /sys files...\n";
# no sorts, we want the order it comes in
# @content = sort @content;
foreach (@content){
$data='';
$sep='';
my $b_fh = 1;
print "F:$_\n" if $debugger{'sys-print'};
open($fh, '<', $_) or $b_fh = 0;
# needed for removing -T test and root
if ($b_fh){
while ($row = <$fh>) {
chomp $row;
$data .= $sep . '"' . $row . '"';
$sep=', ';
}
}
else {
$data = '<unreadable>';
}
$result .= "$_:[$data]\n";
# print "$_:[$data]\n"
}
# print scalar @content . "\n";
open ($fh, '>', "$data_dir/$filename");
print $fh $result;
close $fh;
# print $fh "$result";
}
sub wanted {
return if -d; # not directory
return unless -e; # Must exist
return unless -f; # Must be file
return unless -r; # Must be readable
if ($parse_src eq 'sys'){
# note: a new file in 4.11 /sys can hang this, it is /parameter/ then
# a few variables. Since inxi does not need to see that file, we will
# not use it. Also do not need . files or __ starting files
# print $File::Find::name . "\n";
# block maybe: cfgroup\/
# picdec\/|, wait_for_fb_sleep/wake is an odroid thing caused hang
return if $File::Find::name =~ /(^\/sys\/power\/wait_for_fb)/;
return if $File::Find::name =~ /\/(\.[a-z]|kernel\/|trace\/|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
# NOTE: this made a bunch of files on arm systems unreadable so we handle
# the readable tests in copy_files()
# return unless -T;
}
elsif ($parse_src eq 'proc') {
return if $File::Find::name =~ /^\/proc\/[0-9]+\//;
return if $File::Find::name =~ /^\/proc\/bus\/pci\//;
return if $File::Find::name =~ /^\/proc\/(irq|spl|sys)\//;
# these choke on sudo/root: kmsg kcore kpage and we don't want keys or kallsyms
return if $File::Find::name =~ /^\/proc\/k/;
return if $File::Find::name =~ /(\/mb_groups|debug)$/;
}
# print $File::Find::name . "\n";
push (@content, $File::Find::name);
return;
}
# args: 1 - path to file to be uploaded
# args: 2 - optional: alternate ftp upload url
# 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) || main::error_handler('ftp-connect', $ftp->message);
$ftp->login($user, $pass) || main::error_handler('ftp-login', $ftp->message);
$ftp->binary();
$ftp->cwd($dir);
print "Connected to FTP server.\n";
$ftp->put($file_path) || main::error_handler('ftp-upload', $ftp->message);
$ftp->quit;
print "Uploaded file successfully!\n";
print $ftp->message;
if ($debugger{'gz'}){
print "Removing debugger gz file:\n$file_path\n";
unlink $file_path or main::error_handler('remove',"$file_path", "$!");
print "File removed.\n";
}
print "Debugger data generation and upload completed. Thank you for your help.\n";
}
else {
main::error_handler('ftp-bad-path', "$file_path");
}
}
}
# random tests for various issues
sub user_debug_test_1 {
# open(my $duped, '>&', STDOUT);
# local *STDOUT = $duped;
# my $item = POSIX::strftime("%c", localtime);
# print "Testing character encoding handling. Perl IO data:\n";
# print(join(', ', PerlIO::get_layers(STDOUT)), "\n");
# print "Without binmode: ", $item,"\n";
# binmode STDOUT,":utf8";
# print "With binmode: ", $item,"\n";
# print "Perl IO data:\n";
# print(join(', ', PerlIO::get_layers(STDOUT)), "\n");
# close($duped);
}
#### -------------------------------------------------------------------
#### DOWNLOADER
#### -------------------------------------------------------------------
sub download_file {
my ($type, $url, $file,$ua) = @_;
my ($cmd,$args,$timeout) = ('','','');
my $debug_data = '';
my $result = 1;
$ua = ($ua && $dl{'ua'}) ? $dl{'ua'} . $ua : '';
$dl{'no-ssl-opt'} ||= '';
$dl{'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
# urls must be " quoted in case special characters present
else {
if ($type eq 'stdout'){
$args = $dl{'stdout'};
$cmd = "$dl{'dl'} $dl{'no-ssl-opt'} $ua $timeout $args \"$url\" $dl{'null'}";
$result = qx($cmd);
$debug_data = ($result) ? 'Success: stdout data not null.' : 'Download resulted in null data!';
}
elsif ($type eq 'file') {
$args = $dl{'file'};
$cmd = "$dl{'dl'} $dl{'no-ssl-opt'} $ua $timeout $args $file \"$url\" $dl{'null'}";
system($cmd);
$result = ($?) ? 0 : 1; # reverse these into Perl t/f
$debug_data = $result;
}
elsif ( $dl{'dl'} eq 'wget' && $type eq 'spider'){
$cmd = "$dl{'dl'} $dl{'no-ssl-opt'} $ua $timeout $dl{'spider'} \"$url\"";
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 $tiny = HTTP::Tiny->new;
# note: default is no verify, so default here actually is to verify unless overridden
$tiny->verify_SSL => 1 if !$dl{'no-ssl-opt'};
my $response = $tiny->get($url);
my $return = 1;
my $debug = 0;
my $fh;
$file ||= 'N/A';
log_data('dump','%{$response}',\%{$response}) if $b_log;
# print Dumper \%{$response};
if ( ! $response->{success} ){
my $content = $response->{content};
$content ||= "N/A\n";
my $msg = "Failed to connect to server/file!\n";
$msg .= "Response: ${content}Downloader: HTTP::Tiny URL: $url\nFile: $file";
log_data('data',$msg) if $b_log;
print error_defaults('download-error',$msg) if $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;
my $quiet = '';
$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') ){
$quiet = '-s ' if !$test[1];
$dl{'dl'} = 'curl';
$dl{'file'} = " -L ${quiet}-o ";
$dl{'no-ssl'} = ' --insecure';
$dl{'stdout'} = " -L ${quiet}";
$dl{'timeout'} = ' -y ';
$dl{'ua'} = ' -A ' . $dl_ua;
}
elsif ($dl{'wget'} && check_program('wget') ){
$quiet = '-q ' if !$test[1];
$dl{'dl'} = 'wget';
$dl{'file'} = " ${quiet}-O ";
$dl{'no-ssl'} = ' --no-check-certificate';
$dl{'spider'} = " ${quiet}--spider";
$dl{'stdout'} = " $quiet -O -";
$dl{'timeout'} = ' -T ';
$dl{'ua'} = ' -U ' . $dl_ua;
}
elsif ($dl{'fetch'} && check_program('fetch')){
$quiet = '-q ' if !$test[1];
$dl{'dl'} = 'fetch';
$dl{'file'} = " ${quiet}-o ";
$dl{'no-ssl'} = ' --no-verify-peer';
$dl{'stdout'} = " ${quiet}-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 {
eval $start if $b_log;
my ( $err, $one, $two) = @_;
my ($b_help,$b_recommends);
my ($b_exit,$errno) = (1,0);
my $message = do {
if ( $err eq 'empty' ) { 'empty value' }
## Basic rules
elsif ( $err eq 'not-in-irc' ) {
$errno=1; "You can't run option $one in an IRC client!" }
## Internal/external options
elsif ( $err eq 'bad-arg' ) {
$errno=10; $b_help=1; "Unsupported value: $two for option: $one" }
elsif ( $err eq 'bad-arg-int' ) {
$errno=11; "Bad internal argument: $one" }
elsif ( $err eq 'distro-block' ) {
$errno=20; "Option: $one has been disabled by the $self_name distribution maintainer." }
elsif ( $err eq 'option-feature-incomplete' ) {
$errno=21; "Option: '$one' feature: '$two' has not been implemented yet." }
elsif ( $err eq 'unknown-option' ) {
$errno=22; $b_help=1; "Unsupported option: $one" }
## Data
elsif ( $err eq 'open-data' ) {
$errno=32; "Error opening data for reading: $one \nError: $two" }
elsif ( $err eq 'download-error' ) {
$errno=33; "Error downloading file with $dl{'dl'}: $one \nError: $two" }
## Files:
elsif ( $err eq 'copy-failed' ) {
$errno=40; "Error copying file: $one \nError: $two" }
elsif ( $err eq 'create' ) {
$errno=41; "Error creating file: $one \nError: $two" }
elsif ( $err eq 'downloader-error' ) {
$errno=42; "Error downloading file: $one \nfor download source: $two" }
elsif ( $err eq 'file-corrupt' ) {
$errno=43; "Downloaded file is corrupted: $one" }
elsif ( $err eq 'mkdir' ) {
$errno=44; "Error creating directory: $one \nError: $two" }
elsif ( $err eq 'open' ) {
$errno=45; $b_exit=0; "Error opening file: $one \nError: $two" }
elsif ( $err eq 'open-dir' ) {
$errno=46; "Error opening directory: $one \nError: $two" }
elsif ( $err eq 'output-file-bad' ) {
$errno=47; "Value for --output-file must be full path, a writable directory, \nand include file name. Path: $two" }
elsif ( $err eq 'not-writable' ) {
$errno=48; "The file: $one is not writable!" }
elsif ( $err eq 'open-dir-failed' ) {
$errno=49; "The directory: $one failed to open with error: $two" }
elsif ( $err eq 'remove' ) {
$errno=50; "Failed to remove file: $one Error: $two" }
elsif ( $err eq 'rename' ) {
$errno=51; "There was an error moving files: $one\nError: $two" }
elsif ( $err eq 'write' ) {
$errno=52; "Failed writing file: $one - Error: $two!" }
## Downloaders
elsif ( $err eq 'missing-downloader' ) {
$errno=60; "Downloader program $two could not be located on your system." }
elsif ( $err eq 'missing-perl-downloader' ) {
$errno=61; $b_recommends=1; "Perl downloader missing required module." }
## FTP
elsif ( $err eq 'ftp-bad-path' ) {
$errno=70; "Unable to locate for FTP upload file:\n$one" }
elsif ( $err eq 'ftp-connect' ) {
$errno=71; "There was an error with connection to ftp server: $one" }
elsif ( $err eq 'ftp-login' ) {
$errno=72; "There was an error with login to ftp server: $one" }
elsif ( $err eq 'ftp-upload' ) {
$errno=73; "There was an error with upload to ftp server: $one" }
## Modules
elsif ( $err eq 'required-module' ) {
$errno=80; $b_recommends=1; "The required $one Perl module is not installed:\n$two" }
## DEFAULT
else {
$errno=255; "Error handler ERROR!! Unsupported options: $err!"}
};
print_line("Error $errno: $message\n");
if ($b_help){
print_line("Check -h for correct parameters.\n");
}
if ($b_recommends){
print_line("See --recommends for more information.\n");
}
eval $end if $b_log;
exit $errno if $b_exit && !$debugger{'no-exit'};
}
sub error_defaults {
my ($type,$one) = @_;
$one ||= '';
my %errors = (
'download-error' => "Download Failure:\n$one\n",
);
return $errors{$type};
}
#### -------------------------------------------------------------------
#### RECOMMENDS
#### -------------------------------------------------------------------
## CheckRecommends
{
package CheckRecommends;
sub run {
main::error_handler('not-in-irc', 'recommends') if $b_irc;
my (@data,@rows);
my $line = make_line();
my $pm = get_pm();
@data = basic_data($line,$pm);
push @rows,@data;
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 0; # shell true
}
sub basic_data {
my ($line,$pm_local) = @_;
my (@data,@rows);
my $client = $client{'name-print'};
$pm_local ||= 'N/A';
$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" ],
['0', '', '', "Package manager: $pm_local" ],
);
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 upower uptime usbdevs);
$info_os = 'info-bsd';
}
else {
@data = qw(blockdev dig dmidecode fdisk file hddtemp ifconfig ip ipmitool
ipmi-sensors lsblk lsusb modinfo runlevel sensors smartctl strings sudo
tree upower uptime);
}
$b_program = 1;
$item = 'Program';
$extra2 = "Note: IPMI sensors are generally only found on servers. To access
that data, you only need one of the ipmi items.";
}
elsif ($type eq 'recommended display information programs'){
if ($bsd_type){
@data = qw(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 Net::FTP);
$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';
if (($b_program || $b_module) && $pm){
$info{$pm} ||= 'N/A';
$install = " ~ Install package: $info{$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',
}),
## START PACKAGE MANAGER BLOCK ##
# Note: see inxi-perl branch for details: docs/recommends-package-manager.txt
# System Tools
'blockdev' => ({
'info' => '--admin -p/-P (filesystem blocksize)',
'info-bsd' => '',
'apt' => 'util-linux',
'pacman' => 'util-linux',
'rpm' => 'util-linux',
}),
'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; -J (optional); -N usb networking',
'info-bsd' => '-A; -J; -N. 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' => '-Da advanced data',
'info-bsd' => '-Da advanced data',
'apt' => 'smartmontools',
'pacman' => 'smartmontools',
'rpm' => 'smartmontools',
}),
'strings' => ({
'info' => '-I sysvinit version',
'info-bsd' => '',
'apt' => 'binutils',
'pacman' => '?',
'rpm' => '?',
}),
'sysctl' => ({
'info' => '',
'info-bsd' => '-C; -I; -m; -tm',
'apt' => '?',
'pacman' => '?',
'rpm' => '?',
}),
'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',
}),
'upower' => ({
'info' => '-sx attached device battery info',
'info-bsd' => '-sx attached device battery info',
'apt' => 'upower',
'pacman' => 'upower',
'rpm' => 'upower',
}),
'uptime' => ({
'info' => '-I uptime',
'info-bsd' => '-I uptime',
'apt' => 'procps',
'pacman' => 'procps',
'rpm' => 'procps',
}),
'usbdevs' => ({
'info' => '',
'info-bsd' => '-A; -J; -N;',
'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 (fallback)',
'info-bsd' => '-S active window managerr (fallback)',
'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',
}),
'Net::FTP' => ({
'info' => '--debug 21,22',
'info-bsd' => '--debug 21,22',
'apt' => 'Core Modules',
'pacman' => 'Core Modules',
'rpm' => 'Core Modules',
}),
'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',
}),
## END PACKAGE MANAGER BLOCK ##
);
my $ref = $data{$type};
my %values = %$ref;
return %values;
}
sub get_pm {
my ($pm) = ('');
# support maintainers of other pm types using custom lists
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;
}
}
}
# args: $1, $2, version numbers to compare by turning them to strings
# note that the structure of the two numbers is expected to be fairly
# similar, otherwise it may not work perfectly.
sub compare_versions {
my ($one,$two) = @_;
if ($one && !$two){return $one;}
elsif ($two && !$one){return $two;}
elsif (!$one && !$two){return}
my ($pad1,$pad2) = ('','');
my (@temp1) = split /[._-]/, $one;
my (@temp2) = split /[._-]/, $two;
@temp1 = map {$_ = sprintf("%04s", $_);$_ } @temp1;
@temp2 = map {$_ = sprintf("%04s", $_);$_ } @temp2;
$pad1 = join '', @temp1;
$pad2 = join '', @temp2;
# print "p1:$pad1 p2:$pad2\n";
if ($pad1 ge $pad2){return $one}
elsif ($pad2 gt $pad1){return $two}
}
# 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;
}
## NOTE: for perl pre 5.012 length(undef) returns warning
# receives string, returns boolean 1 if integer
sub is_int {
return 1 if (defined $_[0] && length($_[0]) && length($_[0]) == ($_[0] =~ tr/0123456789//));
}
# receives string, returns boolean 1 if numeric. tr/// is 4x faster than regex
sub is_numeric {
return 1 if ( defined $_[0] && ( $_[0] =~ tr/0123456789//) >= 1 &&
length($_[0]) == ($_[0] =~ tr/0123456789.//) && ($_[0] =~ tr/.//) <= 1);
}
# gets array ref, which may be undefined, plus join string
# this helps avoid debugger print errors when we are printing arrays
# which we don't know are defined or not null.
# args: 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: program print name 1: program version
# args: 1: program values id 2: program version string
# 3: extra level. Note that StartClient runs BEFORE -x levels are set!
# Only use this function when you only need the name/version data returned
# Important: all tests that use this must explicitly have program_values
# set for each item tested for!!
sub program_data {
eval $start if $b_log;
my ($values_id,$version_id,$level) = @_;
my (@data,$path,@program_data);
$level = 0 if ! $level;
#print "val_id: $values_id ver_id:$version_id lev:$level ex:$extra\n";
$version_id = $values_id if ! $version_id;
@data = main::program_values($values_id);
$program_data[0] = $data[3];
# programs that have no version method return 0 0 for index 1 and 2
if ( $extra >= $level && $data[1] && $data[2]){
$program_data[1] = main::program_version($version_id,$data[0],$data[1],$data[2],$data[5],$data[6]);
}
$program_data[1] = '' if ! defined $program_data[1];
eval $end if $b_log;
return @program_data;
}
# returns array of:
# 0 - match string; 1 - search number; 2 - version string [alt: file];
# 3 - Print name; 4 - console 0/1;
# 5 - 0/1 exit version loop at 1 [alt: if version=file replace value with \s];
# 6 - 0/1 write to stderr [alt: if version=file, path for file]
# arg: 1 - program lower case name
sub program_values {
my ($app) = @_;
my (@program_data);
# note: setting index 1 and 2 to 0 will trip flags to not do version
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 / wm / compositors
'3dwm' => ['^3dwm',0,'0','3dwm',0,1,0], # unknown syntax
'9wm' => ['^9wm',3,'-version','9wm',0,1,0],
'afterstep' => ['^afterstep',3,'--version','AfterStep',0,1,0],
'amiwm' => ['^amiwm',0,'0','AmiWM',0,1,0],
'asc' => ['^asc',0,'0','asc',0,1,0],
'awesome' => ['^awesome',2,'--version','Awesome',0,1,0],
'blackbox' => ['^Blackbox',2,'--version','Blackbox',0,1,0],
'bspwm' => ['^\S',1,'-v','bspwm',0,1,0],
'budgie' => ['^budgie-desktop',2,'--version','Budgie',0,1,0],
'budgie-wm' => ['^budgie',0,'0','budgie-wm',0,1,0],
'cinnamon' => ['^cinnamon',2,'--version','Cinnamon',0,1,0],
'compiz' => ['^compiz',2,'--version','Compiz',0,1,0],
'compton' => ['^\d',1,'--version','Compton',0,1,0],
'dcompmgr' => ['^dcompmgr',0,'0','dcompmgr',0,1,0],
'deepin' => ['^Version',2,'file','Deepin',0,'=','/etc/deepin-version'],
'deepin-metacity' => ['^metacity',2,'--version','Deepin-Metacity',0,1,0],
'deepin-mutter' => ['^mutter',2,'--version','Deepin-Mutter',0,1,0],
'deepin-wm' => ['^gala',0,'0','DeepinWM',0,1,0],
'dwc' => ['^dwc',0,'0','dwc',0,1,0],
'dwm' => ['^dwm',1,'-v','dwm',0,1,1],
# only listed here for compositor values, version data comes from xprop
'enlightenment' => ['^enlightenment',0,'0','enlightenment',0,1,0],
'fireplace' => ['^fireplace',0,'0','fireplace',0,1,0],
'fluxbox' => ['^fluxbox',2,'-v','Fluxbox',0,1,0],
'flwm' => ['^flwm',0,'0','FLWM',0,0,1],
'fvwm' => ['^fvwm',2,'--version','FVWM',0,0,1],
'fvwm2' => ['^fvwm',2,'--version','FVWM2',0,0,1],
# command: fvwm
'fvwm-crystal' => ['^fvwm',2,'--version','FVWM-Crystal',0,0,0],
'gala' => ['^gala',0,'0','gala',0,1,0], # super slow result, but 2, '--version' works?
'gnome-about' => ['gnome',3,'--version','Gnome',0,1,0],
'gnome-shell' => ['gnome',3,'--version','Gnome',0,1,0],
'grefson' => ['^grefson',0,'0','grefson',0,1,0],
# note, herbstluftwm when launched with full path returns full path in version string
'herbstluftwm' => ['herbstluftwm',2,'--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],
'ion' => ['^ion',0,'0','Ion',0,1,0],
'kded' => ['^KDE Development Platform:',4,'--version','KDE',0,1,0],
'kded1' => ['^KDE Development Platform:',4,'--version','KDE',0,1,0],
'kded2' => ['^KDE Development Platform:',4,'--version','KDE',0,1,0],
'kded3' => ['^KDE Development Platform:',4,'--version','KDE',0,1,0],
'kded4' => ['^KDE Development Platform:',4,'--version','KDE',0,1,0],
'ksmcon' => ['^ksmcon',0,'0','ksmcon',0,1,0],
'kwin' => ['^kwin',0,'0','kwin',0,1,0],
'kwin_wayland' => ['^kwin_wayland',0,'0','kwin_wayland',0,1,0],
'kwin_x11' => ['^kwin_x11',0,'0','kwin_x11',0,1,0],
'liri' => ['^liri',0,'0','liri',0,1,0],
'lumina' => ['^\S',1,'--version','Lumina',0,1,1],
'lwm' => ['^lwm',0,'0','lwm',0,1,0],
'lxde' => ['^lxpanel',2,'--version','LXDE',0,1,0],
# command: lxqt-panel
'lxqt' => ['^lxqt-panel',2,'--version','LXQt',0,1,0],
'lxqt-variant' => ['^lxqt-panel',0,'0','LXQt-Variant',0,1,0],
'lxsession' => ['^lxsession',0,'0','lxsession',0,1,0],
'ly' => ['^ly',3,'--version','Ly',0,1,0],
'manokwari' => ['^manokwari',0,'0','Manokwari',0,1,0],
'marco' => ['^marco',2,'--version','marco',0,1,0],
'matchbox' => ['^matchbox',0,'0','Matchbox',0,1,0],
'matchbox-window-manager' => ['^matchbox',2,'--help','Matchbox',0,0,0],
'mate-about' => ['^MATE[[:space:]]DESKTOP',-1,'--version','MATE',0,1,0],
# note, mate-session when launched with full path returns full path in version string
'mate-session' => ['mate-session',-1,'--version','MATE',0,1,0],
'metacity' => ['^metacity',2,'--version','Metacity',0,1,0],
'metisse' => ['^metisse',0,'0','metisse',0,1,0],
'mir' => ['^mir',0,'0','mir',0,1,0],
'motorcar' => ['^motorcar',0,'0','motorcar',0,1,0],
'muffin' => ['^muffin',2,'--version','muffin',0,1,0],
'moblin' => ['^moblin',0,'0','moblin',0,1,0],
'mutter' => ['^mutter',2,'--version','mutter',0,1,0],
'mwm' => ['^mwm',0,'0','mwm',0,1,0],
'nawm' => ['^nawm',0,'0','nawm',0,1,0],
'notion' => ['^.',1,'--version','notion',0,1,0],
'openbox' => ['^openbox',2,'--version','Openbox',0,1,0],
'orbital' => ['^orbital',0,'0','orbital',0,1,0],
'pantheon' => ['^pantheon',0,'0','Pantheon',0,1,0],
'papyros' => ['^papyros',0,'0','papyros',0,1,0],
'pekwm' => ['^pekwm',3,'--version','PekWM',0,1,0],
'perceptia' => ['^perceptia',0,'0','perceptia',0,1,0],
'picom' => ['^\d',1,'--version','Picom',0,1,0],
'plasmashell' => ['^plasmashell',2,'--version','KDE Plasma',0,1,0],
'qtdiag' => ['^qt',2,'--version','Qt',0,1,0],
'qtile' => ['^qtile',0,'0','Qtile',0,0,1],
'razor' => ['^razor',0,'0','Razor-Qt',0,1,0],
'ratpoison' => ['^ratpoison',2,'--version','Ratpoison',0,1,0],
'rustland' => ['^rustland',0,'0','rustland',0,1,0],
'sawfish' => ['^sawfish',3,'--version','Sawfish',0,1,0],
'scrotwm' => ['^scrotwm.*welcome.*',5,'-v','Scrotwm',0,1,1],
'sommelier' => ['^sommelier',0,'0','sommelier',0,1,0],
'spectrwm' => ['^spectrwm.*welcome.*wm',5,'-v','Spectrwm',0,1,1],
'sway' => ['^sway',3,'-v','sway',0,1,0],
'swc' => ['^swc',0,'0','swc',0,1,0],
'tvtwm' => ['^tvtwm',0,'0','tvtwm',0,1,0],
'twin' => ['^Twin:',2,'--version','Twin',0,0,0],
'twm' => ['^twm',0,'0','twm',0,1,0],
'ukui' => ['^ukui-session',2,'--version','UKUI',0,1,0],
'ukwm' => ['^ukwm',2,'--version','ukwm',0,1,0],
'unagi' => ['^unagi',0,'0','unagi',0,1,0],
'unity' => ['^unity',2,'--version','Unity',0,1,0],
'unity-system-compositor' => ['^unity-system-compositor',2,'--version','unity-system-compositor (mir)',0,0,0],
'wavy' => ['^wavy',0,'0','wavy',0,1,0],
'waycooler' => ['^way',3,'--version','way-cooler',0,1,0],
'way-cooler' => ['^way',3,'--version','way-cooler',0,1,0],
'wayhouse' => ['^wayhouse',0,'0','wayhouse',0,1,0],
'westford' => ['^westford',0,'0','westford',0,1,0],
'weston' => ['^weston',0,'0','weston',0,1,0],
'windowlab' => ['^windowlab',2,'-about','WindowLab',0,1,0],
'wm2' => ['^wm2',0,'0','wm2',0,1,0],
'wmaker' => ['^Window[[:space:]]*Maker',-1,'--version','WindowMaker',0,1,0],
'wmii' => ['^wmii',0,'0','wmii',0,1,0], # note: in debian, wmii is wmii3
'wmii2' => ['^wmii2',1,'--version','wmii2',0,1,0],
'wmx' => ['^wmx',0,'0','wmx',0,1,0],
'xcompmgr' => ['^xcompmgr',0,'0','xcompmgr',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],
'xmonad' => ['^xmonad',2,'--version','XMonad',0,1,0],
## display managers (dm)
'cdm' => ['^cdm',0,'0','CDM',0,1,0],
'entrance' => ['^entrance',0,'0','Entrance',0,1,0],
'gdm' => ['^gdm',2,'--version','GDM',0,1,0],
'gdm3' => ['^gdm',2,'--version','GDM3',0,1,0],
'kdm' => ['^kdm',0,'0','KDM',0,1,0],
'ldm' => ['^ldm',0,'0','LDM',0,1,0],
'lightdm' => ['^lightdm',2,'--version','LightDM',0,1,1],
'lxdm' => ['^lxdm',0,'0','LXDM',0,1,0],
'mdm' => ['^mdm',0,'0','MDM',0,1,0],
'nodm' => ['^nodm',0,'0','nodm',0,1,0],
'pcdm' => ['^pcdm',0,'0','PCDM',0,1,0],
'sddm' => ['^sddm',0,'0','SDDM',0,1,0],
'slim' => ['slim version',3,'-v','SLiM',0,1,0],
'tdm' => ['^tdm',0,'0','TDM',0,1,0],
'wdm' => ['^wdm',0,'0','WINGs DM',0,1,0],
'xdm' => ['^xdm',0,'0','XDM',0,1,0],
'xenodm' => ['^xenodm',0,'0','xenodm',0,1,0],
## Shells
'ash' => ['^ash',0,'0','ash',1,0,0],
'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],
'xonsh' => ['^xonsh',1,'--version','xonsh',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};
@program_data = @$ref;
}
#my $debug = main::Dumper \@program_data;
main::log_data('dump',"Program Data",\@program_data) if $b_log;
return @program_data;
}
# args: 1 - desktop/app command for --version; 2 - search string;
# 3 - space print number; 4 - [optional] version arg: -v, version, etc
# 5 - [optional] exit first find 0/1; 6 - [optional] 0/1 stderr output
sub program_version {
eval $start if $b_log;
my ($app, $search, $num,$version,$exit,$stderr) = @_;
my ($cmd,$line,$output);
my $version_nu = '';
my $count = 0;
#print "app:$app\n";
$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 ( $stderr && $stderr ne 'file' ) {
$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 =~ /dash$/ ){
$app =~ s/^.*\///;
$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;
# special case, in rare instances version comes from file
if ($version eq 'file' && $stderr){
return 0 unless -r $stderr;
my @data = reader($stderr,'strip');
@data = map {s/$exit/ /;$_} @data if $exit;
$output = join "\n",@data;
$exit = 100;
}
else {
$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-|xonsh\/|wmii2-|wmii-|\||\(|\))//g if $version_nu;
# trim off leading v but only when followed by a number
$version_nu =~ s/^v([0-9])/$1/i if $version_nu;
# print "$version_nu\n";
last;
}
$count++;
}
close $ch if $ch;
}
log_data('data',"Program version: $version_nu") if $b_log;
eval $end if $b_log;
return $version_nu;
}
# print program_version('bash', 'bash', 4) . "\n";
# 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 0;
}
else {
error_handler('file-corrupt', "$self_name");
}
}
# now run the error handlers on any downloader failure
else {
error_handler('download-error', $self_download, $download_id);
}
eval $end if $b_log;
}
sub update_man {
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! Root privileges required.\n";
print "Unable to continue: $man_file_location\n";
return 0;
}
if ( -f "/usr/share/man/man8/inxi.8.gz" ){
print "Updating man page location to man1.\n";
rename "/usr/share/man/man8/inxi.8.gz", "$man_file_location/inxi.1.gz";
if ( check_program('mandb') ){
system( 'mandb' );
}
}
# 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|admin' => sub {
$b_admin = 1;},
'A|audio' => sub {
$show{'short'} = 0;
$show{'audio'} = 1;},
'b|basic' => sub {
$show{'short'} = 0;
$show{'battery'} = 1;
$show{'cpu-basic'} = 1;
$show{'raid-basic'} = 1;
$show{'disk-total'} = 1;
$show{'graphic'} = 1;
$show{'graphic-basic'} = 1;
$show{'info'} = 1;
$show{'machine'} = 1;
$show{'network'} = 1;
$show{'system'} = 1;},
'B|battery' => sub {
$show{'short'} = 0;
$show{'battery'} = 1;
$show{'battery-forced'} = 1; },
'c|color:i' => sub {
my ($opt,$arg) = @_;
if ( $arg >= 0 && $arg < 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|disk' => 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{'graphic-basic'} = 1;
$show{'info'} = 1;
$show{'machine'} = 1;
$show{'network'} = 1;
$show{'network-advanced'} = 1;
$show{'partition'} = 1;
$show{'raid'} = 1;
$show{'sensor'} = 1;
$show{'swap'} = 1;
$show{'system'} = 1; },
'G|graphics|graphic' => sub {
$show{'short'} = 0;
$show{'graphic'} = 1;
$show{'graphic-basic'} = 1; },
'h|help|?' => sub {
$b_help = 1; },
'i|ip' => sub {
$show{'short'} = 0;
$show{'ip'} = 1;
$show{'network'} = 1;
$show{'network-advanced'} = 1;
$b_downloader = 1 if ! check_program('dig');},
'I|info' => sub {
$show{'short'} = 0;
$show{'info'} = 1; },
'j|swap|swaps' => sub {
$show{'short'} = 0;
$show{'swap'} = 1; },
'J|usb' => sub {
$show{'short'} = 0;
$show{'usb'} = 1; },
'l|labels|label' => sub {
$show{'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; },
'memory-modules' => sub {
$show{'short'} = 0;
$show{'ram'} = 1;
$show{'ram-modules'} = 1;},
'memory-short' => sub {
$show{'short'} = 0;
$show{'ram'} = 1;
$show{'ram-short'} = 1;},
'M|machine' => sub {
$show{'short'} = 0;
$show{'machine'} = 1; },
'n|network-advanced' => sub {
$show{'short'} = 0;
$show{'network'} = 1;
$show{'network-advanced'} = 1; },
'N|network' => sub {
$show{'short'} = 0;
$show{'network'} = 1; },
'o|unmounted' => sub {
$show{'short'} = 0;
$show{'unmounted'} = 1; },
'p|partition-full|partitions-full' => sub {
$show{'short'} = 0;
$show{'partition'} = 0;
$show{'partition-full'} = 1; },
'P|partitions|partition' => sub {
$show{'short'} = 0;
$show{'partition'} = 1; },
'partition-sort:s' => sub {
my ($opt,$arg) = @_;
if ($arg =~ /^(dev-base|fs|id|label|percent-used|size|uuid|used)$/){
$show{'partition-sort'} = $arg;
}
else {
error_handler('bad-arg',$opt,$arg);
} },
'r|repos|repo' => sub {
$show{'short'} = 0;
$show{'repo'} = 1; },
'R|raid' => sub {
$show{'short'} = 0;
$show{'raid'} = 1;
$show{'raid-forced'} = 1; },
's|sensors|sensor' => sub {
$show{'short'} = 0;
$show{'sensor'} = 1; },
'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);
} },
'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{'graphic-basic'} = 1;
$show{'info'} = 1;
$show{'system'} = 1;
}
if ($arg >= 2 ){
$show{'battery'} = 1;
$show{'disk-basic'} = 1;
$show{'raid-basic'} = 1;
$show{'machine'} = 1;
$show{'network'} = 1;
}
if ($arg >= 3 ){
$show{'network-advanced'} = 1;
$show{'cpu'} = 1;
$extra = 1;
}
if ($arg >= 4 ){
$show{'disk'} = 1;
$show{'partition'} = 1;
}
if ($arg >= 5 ){
$show{'audio'} = 1;
$show{'ram'} = 1;
$show{'label'} = 1;
$show{'optical-basic'} = 1;
$show{'ram'} = 1;
$show{'raid'} = 1;
$show{'sensor'} = 1;
$show{'swap'} = 1;
$show{'uuid'} = 1;
}
if ($arg >= 6 ){
$show{'optical'} = 1;
$show{'partition-full'} = 1;
$show{'unmounted'} = 1;
$show{'usb'} = 1;
$extra = 2;
}
if ($arg >= 7 ){
$b_downloader = 1 if ! check_program('dig');
$show{'cpu-flag'} = 1;
$show{'ip'} = 1;
$show{'raid-forced'} = 1;
$extra = 3;
}
if ($arg >= 8 ){
$b_admin = 1;
$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);
} },
'V|version' => sub {
$b_version = 1 },
'w|weather' => sub {
my ($opt) = @_;
$show{'short'} = 0;
$b_downloader = 1;
if ( $use{'weather'} ){
$show{'weather'} = 1;
}
else {
error_handler('distro-block', $opt);
} },
'W|weather-location:s' => sub {
my ($opt,$arg) = @_;
$arg ||= '';
$arg =~ s/\s//g;
$show{'short'} = 0;
$b_downloader = 1;
if ( $use{'weather'} ){
if ($arg){
$show{'weather'} = 1;
$show{'weather-location'} = $arg;
}
else {
error_handler('bad-arg',$opt,$arg);
}
}
else {
error_handler('distro-block', $opt);
} },
'ws|weather-source:s' => sub {
my ($opt,$arg) = @_;
# let api processor handle checks if valid, this
# future proofs this
if ($arg =~ /^[1-9]$/){
$weather_source = $arg;
}
else {
error_handler('bad-arg',$opt,$arg);
} },
'weather-unit:s' => sub {
my ($opt,$arg) = @_;
$arg ||= '';
$arg =~ s/\s//g;
$arg = lc($arg) if $arg;
if ($arg && $arg =~ /^(c|f|cf|fc|i|m|im|mi)$/){
my %units = ('c'=>'m','f'=>'i','cf'=>'mi','fc'=>'im');
$arg = $units{$arg} if defined $units{$arg};
$weather_unit = $arg;
}
else {
error_handler('bad-arg',$opt,$arg);
} },
'x|extra:i' => sub {
my ($opt,$arg) = @_;
if ($arg > 0){
$extra = $arg;
}
else {
$extra++;
} },
'y|width:i' => sub {
my ($opt, $arg) = @_;
if( defined $arg && $arg == -1){
$arg = 2000;
}
# note: :i creates 0 value if not supplied even though means optional
elsif (!$arg){
$arg = 80;
}
if ( $arg =~ /\d/ && $arg >= 80 ){
set_display_width($arg);
}
else {
error_handler('bad-arg', $opt, $arg);
} },
'z|filter' => sub {
$use{'filter'} = 1; },
'filter-label' => sub {
$use{'filter-label'} = 1; },
'Z|filter-override' => sub {
$use{'filter-override'} = 1; },
'filter-uuid' => sub {
$use{'filter-uuid'} = 1; },
## 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);
}
},
'bsd-data:s' => sub {
my ($opt,$arg) = @_;
if ($arg =~ /^(dboot|pciconf|sysctl|usbdevs)$/i){
$b_fake_dboot = 1 if $arg eq 'dboot';
$b_fake_pciconf = 1 if $arg eq 'pciconf';
$b_fake_sysctl = 1 if $arg eq 'sysctl';
$b_fake_usbdevs = 1 if $arg eq 'usbdevs';
}
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-3]|2[0-4]$/){
$debug=$arg;
}
else {
error_handler('bad-arg', $opt, $arg);
} },
'debug-no-eps' => sub {
$debugger{'no-exit'} = 1;
$debugger{'no-proc'} = 1;
$debugger{'sys'} = 0;
},
'debug-no-exit' => sub {
$debugger{'no-exit'} = 1 },
'debug-no-proc' => sub {
$debugger{'no-proc'} = 1; },
'debug-no-sys' => sub {
$debugger{'sys'} = 0; },
'debug-proc' => sub {
$debugger{'proc'} = 1; },
'debug-proc-print' => sub {
$debugger{'proc-print'} = 1;},
'debug-sys-print' => sub {
$debugger{'sys-print'} = 1; },
'debug-test-1' => sub {
$debugger{'test-1'} = 1; },
'debug-z' => sub {
$debugger{'z'} = 1 },
'dig' => sub {
$b_skip_dig = 0; },
'display:s' => sub {
my ($opt,$arg) = @_;
if ($arg =~ /^:?([0-9]+)?$/){
$display=$arg;
$display ||= ':0';
$display = ":$display" if $display !~ /^:/;
$b_display = ($b_root) ? 0 : 1;
$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);
} },
'fake-dmi' => sub {
$b_fake_dmidecode = 1 },
'ftp:s' => sub {
my ($opt,$arg) = @_;
# pattern: ftp.x.x/x
if ($arg =~ /^ftp\..+\..+\/[^\/]+$/ ){
$ftp_alt = $arg;
}
else {
error_handler('bad-arg', $opt, $arg);
}},
'host|hostname' => sub {
$show{'host'} = 1;
$show{'no-host'} = 0},
'indent-min:i' => sub {
my ($opt,$arg) = @_;
if ($arg =~ /^\d+$/){
$size{'indent-min'} = $arg;
}
else {
error_handler('bad-arg', $opt, $arg);
}},
'irc' => sub {
$b_irc = 1; },
'man' => sub {
$b_use_man = 1; },
'mips' => sub {
$b_mips = 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-dig' => sub {
$b_skip_dig = 1; },
'no-host|no-hostname' => sub {
$show{'host'} = 0 ;
$show{'no-host'} = 1},
'no-man' => sub {
$b_no_man_force = 0; },
'no-ssl' => sub {
$dl{'no-ssl-opt'}=1 },
'no-sudo' => sub {
$b_no_sudo = 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);
}},
'ppc' => sub {
$b_ppc = 1 },
'recommends' => sub {
$b_recommends = 1; },
'sparc' => sub {
$b_sparc = 1; },
'sys-debug' => sub {
$debugger{'sys-force'} = 1; },
'tty' => sub { # workaround for ansible running this
$b_irc = 0; },
'U|update:s' => sub { # 1,2,3 OR http://myserver/path/inxi
my ($opt,$arg) = @_;
$b_downloader = 1;
if ( $use{'update'} ){
$b_updater = 1;
if (!$arg && $self_name eq 'pinxi'){
$b_man = 1;
$download_id = 'inxi-perl branch';
$self_download = get_defaults('inxi-pinxi');
}
elsif ($arg && $arg eq '3'){
$b_man = 1;
$download_id = 'dev server';
$self_download = get_defaults('inxi-dev');
}
else {
if (!$arg){
$download_id = 'main branch';
$self_download = get_defaults('inxi-main');
$b_man = 1;
$b_use_man = 1;
}
elsif ( $arg =~ /^[12]$/){
$download_id = "branch $arg";
$self_download = get_defaults("inxi-branch-$arg");
}
elsif ( $arg =~ /^http/){
$download_id = 'alt server';
$self_download = $arg;
}
}
if (!$self_download){
error_handler('bad-arg', $opt, $arg);
}
}
else {
error_handler('distro-block', $opt);
} },
'usb-sys' => sub {
$b_usb_sys = 1 },
'usb-tool' => sub {
$b_usb_tool = 1 },
'wan-ip-url:s' => sub {
my ($opt,$arg) = @_;
if ($arg && $arg =~ /^(f|ht)tp[s]?:\/\//){
$wan_url = $arg;
$b_skip_dig = 1
}
else {
error_handler('bad-arg', $opt, $arg);
}},
'wm' => sub {
$b_wmctrl = 1 },
'<>' => sub {
my ($opt) = @_;
error_handler('unknown-option', "$opt", "" ); }
) ; #or error_handler('unknown-option', "@ARGV", '');
## run all these after so that we can change widths, downloaders, etc
eval $end if $b_log;
CheckRecommends::run() if $b_recommends;
set_downloader() if $b_downloader || $wan_url || ($b_skip_dig && $show{'ip'}); # sets for either config or arg here
set_xorg_log() if $show{'graphic'};
show_version() if $b_version;
show_options() if $b_help;
$b_man = 0 if (!$b_use_man || $b_no_man_force);
update_me( $self_download, $download_id ) if $b_updater;
if ($output_type){
if ($output_type ne 'screen' && ! $output_file){
error_handler('bad-arg', '--output', '--output-file not provided');
}
}
$show{'graphic-basic'} = 0 if $b_admin;
$b_block_tool = 1 if ( $b_admin && ($show{'partition'} || $show{'partition-full'} ));
$b_sudo = 1 if ( $show{'unmounted'} || ($extra > 0 && $show{'disk'}) );
$extra = 3 if $b_admin;
$use{'filter'} = 0 if $use{'filter-override'};
# override for things like -b or -v2 to -v3
$show{'cpu-basic'} = 0 if $show{'cpu'};
$show{'optical-basic'} = 0 if $show{'optical'};
$show{'partition'} = 0 if $show{'partition-full'};
$show{'host'} = 0 if $show{'no-host'};
$show{'host'} = 1 if ($show{'host'} || (!$use{'filter'} && !$show{'no-host'}));
if ($show{'disk'} || $show{'optical'} ){
$show{'disk-basic'} = 0;
$show{'disk-total'} = 0;
}
if ( $show{'ram'} || $show{'slot'} || ($show{'cpu'} && $extra > 1) ||
( ( $bsd_type || $b_dmidecode_force ) && ($show{'machine'} || $show{'battery'}) ) ){
$b_dmi = 1;
}
if ($show{'audio'} || $show{'graphic'} || $show{'network'} || $show{'raid'} || $show{'raid-forced'} ){
$b_pci = 1;
}
if ($show{'usb'} || $show{'audio'} || $show{'graphic'} || $show{'network'} ){
$b_usb = 1;
}
if ($bsd_type && ($show{'short'} || $show{'system'} || $show{'battery'} || $show{'cpu'} || $show{'cpu-basic'} ||
$show{'info'} || $show{'machine'} || $show{'process'} || $show{'ram'} || $show{'sensor'} ) ){
$b_sysctl = 1;
}
if ($bsd_type && ($show{'short'} || $show{'disk-basic'} || $show{'disk-total'} || $show{'disk'})){
$b_dm_boot_disk = 1;
}
if ($bsd_type && ($show{'optical-basic'} || $show{'optical'})){
$b_dm_boot_optical = 1
}
if ($b_admin && $show{'disk'}){
$b_smartctl = 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. For more detailed
information, see man^$self_name. If you start $self_name with no arguments,
it will display a short system summary." ],
['0', '', '', '' ],
['0', '', '', "You can use these options alone or together,
to show or add the item(s) you want to see: A, B, C, D, G, I, J, M, N, P,
R, S, W, d, f, i, j, l, m, n, o, p, r, s, t, u, w, --slots.
If you use them with -v [level], -b or -F, $self_name will add the requested
lines to the output." ],
['0', '', '', '' ],
['0', '', '', "Examples:^$self_name^-v4^-c6 OR $self_name^-bDc^6 OR
$self_name^-FzjJxy^80" ],
['0', '', '', $line ],
['0', '', '', "Output Control Options:" ],
['1', '-a', '--admin', "Adds advanced sys admin data (only works with
verbose or line output, not short form), sets --extra=3:" ],
['2', '-C', '', "If available: CPU socket type, base/boost speeds
(dmidecode+root/sudo required); CPU vulnerabilities (bugs);
family, model-id, stepping - format: hex (decimal) if greater
than 9, otherwise hex; microcode - format: hex." ],
['2', '-d,-D', '', "If available: logical and physical block sizes; drive family;
USB drive specifics; SMART report." ],
['2', '-G', '', "If available: Xorg Display ID, Screens total, default Screen,
current Screen; per X Screen: resolution, dpi, size, diagonal; per Monitor:
resolution; hz; dpi; size; diagonal. See man for explanations." ],
['2', '-j,-p,-P', '', "For swap (if available): swappiness and vfs cache
pressure, and if values are default or not." ],
['2', '-p,-P', '', "If available: raw size of ${partition_string}s,
percent available for user, block size of file system (root required)." ],
['2', '-S', '', "If available: kernel boot parameters." ],
['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', "System battery info, including charge and condition, plus
extra info (if battery present)." ],
['1', '-c', '--color', "Set color scheme (0-42). For piped or redirected output,
you must use an explicit color selector. Example:^$self_name^-c^11" ],
['1', '', '', "Color selectors let you set the config file value for the
selection (NOTE: IRC and global only show safe color set)" ],
['2', '94', '', "Console, out of X" ],
['2', '95', '', "Terminal, running in X - like xTerm" ],
['2', '96', '', "Gui IRC, running in X - like Xchat, Quassel, Konversation etc." ],
['2', '97', '', "Console IRC running in X - like irssi in xTerm" ],
['2', '98', '', "Console IRC not in X" ],
['2', '99', '', "Global - Overrides/removes all settings. Setting specific
removes global." ],
['1', '-C', '--cpu', "CPU output, including per CPU clock speed and max
CPU speed (if available)." ],
['1', '-d', '--disk-full, --optical', "Optical drive data (and floppy disks,
if present). Triggers -D." ],
['1', '-D', '--disk', "Hard Disk info, including total storage and details
for each disk. Disk total used percentage includes swap ${partition_string}
size(s)." ],
['1', '-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 --swap, -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/Wayland compositor, 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', '-j', '--swap', "Swap in use. Includes ${partition_string}s, zram, file." ],
['1', '-J', '--usb', "Show USB data: Hubs and Devices." ],
['1', '-l', '--label', "$partition_string_u labels. Triggers -P.
For full -p output, use -pl." ],
['1', '-m', '--memory', "Memory (RAM) data. Requires root. Numbers of
devices (slots) supported and individual memory devices (sticks of memory etc).
For devices, shows device locator, size, speed, type (e.g. DDR3).
If neither -I nor -tm are selected, also shows RAM used/total." ],
['1', '', '--memory-modules', "Memory (RAM) data. Exclude empty module slots." ],
['1', '', '--memory-short', "Memory (RAM) data. Show only short Memory RAM report,
number of arrays, slots, modules, and RAM type." ],
['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 /usr/home /var /var/log /var/tmp. Swap
${partition_string}s show if --swap is not used. Use -p to see all
mounted ${partition_string}s." ],
['1', '-r', '--repos', "Distro repository data. Supported repo types: APK,
APT, CARDS, EOPKG, PACMAN, PACMAN-G2, PISI, PORTAGE, PORTS (BSDs), SLACKPKG,
TCE, URPMQ, XBPS, 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.^-t^cm10)." ],
['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), full swap (-j), 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 (-J),
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 ( $use{'weather'} ){
@rows = (
['1', '-w', '--weather', "Local weather data/time. To check an alternate
location, see -W. NO AUTOMATED QUERIES ALLOWED!"],
['1', '-W', '--weather-location', "[location] Supported options for
[location]: postal code[,country/country code]; city, state (USA)/country
(country/two character country code); latitude, longitude. Only use if you
want the weather somewhere other than the machine running $self_name. Use
only ASCII characters, replace spaces in city/state/country names with '+'.
Example:^$self_name^-W^[new+york,ny^london,gb^madrid,es]"],
['1', '', '--weather-source', "[1-9] Change weather data source. 1-4 generally
active, 5-9 check. See man."],
['1', '', '--weather-unit', "Set weather units to metric (m), imperial (i),
metric/imperial (mi), or imperial/metric (im)."],
);
push @data, @rows;
}
@rows = (
['1', '-x', '--extra', "Adds the following extra data (only works with
verbose or line output, not short form):" ],
['2', '-A', '', "Specific vendor/product information (if relevant);
PCI Bus ID/USB ID number of card; Version/port(s)/driver version (if available)." ],
['2', '-B', '', "Vendor/model, status (if available); attached devices
(e.g. wireless mouse, keyboard, if present)." ],
['2', '-C', '', "CPU $flags (short list, use -f to see full list), Bogomips
on CPU; CPU microarchitecture + revision (if found, or unless --admin,
then shows as 'stepping')." ],
['2', '-d', '', "Extra optical drive features data; adds rev version to
optical drive." ],
['2', '-D', '', "HDD temp with disk data 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', '', "Specific vendor/product information (if relevant);
PCI Bus ID/USB ID number of card; 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', '-J', '', "For Device: driver." ],
['2', '-m,--memory-modules', '', "Max memory module size (if available), device type." ],
['2', '-N', '', "Specific vendor/product information (if relevant);
PCI Bus ID/USB ID number of card; Version/port(s)/driver version (if available)." ],
['2', '-R', '', "md-raid: second RAID Info line with extra data:
blocks, chunk size, bitmap (if present). Resync line, shows blocks
synced/total blocks. Hardware RAID driver version, bus ID." ],
['2', '-s', '', "Basic voltages (ipmi, lm-sensors if present): 12v, 5v, 3.3v, vbat." ],
['2', '-S', '', "Kernel gcc version; system base of distro (if relevant
and detected)" ],
['2', '-t', '', "Adds memory use output to CPU (-xt c), and CPU use to
memory (-xt m)." ],
);
push @data, @rows;
if ( $use{'weather'} ){
@rows = (['2', '-w -W', '', "Wind speed and direction, humidity, pressure,
and time zone, if available." ]);
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', '', "L1/L3 cache (if root and dmidecode installed)." ],
['2', '-D', '', "Disk transfer speed; NVMe lanes; Disk serial number." ],
['2', '-G', '', "Chip vendor:product ID for each video card; OpenGL
compatibility version, if free drivers and available; Xorg compositor;
alternate Xorg drivers (if available). Alternate means driver is on automatic
driver check list of Xorg for the card vendor, but is not installed on system;
Xorg dpi." ],
['2', '-I', '', "Other detected installed gcc versions (if present). System
default runlevel. Adds parent program (or tty) for shell info if not in
IRC. Adds Init version number, RC (if found)." ],
['2', '-j,-p,-P', '', "Swap priority." ],
['2', '-J', '', "Vendor:chip ID." ],
['2', '-m,--memory-modules', '', "Manufacturer, part number; single/double bank (if found)." ],
['2', '-M', '', "Chassis info, BIOS ROM size (dmidecode only), if available." ],
['2', '-N', '', "Chip vendor:product ID." ],
['2', '-R', '', "md-raid: Superblock (if present), algorithm. If resync,
shows progress bar. Hardware RAID Chip vendor:product ID." ],
['2', '-s', '', "DIMM/SOC voltages (ipmi only)." ],
['2', '-S', '', "Display manager (dm) in desktop output (e.g. kdm,
gdm3, lightdm); active window manager if detected; desktop toolkit,
if available (Xfce/KDE/Trinity only)." ],
['2', '--slots', '', "Slot length." ],
);
push @data, @rows;
if ( $use{'weather'} ){
@rows = (['2', '-w -W', '', "Snow, rain, precipitation, (last observed hour),
cloud cover, 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', '-A', '', "Serial number." ],
['2', '-B', '', "Chemistry, cycles, location (if available)." ],
['2', '-C', '', "CPU boost (turbo) enabled/disabled, if present;
CPU voltage, external clock speed (if root and dmidecode installed)." ],
['2', '-D', '', "Firmware rev. if available; partition scheme, in some cases; disk
rotation speed (if detected)." ],
['2', '-G', '', "Xorg Compositor version (if detectable)." ],
['2', '-I', '', "For 'Shell:' adds ([su|sudo|login]) to shell name if present;
for 'running in:' adds (SSH) if SSH session." ],
['2', '-J', '', "For Device: serial number (if present), interface count; USB speed." ],
['2', '-m,--memory-modules', '', "Width of memory bus, data and total (if present and greater
than data); Detail for Type, if present; module voltage, if available; serial
number." ],
['2', '-N', '', "Serial number." ],
['2', '-R', '', "zfs-raid: portion allocated (used) by RAID devices/arrays.
md-raid: system md-raid support types (kernel support, read ahead, RAID events).
Hardware RAID rev, ports, specific vendor/product information." ],
['2', '-S', '', "Panel/tray/bar/dock info in desktop output, if in X (like lxpanel,
xfce4-panel, mate-panel); (if available) dm version number, window manager
version number." ],
);
push @data, @rows;
if ( $use{'weather'} ){
@rows = (['2', '-w -W', '', "Location (uses -z/irc filter), weather observation
time, altitude, sunrise/sunset, if available." ] );
push @data, @rows;
}
@rows = (
['1', '-y', '--width', "Output line width max (integer >= 80). Overrides IRC/Terminal
settings or actual widths. If no integer give, defaults to 80. Example:^inxi^-y^130" ],
['1', '-z', '--filter', "Adds security filters for IP/MAC addresses, serial numbers,
location (-w), user home directory name, host item. Default on for IRC clients." ],
['1', '', '--filter-label', "Filters out ${partition_string} labels in -j,
-o, -p, -P, -Sa." ],
['1', '-Z', '--filter-override', "Override for output filters. Useful for
debugging networking issues in IRC, for example." ],
['1', '', '--filter-uuid', "Filters out ${partition_string} UUIDs in -j,
-o, -p, -P, -Sa." ],
[0, '', '', "$line" ],
[0, '', '', "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 ( $use{'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', '', '', "Advanced Options:" ],
['1', '', '--alt', "Trigger for various advanced options:" ],
['2', '40', '', "Bypass Perl as a downloader option." ],
['2', '41', '', "Bypass Curl as a downloader option." ],
['2', '42', '', "Bypass Fetch as a downloader option." ],
['2', '43', '', "Bypass Wget as a downloader option." ],
['2', '44', '', "Bypass Curl, Fetch, and Wget as downloader options. Forces
Perl if HTTP::Tiny present." ],
['1', '', '--dig', "Overrides configuration item NO_DIG (resets to default)." ],
['1', '', '--display', "[:[0-9]] Try to get display data out of X (default: display 0)." ],
['1', '', '--dmidecode', "Force use of dmidecode data instead of /sys where relevant
(e.g. -M, -B)." ],
['1', '', '--downloader', "Force $self_name to use [curl|fetch|perl|wget] for downloads." ],
['1', '', '--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 ( $use{'update'} ){
@rows = (
['1', '', '--man', "Install correct man version for dev branch (-U 3) or pinxi using -U." ],
);
push @data, @rows;
}
@rows = (
['1', '', '--no-dig', "Skip dig for WAN IP checks, use downloader program." ],
['1', '', '--no-host', "Turn off hostname for -S. Useful if showing output from servers etc." ],
);
push @data, @rows;
if ( $use{'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/Perl-HTTP::Tiny)." ],
['1', '', '--no-sudo', "Skip internal program use of sudo features (not related
to starting $self_name with sudo)." ],
['1', '', '--output', "[json|screen|xml] Change data output type. Requires --output-file
if not screen." ],
['1', '', '--output-file', "[Full filepath|print] Output file to be used for --output." ],
['1', '', '--partition-sort', "[dev-base|fs|id|label|percent-used|size|uuid|used]
Change sort order of ${partition_string} output. See man page for specifics." ],
['1', '', '--sleep', "[0-x.x] Change CPU sleep time, in seconds, for -C
(default:^$cpu_sleep). Allows system to catch up and show a more accurate CPU
use. Example:^$self_name^-Cxxx^--sleep^0.15" ],
['1', '', '--tty', "Forces irc flag to false. Generally useful if $self_name is running
inside of another tool like Chef or MOTD and returns corrupted color codes. Please see
man page or file an issue if you need to use this flag. Must use -y [width] option if
you want a specific output width. Always put this option first in an option list."],
['1', '', '--usb-sys', "Force USB data to use /sys as data source (Linux only)." ],
['1', '', '--usb-tool', "Force USB data to use lsusb as data source (Linux only)." ],
['1', '', '--wan-ip-url', "[URL] Skips dig, uses supplied URL for WAN IP (-i).
URL output must end in the IP address. See man.
Example:^$self_name^-i^--wan-ip-url^https://yoursite.com/ip.php" ],
['1', '', '--wm', "Force wm: to use wmctrl as data source. Default uses ps." ],
['0', '', '', $line ],
['0', '', '', "Debugging Options:" ],
['1', '', '--dbg', "Specific debuggers, change often. Only 1 is constant:" ],
['2', '1', '', "Show downloader output. Turns off quiet mode." ],
['1', '', '--debug', "Triggers debugging modes." ],
['2', '1-3', '', "On screen debugger output." ],
['2', '10', '', "Basic logging." ],
['2', '11', '', "Full file/system info logging." ],
['1', '', ,'', "The following create a tar.gz file of system data, plus $self_name
output. To automatically upload debugger data tar.gz file
to ftp.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', '', '--debug-proc', "Force debugger parsing of /proc as sudo/root." ],
['1', '', '--debug-proc-print', "To locate file that /proc debugger hangs on." ],
['1', '', '--debug-no-exit', "Skip exit on error to allow completion." ],
['1', '', '--debug-no-proc', "Skip /proc debugging in case of a hang." ],
['1', '', '--debug-no-sys', "Skip /sys debugging in case of a hang." ],
['1', '', '--debug-sys', "Force PowerPC debugger parsing of /sys as sudo/root." ],
['1', '', '--debug-sys-print', "To locate file that /sys debugger hangs on." ],
['1', '', '--ftp', "Use with --debugger 21 to trigger an alternate FTP server for upload.
Format:^[ftp.xx.xx/yy]. Must include a remote directory to upload to.
Example:^$self_name^--debug^21^--ftp^ftp.myserver.com/incoming" ],
['0', '', '', "$line" ],
);
push @data, @rows;
print_basic(@data);
exit 0; # shell true
}
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 0; # shell true
}
########################################################################
#### 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 {
$use{'filter'} = 1;
get_client_name();
if ($client{'konvi'} == 1 || $client{'konvi'} == 3){
set_konvi_data();
}
}
eval $end if $b_log;
}
sub get_client_name {
eval $start if $b_log;
my $client_name = '';
# print "$ppid\n";
if ($ppid && -e "/proc/$ppid/exe" ){
$client_name = lc(readlink "/proc/$ppid/exe");
$client_name =~ s/^.*\///;
if ($client_name =~ /^bash|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";
#print "$client{'name-print'}\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');
}
if (@data){
$client{'version'} = main::awk(\@data,'version',2,'\s*=\s*');
}
# fingers crossed, hexchat won't open gui!!
if (!$client{'version'}) {
@data = main::grabber("$client{'name'} --version 2>/dev/null");
$client{'version'} = main::awk(\@data,'hexchat',2,'\s+');
}
$client{'name-print'} = 'HexChat';
}
# note: see legacy inxi konvi logic if we need to restore any of the legacy code.
elsif ($client{'name'} eq 'konversation') {
$client{'konvi'} = ( ! $client{'native'} ) ? 2 : 1;
}
elsif ($client{'name'} =~ /quassel/) {
@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'}) {
# NOTE: these must be empirically determined, not all events that
# show no tty are actually IRC.
my $wl_terms = 'alacritty|evilvte|germinal|guake|hyper|kate|kitty|kmscon|';
$wl_terms .= 'konsole|putty|rxvt|sakura|shellinabox|^st$|sudo|term|tilda|';
$wl_terms .= 'tilix|urvxt|yaft|yakuake';
my $wl_clients = 'ansible|chef|run-parts';
my $whitelist = "$wl_terms|$wl_clients";
# print "$client{'name'}\n";
if ($client{'name'} =~ /($whitelist)/i){
if ($client{'name'} =~ /($wl_terms)/i){
main::get_shell_data($ppid);
}
else {
$client{'name-print'} = $client{'name'};
}
$b_irc = 0;
}
else {
$client{'name-print'} = 'Unknown Client: ' . $client{'name'};
}
}
eval $end if $b_log;
}
sub get_cmdline {
eval $start if $b_log;
my @cmdline;
my $i = 0;
$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 -session',2,'\s+');
main::log_data('data',"pid: $pid") if $b_log;
$konvi = readlink ("/proc/$pid/exe");
$konvi =~ s/^.*\///; # basename
@app = main::program_values('konversation');
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 = ( $use{'filter'} ) ? $filter_string : $string;
}
else {
$string = 'N/A';
}
return $string;
}
# note, let the print logic handle N/A cases
sub apply_partition_filter {
my ($source,$string,$type) = @_;
return $string if !$string || $string eq 'N/A';
if ($source eq 'system') {
my $test = ($type eq 'label') ? '=LABEL=': '=UUID=';
$string =~ s/$test[^\s]+/$test$filter_string/g;
}
else {
$string = $filter_string;
}
return $string;
}
sub arm_cleaner {
my ($item) = @_;
$item =~ s/(\([^\(]*Device Tree[^\)]*\))//gi;
$item =~ s/\s\s+/ /g;
$item =~ s/^\s+|\s+$//g;
return $item;
}
sub clean_characters {
my ($data) = @_;
# newline, pipe, brackets, + sign, with space, then clear doubled
# spaces and then strip out trailing/leading spaces.
# etc/issue often has junk stuff like (\l) \n \l
return if ! $data;
$data =~ s/[:\47]|\\[a-z]|\n|,|\"|\*|\||\+|\[\s\]|n\/a|\s\s+/ /g;
$data =~ s/\(\s*\)//;
$data =~ s/^\s+|\s+$//g;
return $data;
}
sub cleaner {
my ($item) = @_;
return $item if !$item;# handle cases where it was 0 or ''
# note: |nee trips engineering, but I don't know why nee was filtered
$item =~ s/chipset|company|components|computing|computer|corporation|communications|electronics|electrical|electric|gmbh|group|incorporation|indus
|