data/scripts/inxi

   1 #!/usr/bin/env perl
   2 ## infobash: Copyright (C) 2005-2007  Michiel de Boer aka locsmif
   3 ## inxi: Copyright (C) 2008-2018 Harald Hope
   4 ##       Additional features (C) Scott Rogers - kde, cpu info
   5 ## Further fixes (listed as known): Horst Tritremmel <hjt at sidux.com>
   6 ## Steven Barrett (aka: damentz) - usb audio patch; swap percent used patch
   7 ## Jarett.Stevens - dmidecode -M patch for older systems with the /sys
   8 ##
   9 ## License: GNU GPL v3 or greater
  10 ##
  11 ## You should have received a copy of the GNU General Public License
  12 ## along with this program.  If not, see <http://www.gnu.org/licenses/>.
  13 ##
  14 ## If you don't understand what Free Software is, please read (or reread)
  15 ## this page: http://www.gnu.org/philosophy/free-sw.html
  16
  17 use strict;
  18 use warnings;
  19 # use diagnostics;
  20 use 5.008;
  21
  22 use Cwd qw(abs_path); # qw(abs_path);#abs_path realpath getcwd
  23 use Data::Dumper qw(Dumper); # print_r
  24 use File::Find;
  25 use Getopt::Long qw(GetOptions);
  26 # Note: default auto_abbrev is enabled, that's fine
  27 Getopt::Long::Configure ('bundling', 'no_ignore_case',
  28 'no_getopt_compat', 'no_auto_abbrev','pass_through');
  29 use POSIX qw(uname strftime ttyname);
  30 # use feature qw(state);
  31
  32 ## INXI INFO ##
  33 my $self_name='inxi';
  34 my $self_version='3.0.18';
  35 my $self_date='2018-07-16';
  36 my $self_patch='00';
  37 ## END INXI INFO ##
  38
  39 ### INITIALIZE VARIABLES ###
  40
  41 ## Self data
  42 my ($self_path, $user_config_dir, $user_config_file,$user_data_dir);
  43
  44 ## Debuggers
  45 my $debug=0;
  46 my (@t0,$end,$start,$fh_l,$log_file); # log file handle, file
  47 my ($b_hires,$t1,$t2,$t3) = (0,0,0,0);
  48 # NOTE: redhat removed HiRes from Perl Core Modules.
  49 if (eval {require Time::HiRes}){
  50         Time::HiRes->import('gettimeofday','tv_interval','usleep');
  51         $b_hires = 1;
  52 }
  53 @t0 = eval 'Time::HiRes::gettimeofday()' if $b_hires; # let's start it right away
  54 ## Hashes
  55 my ( %alerts,%client,%colors,%dl,%files,%rows,%system_files,%use );
  56
  57 ## Arrays
  58 # ps_aux is full output, ps_cmd is only the last 10 columns to last
  59 my (@app,@dmesg_boot,@dmi,@gpudata,@ifs,@ifs_bsd,@paths,@pci,@ps_aux,
  60 @ps_cmd,@ps_gui,@sysctl,@sysctl_battery,@sysctl_sensors,@sysctl_machine,
  61 @uname,@usb);
  62 ## Disk arrays
  63 my (@dm_boot_disk,@dm_boot_optical,@glabel,@gpart,@hardware_raid,@labels,
  64 @lsblk,@partitions,@raid,@sysctl_disks,@uuids);
  65 my @test = (0,0,0,0,0);
  66
  67 ## Booleans
  68 my ($b_admin,$b_arm,$b_console_irc,$b_debug_gz,$b_debug_timers,
  69 $b_display,$b_dmesg_boot_check,
  70 $b_dmi,$b_dmidecode_force,$b_fake_bsd,$b_fake_dboot,$b_fake_pciconf,
  71 $b_fake_sysctl,$b_fake_usbdevs,$b_force_display,$b_gpudata,$b_irc,
  72 $b_log,$b_log_colors,$b_log_full,$b_man,$b_mem,$b_mips,$b_pci,$b_pci_tool,
  73 $b_proc_debug,$b_ps_gui,$b_root,$b_running_in_display,$b_slot_tool,
  74 $b_soc_audio,$b_soc_gfx,$b_soc_net,$b_sudo,$b_sysctl,$b_usb_check,$b_wmctrl);
  75 ## Disk checks
  76 my ($b_dm_boot_disk,$b_dm_boot_optical,$b_glabel,$b_hardware_raid,
  77 $b_label_uuid,$b_lsblk,$b_partitions,$b_raid);
  78 my ($b_sysctl_disk,$b_update,$b_weather) = (1,1,1);
  79
  80 ## System
  81 my ($bsd_type,$language,$os) = ('','','');
  82 my ($bits_sys,$cpu_arch);
  83 my ($cpu_sleep,$dl_timeout,$limit,$ps_count,$usb_level) = (0.35,4,10,5,0);
  84 my $sensors_cpu_nu = 0;
  85 my $weather_unit='mi';
  86
  87 ## Tools
  88 my ($display,$ftp_alt,$tty_session);
  89 my ($display_opt,$sudo) = ('','');
  90
  91 ## Output
  92 my $extra = 0;# supported values: 0-3
  93 my $filter_string = '<filter>';
  94 my $line1 = "----------------------------------------------------------------------\n";
  95 my $line2 = "======================================================================\n";
  96 my $line3 = "----------------------------------------\n";
  97 my ($output_file,$output_type) = ('','screen');
  98 my $prefix = 0; # for the primiary row hash key prefix
  99
 100 # these will assign a separator to non irc states. Important! Using ':' can
 101 # trigger stupid emoticon. Note: SEP1/SEP2 from short form not used anymore.
 102 # behaviors in output on IRC, so do not use those.
 103 my %sep = (
 104 's1-irc' => ':',
 105 's1-console' => ':',
 106 's2-irc' => '',
 107 's2-console' => ':',
 108 );
 109
 110 my %show = ('host' => 1);
 111
 112 my %size = (
 113 'console' => 115,
 114 # Default indentation level. NOTE: actual indent is 1 greater to allow for
 115 # spacing
 116 'indent' => 11,
 117 'indent-min' => 90,
 118 'irc' => 100, # shorter because IRC clients have nick  lists etc
 119 'max' => 0,
 120 'no-display' => 130,
 121 # these will be set dynamically in set_display_width()
 122 'term' => 80,
 123 'term-lines' => 100,
 124 );
 125
 126 ## debug temp tools
 127 $client{'test-konvi'} = 0;
 128
 129 ########################################################################
 130 #### STARTUP
 131 ########################################################################
 132
 133 #### -------------------------------------------------------------------
 134 #### MAIN
 135 #### -------------------------------------------------------------------
 136
 137 sub main {
 138 #       print Dumper \@ARGV;
 139         eval $start if $b_log;
 140         initialize();
 141         ## use for start client debugging
 142         # $debug = 3; # 3 prints timers
 143         # set_debugger(); # for debugging of konvi issues
 144         #my $ob_start = StartClient->new();
 145         #$ob_start->get_client_data();
 146         StartClient::get_client_data();
 147         # print_line( Dumper \%client);
 148         get_options();
 149         set_debugger(); # right after so it's set
 150         check_tools();
 151         set_colors();
 152         set_sep();
 153         # print download_file('stdout','https://') . "\n";
 154         generate_lines();
 155         eval $end if $b_log;
 156         cleanup();
 157         # weechat's executor plugin forced me to do this, and rightfully so,
 158         # because else the exit code from the last command is taken..
 159         exit 0;
 160 }
 161
 162 #### -------------------------------------------------------------------
 163 #### INITIALIZE
 164 #### -------------------------------------------------------------------
 165
 166 sub initialize {
 167         set_os();
 168         set_path();
 169         set_user_paths();
 170         set_basics();
 171         system_files('set');
 172         get_configs();
 173         # set_downloader();
 174         set_display_width('live');
 175 }
 176
 177 sub check_tools {
 178         my ($action,$program,$message,@data,%commands,%hash);
 179         if ( $b_dmi ){
 180                 $action = 'use';
 181                 if ($program = check_program('dmidecode')) {
 182                         @data = grabber("$program -t chassis -t baseboard -t processor 2>&1");
 183                         if (scalar @data < 15){
 184                                 if ($b_root) {
 185                                         foreach (@data){
 186                                                 if ($_ =~ /No SMBIOS/i){
 187                                                         $action = 'smbios';
 188                                                         last;
 189                                                 }
 190                                                 elsif ($_ =~ /^\/dev\/mem: Operation/i){
 191                                                         $action = 'no-data';
 192                                                         last;
 193                                                 }
 194                                                 else {
 195                                                         $action = 'unknown-error';
 196                                                         last;
 197                                                 }
 198                                         }
 199                                 }
 200                                 else {
 201                                         if (grep { $_ =~ /^\/dev\/mem: Permission/i } @data){
 202                                                 $action = 'permissions';
 203                                         }
 204                                         else {
 205                                                 $action = 'unknown-error';
 206                                         }
 207                                 }
 208                         }
 209                 }
 210                 else {
 211                         $action = 'missing';
 212                 }
 213                 %hash = (
 214                 'dmidecode' => {
 215                 'action' => $action,
 216                 'missing' => 'Required program dmidecode not available',
 217                 'permissions' => 'Unable to run dmidecode. Are you root?',
 218                 'smbios' => 'No SMBIOS data for dmidecode to process',
 219                 'no-data' => 'dmidecode is not allowed to read /dev/mem',
 220                 'unknown-error' => 'dmidecode was unable to generate data',
 221                 },
 222                 );
 223                 %alerts = (%alerts, %hash);
 224         }
 225         # note: gnu/linux has sysctl so it may be used that for something if present
 226         # there is lspci for bsds so doesn't hurt to check it
 227         if ($b_pci || $b_sysctl){
 228                 if (!$bsd_type){
 229                         if ($b_pci ){
 230                                 %hash = ('lspci' => '-n',);
 231                                 %commands = (%commands,%hash);
 232                         }
 233                 }
 234                 else {
 235                         if ($b_pci ){
 236                                 %hash = ('pciconf' => '-l',);
 237                                 %commands = (%commands,%hash);
 238                         }
 239                         if ($b_sysctl ){
 240                                 # note: there is a case of kernel.osrelease but it's a linux distro
 241                                 %hash = ('sysctl' => 'kern.osrelease',);
 242                                 %commands = (%commands,%hash);
 243                         }
 244                 }
 245                 foreach ( keys %commands ){
 246                         $action = 'use';
 247                         if ($program = check_program($_)) {
 248                                 # > 0 means error in shell
 249                                 #my $cmd = "$program $commands{$_} >/dev/null";
 250                                 #print "$cmd\n";
 251                                 $action = 'permissions' if system("$program $commands{$_} >/dev/null 2>&1");
 252                         }
 253                         else {
 254                                 $action = 'missing';
 255                         }
 256                         %hash = (
 257                         $_ => {
 258                         'action' => $action,
 259                         'missing' => "Missing system tool: $_. Output will be incomplete",
 260                         'permissions' => "Unable to run $_. Root required?",
 261                         },
 262                         );
 263                         %alerts = (%alerts, %hash);
 264                 }
 265         }
 266         %commands = ();
 267         if ( $show{'sensor'} ){
 268                 %commands = ('sensors' => 'linux',);
 269         }
 270         # note: lsusb ships in FreeBSD ports sysutils/usbutils
 271         if ( $usb_level ){
 272                 %hash = ('lsusb' => 'all',);
 273                 %commands = (%commands,%hash);
 274                 %hash = ('usbdevs' => 'bsd',);
 275                 %commands = (%commands,%hash);
 276         }
 277         if ($show{'ip'} || ($bsd_type && $show{'network-advanced'})){
 278                 %hash = (
 279                 'ip' => 'linux',
 280                 'ifconfig' => 'all',
 281                 );
 282                 %commands = (%commands,%hash);
 283         }
 284         foreach ( keys %commands ){
 285                 $action = 'use';
 286                 $message = 'Present and working';
 287                 if ( ($commands{$_} eq 'linux' && $os ne 'linux' ) || ($commands{$_} eq 'bsd' && $os eq 'linux' ) ){
 288                         $message = "No " . ucfirst($os) . " support. Is a comparable $_ tool available?";
 289                         $action = 'platform';
 290                 }
 291                 elsif (!check_program($_)){
 292                         $message = "Required tool $_ not installed. Check --recommends";
 293                         $action = 'missing';
 294                 }
 295                 %hash = (
 296                 $_ => {
 297                 'action' => $action,
 298                 'missing' => $message,
 299                 'platform' => $message,
 300                 },
 301                 );
 302                 %alerts = (%alerts, %hash);
 303         }
 304         # print Dumper \%alerts;
 305         # only use sudo if not root, -n option requires sudo -V 1.7 or greater.
 306         # for some reason sudo -n with < 1.7 in Perl does not print to stderr
 307         # sudo will just error out which is the safest course here for now,
 308         # otherwise that interactive sudo password thing is too annoying
 309         # important: -n makes it non interactive, no prompt for password
 310         if (!$b_root && $b_sudo && (my $path = main::check_program('sudo') )) {
 311                 my @data = program_values('sudo');
 312                 my $version = program_version($path,$data[0],$data[1],$data[2],$data[5]);
 313                 $version =~ s/^([0-9]+\.[0-9]+).*/$1/;
 314                 $sudo = "$path -n " if $version >= 1.7;
 315         }
 316         set_fake_tools() if $b_fake_bsd;
 317 }
 318
 319 # args: 1 - desktop/app command for --version; 2 - search string;
 320 # 3 - space print number; 4 - [optional] version arg: -v, version, etc
 321 # 5 - [optional] exit first find 0/1; 6 - [optional] 0/1 stderr output
 322 sub set_basics {
 323         ### LOCALIZATION - DO NOT CHANGE! ###
 324         # set to default LANG to avoid locales errors with , or .
 325         # Make sure every program speaks English.
 326         $ENV{'LANG'}='C';
 327         $ENV{'LC_ALL'}='C';
 328         # remember, perl uses the opposite t/f return as shell!!!
 329         $b_irc = ( system('tty >/dev/null') ) ? 1 : 0;
 330         # print "birc: $b_irc\n";
 331         $b_display = ( $ENV{'DISPLAY'} ) ? 1 : 0;
 332         $b_root = ( $ENV{'HOME'} eq '/root' ) ? 1 : 0;
 333         $dl{'dl'} = 'curl';
 334         $dl{'curl'} = 1;
 335         $dl{'tiny'} = 1; # note: two modules needed, tested for in set_downloader
 336         $dl{'wget'} = 1;
 337         $dl{'fetch'} = 1;
 338         $client{'console-irc'} = 0;
 339         $client{'dcop'} = (check_program('dcop')) ? 1 : 0;
 340         $client{'qdbus'} = (check_program('qdbus')) ? 1 : 0;
 341         $client{'konvi'} = 0;
 342         $client{'name'} = '';
 343         $client{'name-print'} = '';
 344         $client{'su-start'} = ''; # shows sudo/su
 345         $client{'version'} = '';
 346         $colors{'default'} = 2;
 347 }
 348
 349 # args: $1 - default OR override default cols max integer count. $_[0]
 350 # is the display width override.
 351 sub set_display_width {
 352         my ($width) = @_;
 353         if ( $width eq 'live' ){
 354                 ## sometimes tput will trigger an error (mageia) if irc client
 355                 if ( ! $b_irc ){
 356                         if ( check_program('tput') ) {
 357                                 # trips error if use qx()...
 358                                 chomp($size{'term'}=qx{tput cols});
 359                                 chomp($size{'term-lines'}=qx{tput lines});
 360                                 $size{'term-cols'} = $size{'term'};
 361                         }
 362                         # print "tc: $size{'term'} cmc: $size{'console'}\n";
 363                         # double check, just in case it's missing functionality or whatever
 364                         if ( $size{'term'} == 0 || $size{'term'} !~ /\d/ ){
 365                                 $size{'term'}=80;
 366                                 # we'll be using this for terminal dimensions later so don't set default.
 367                                 # $size{'term-lines'}=100;
 368                         }
 369                 }
 370                 # this lets you set different size for in or out of display server
 371                 # if ( ! $b_running_in_display && $configs{'COLS_MAX_NO_DISPLAY'} != 0 ){
 372                 #       $size{'console'}=$configs{'COLS_MAX_NO_DISPLAY'};
 373                 # }
 374                 # term_cols is set in top globals, using tput cols
 375                 # print "tc: $size{'term'} cmc: $size{'console'}\n";
 376                 if ( $size{'term'} < $size{'console'} ){
 377                         $size{'console'}=$size{'term'};
 378                 }
 379                 # adjust, some terminals will wrap if output cols == term cols
 380                 $size{'console'}=( $size{'console'} - 2 );
 381                 # echo cmc: $size{'console'}
 382                 # comes after source for user set stuff
 383                 if ( ! $b_irc ){
 384                         $size{'max'}=$size{'console'};
 385                 }
 386                 else {
 387                         $size{'max'}=$size{'irc'};
 388                 }
 389         }
 390         else {
 391                 $size{'max'}=$width;
 392         }
 393         # print "tc: $size{'term'} cmc: $size{'console'} cm: $size{'max'}\n";
 394 }
 395
 396 # only for dev/debugging BSD
 397 sub set_fake_tools {
 398         $system_files{'dmesg-boot'} = '/var/run/dmesg.boot' if $b_fake_dboot;
 399         $alerts{'pciconf'} = ({'action' => 'use'}) if $b_fake_pciconf;
 400         $alerts{'sysctl'} = ({'action' => 'use'}) if $b_fake_sysctl;
 401         if ($b_fake_usbdevs ){
 402                 $alerts{'usbdevs'} = ({'action' => 'use'});
 403                 $alerts{'lsusb'} = ({
 404                 'action' => 'missing',
 405                 'missing' => 'Required program lsusb not available',
 406                 });
 407         }
 408 }
 409
 410 # NOTE: most tests internally are against !$bsd_type
 411 sub set_os {
 412         @uname = uname();
 413         $os = lc($uname[0]);
 414         $cpu_arch = lc($uname[-1]);
 415         if ($cpu_arch =~ /arm|aarch/){$b_arm = 1}
 416         elsif ($cpu_arch =~ /mips/) {$b_mips = 1}
 417         # aarch32 mips32 intel/amd handled in cpu
 418         if ($cpu_arch =~ /(armv[1-7]|32|sparc_v9)/){
 419                 $bits_sys = 32;
 420         }
 421         elsif ($cpu_arch =~ /(alpha|64)/){
 422                 $bits_sys = 64;
 423         }
 424         if ( $os =~ /(bsd|dragonfly|darwin)/ ){
 425                 if ( $os =~ /openbsd/ ){
 426                         $os = 'openbsd';
 427                 }
 428                 elsif ($os =~ /darwin/){
 429                         $os = 'darwin';
 430                 }
 431                 if ($os =~ /kfreebsd/){
 432                         $bsd_type = 'debian-bsd';
 433                 }
 434                 else {
 435                         $bsd_type = $os;
 436                 }
 437         }
 438 }
 439
 440 # This data is hard set top of program but due to a specific project's
 441 # foolish idea that ignoring the FSH totally is somehow a positive step
 442 # forwards for free software, we also have to padd the results with PATH.
 443 sub set_path {
 444         # Extra path variable to make execute failures less likely, merged below
 445         my (@path);
 446         @paths = qw(/sbin /bin /usr/sbin /usr/bin /usr/local/sbin /usr/local/bin /usr/X11R6/bin);
 447         @path = split /:/, $ENV{'PATH'} if $ENV{'PATH'};
 448         # print "paths: @paths\nPATH: $ENV{'PATH'}\n";
 449         # Create a difference of $PATH and $extra_paths and add that to $PATH:
 450         foreach my $id (@path) {
 451                 if ( !(grep { /^$id$/ } @paths) && $id !~ /(game)/ ){
 452                         push @paths, $id;
 453                 }
 454         }
 455         # print "paths: @paths\n";
 456 }
 457
 458 sub set_sep {
 459         if ( $b_irc ){
 460                 # too hard to read if no colors, so force that for users on irc
 461                 if ($colors{'scheme'} == 0 ){
 462                         $sep{'s1'} = $sep{'s1-console'};
 463                         $sep{'s2'} = $sep{'s2-console'};
 464                 }
 465                 else {
 466                         $sep{'s1'} = $sep{'s1-irc'};
 467                         $sep{'s2'} = $sep{'s2-irc'};
 468                 }
 469         }
 470         else {
 471                 $sep{'s1'} = $sep{'s1-console'};
 472                 $sep{'s2'} = $sep{'s2-console'};
 473         }
 474 }
 475
 476 sub set_user_paths {
 477         my ( $b_conf, $b_data );
 478         # this needs to be set here because various options call the parent
 479         # initialize function directly.
 480         $self_path = $0;
 481         $self_path =~ s/[^\/]+$//;
 482         # print "0: $0 sp: $self_path\n";
 483
 484         if ( defined $ENV{'XDG_CONFIG_HOME'} && $ENV{'XDG_CONFIG_HOME'} ){
 485                 $user_config_dir=$ENV{'XDG_CONFIG_HOME'};
 486                 $b_conf=1;
 487         }
 488         elsif ( -d "$ENV{'HOME'}/.config" ){
 489                 $user_config_dir="$ENV{'HOME'}/.config";
 490                 $b_conf=1;
 491         }
 492         else {
 493                 $user_config_dir="$ENV{'HOME'}/.$self_name";
 494         }
 495         if ( defined $ENV{'XDG_DATA_HOME'} && $ENV{'XDG_DATA_HOME'} ){
 496                 $user_data_dir="$ENV{'XDG_DATA_HOME'}/$self_name";
 497                 $b_data=1;
 498         }
 499         elsif ( -d "$ENV{'HOME'}/.local/share" ){
 500                 $user_data_dir="$ENV{'HOME'}/.local/share/$self_name";
 501                 $b_data=1;
 502         }
 503         else {
 504                 $user_data_dir="$ENV{'HOME'}/.$self_name";
 505         }
 506         # note, this used to be created/checked in specific instance, but we'll just do it
 507         # universally so it's done at script start.
 508         if ( ! -d $user_data_dir ){
 509                 mkdir $user_data_dir;
 510                 # system "echo", "Made: $user_data_dir";
 511         }
 512         if ( $b_conf && -f "$ENV{'HOME'}/.$self_name/$self_name.conf" ){
 513                 #system 'mv', "-f $ENV{'HOME'}/.$self_name/$self_name.conf", $user_config_dir;
 514                 # print "WOULD: Moved $self_name.conf from $ENV{'HOME'}/.$self_name to $user_config_dir\n";
 515         }
 516         if ( $b_data && -d "$ENV{'HOME'}/.$self_name" ){
 517                 #system 'mv', '-f', "$ENV{'HOME'}/.$self_name/*", $user_data_dir;
 518                 #system 'rm', '-Rf', "$ENV{'HOME'}/.$self_name";
 519                 # print "WOULD: Moved data dir $ENV{'HOME'}/.$self_name to $user_data_dir\n";
 520         }
 521         $log_file="$user_data_dir/$self_name.log";
 522         #system 'echo', "$ENV{'HOME'}/.$self_name/* $user_data_dir";
 523         # print "scd: $user_config_dir sdd: $user_data_dir \n";
 524 }
 525
 526 # args: 1: set|hash key to return either null or path
 527 sub system_files {
 528         my ($file) = @_;
 529         if ( $file eq 'set'){
 530                 %files = (
 531                 'asound-cards' => '/proc/asound/cards',
 532                 'asound-modules' => '/proc/asound/modules',
 533                 'asound-version' => '/proc/asound/version',
 534                 'cpuinfo' => '/proc/cpuinfo',
 535                 'dmesg-boot' => '/var/run/dmesg.boot',
 536                 'lsb-release' => '/etc/lsb-release',
 537                 'mdstat' => '/proc/mdstat',
 538                 'meminfo' => '/proc/meminfo',
 539                 'modules' => '/proc/modules',
 540                 'mounts' => '/proc/mounts',
 541                 'os-release' => '/etc/os-release',
 542                 'partitions' => '/proc/partitions',
 543                 'scsi' => '/proc/scsi/scsi',
 544                 'version' => '/proc/version',
 545                 'xorg-log' => '/var/log/Xorg.0.log'
 546                 );
 547                 foreach ( keys %files ){
 548                         $system_files{$_} = ( -e $files{$_} ) ? $files{$_} : '';
 549                 }
 550                 if ( ! $system_files{'xorg-log'} && check_program('xset') ){
 551                         my $data = qx(xset q 2>/dev/null);
 552                         foreach ( split /\n/, $data){
 553                                 if ($_ =~ /Log file/i){
 554                                         $system_files{'xorg-log'} = get_piece($_,3);
 555                                         last;
 556                                 }
 557                         }
 558                 }
 559         }
 560         else {
 561                 return $system_files{$file};
 562         }
 563 }
 564
 565 ########################################################################
 566 #### UTILITIES
 567 ########################################################################
 568
 569 #### -------------------------------------------------------------------
 570 #### COLORS
 571 #### -------------------------------------------------------------------
 572
 573 ## arg: 1 - the type of action, either integer, count, or full
 574 sub get_color_scheme {
 575         my ($type) = @_;
 576         eval $start if $b_log;
 577         my @color_schemes = (
 578         [qw(EMPTY EMPTY EMPTY )],
 579         [qw(NORMAL NORMAL NORMAL )],
 580         # for dark OR light backgrounds
 581         [qw(BLUE NORMAL NORMAL)],
 582         [qw(BLUE RED NORMAL )],
 583         [qw(CYAN BLUE NORMAL )],
 584         [qw(DCYAN NORMAL NORMAL)],
 585         [qw(DCYAN BLUE NORMAL )],
 586         [qw(DGREEN NORMAL NORMAL )],
 587         [qw(DYELLOW NORMAL NORMAL )],
 588         [qw(GREEN DGREEN NORMAL )],
 589         [qw(GREEN NORMAL NORMAL )],
 590         [qw(MAGENTA NORMAL NORMAL)],
 591         [qw(RED NORMAL NORMAL)],
 592         # for light backgrounds
 593         [qw(BLACK DGREY NORMAL)],
 594         [qw(DBLUE DGREY NORMAL )],
 595         [qw(DBLUE DMAGENTA NORMAL)],
 596         [qw(DBLUE DRED NORMAL )],
 597         [qw(DBLUE BLACK NORMAL)],
 598         [qw(DGREEN DYELLOW NORMAL )],
 599         [qw(DYELLOW BLACK NORMAL)],
 600         [qw(DMAGENTA BLACK NORMAL)],
 601         [qw(DCYAN DBLUE NORMAL)],
 602         # for dark backgrounds
 603         [qw(WHITE GREY NORMAL)],
 604         [qw(GREY WHITE NORMAL)],
 605         [qw(CYAN GREY NORMAL )],
 606         [qw(GREEN WHITE NORMAL )],
 607         [qw(GREEN YELLOW NORMAL )],
 608         [qw(YELLOW WHITE NORMAL )],
 609         [qw(MAGENTA CYAN NORMAL )],
 610         [qw(MAGENTA YELLOW NORMAL)],
 611         [qw(RED CYAN NORMAL)],
 612         [qw(RED WHITE NORMAL )],
 613         [qw(BLUE WHITE NORMAL)],
 614         # miscellaneous
 615         [qw(RED BLUE NORMAL )],
 616         [qw(RED DBLUE NORMAL)],
 617         [qw(BLACK BLUE NORMAL)],
 618         [qw(BLACK DBLUE NORMAL)],
 619         [qw(NORMAL BLUE NORMAL)],
 620         [qw(BLUE MAGENTA NORMAL)],
 621         [qw(DBLUE MAGENTA NORMAL)],
 622         [qw(BLACK MAGENTA NORMAL)],
 623         [qw(MAGENTA BLUE NORMAL)],
 624         [qw(MAGENTA DBLUE NORMAL)],
 625         );
 626         if ($type eq 'count' ){
 627                 return scalar @color_schemes;
 628         }
 629         if ($type eq 'full' ){
 630                 return @color_schemes;
 631         }
 632         else {
 633                 return @{$color_schemes[$type]};
 634                 # print Dumper $color_schemes[$scheme_nu];
 635         }
 636         eval $end if $b_log;
 637 }
 638
 639 sub set_color_scheme {
 640         eval $start if $b_log;
 641         my ($scheme) = @_;
 642         $colors{'scheme'} = $scheme;
 643         my $index = ( $b_irc ) ? 1 : 0; # defaults to non irc
 644
 645         # NOTE: qw(...) kills the escape, it is NOT the same as using
 646         # Literal "..", ".." despite docs saying it is.
 647         my %color_palette = (
 648         'EMPTY' => [ '', '' ],
 649         'DGREY' => [ "\e[1;30m", "\x0314" ],
 650         'BLACK' => [ "\e[0;30m", "\x0301" ],
 651         'RED' => [ "\e[1;31m", "\x0304" ],
 652         'DRED' => [ "\e[0;31m", "\x0305" ],
 653         'GREEN' => [ "\e[1;32m", "\x0309" ],
 654         'DGREEN' => [ "\e[0;32m", "\x0303" ],
 655         'YELLOW' => [ "\e[1;33m", "\x0308" ],
 656         'DYELLOW' => [ "\e[0;33m", "\x0307" ],
 657         'BLUE' => [ "\e[1;34m", "\x0312" ],
 658         'DBLUE' => [ "\e[0;34m", "\x0302" ],
 659         'MAGENTA' => [ "\e[1;35m", "\x0313" ],
 660         'DMAGENTA' => [ "\e[0;35m", "\x0306" ],
 661         'CYAN' => [ "\e[1;36m", "\x0311" ],
 662         'DCYAN' => [ "\e[0;36m", "\x0310" ],
 663         'WHITE' => [ "\e[1;37m", "\x0300" ],
 664         'GREY' => [ "\e[0;37m", "\x0315" ],
 665         'NORMAL' => [ "\e[0m", "\x03" ],
 666         );
 667         my @scheme = get_color_scheme($colors{'scheme'});
 668         $colors{'c1'} = $color_palette{$scheme[0]}[$index];
 669         $colors{'c2'} = $color_palette{$scheme[1]}[$index];
 670         $colors{'cn'} = $color_palette{$scheme[2]}[$index];
 671         # print Dumper \@scheme;
 672         # print "$colors{'c1'}here$colors{'c2'} we are!$colors{'cn'}\n";
 673         eval $end if $b_log;
 674 }
 675
 676 sub set_colors {
 677         eval $start if $b_log;
 678         # it's already been set with -c 0-43
 679         if ( exists $colors{'c1'} ){
 680                 return 1;
 681         }
 682         # This let's user pick their color scheme. For IRC, only shows the color schemes,
 683         # no interactive. The override value only will be placed in user config files.
 684         # /etc/inxi.conf can also override
 685         if (exists $colors{'selector'}){
 686                 my $ob_selector = SelectColors->new($colors{'selector'});
 687                 $ob_selector->select_schema();
 688                 return 1;
 689         }
 690         # set the default, then override as required
 691         my $color_scheme = $colors{'default'};
 692         # these are set in user configs
 693         if (defined $colors{'global'}){
 694                 $color_scheme = $colors{'global'};
 695         }
 696         else {
 697                 if ( $b_irc ){
 698                         if (defined $colors{'irc-virt-term'} && $b_display && $client{'console-irc'}){
 699                                 $color_scheme = $colors{'irc-virt-term'};
 700                         }
 701                         elsif (defined $colors{'irc-console'} && !$b_display){
 702                                 $color_scheme = $colors{'irc-console'};
 703                         }
 704                         elsif ( defined $colors{'irc-gui'}) {
 705                                 $color_scheme = $colors{'irc-gui'};
 706                         }
 707                 }
 708                 else {
 709                         if (defined $colors{'console'} && !$b_display){
 710                                 $color_scheme = $colors{'console'};
 711                         }
 712                         elsif (defined $colors{'virt-term'}){
 713                                 $color_scheme = $colors{'virt-term'};
 714                         }
 715                 }
 716         }
 717         # force 0 for | or > output, all others prints to irc or screen
 718         if (!$b_irc && ! -t STDOUT ){
 719                 $color_scheme = 0;
 720         }
 721         set_color_scheme($color_scheme);
 722         eval $end if $b_log;
 723 }
 724
 725 ## SelectColors
 726 {
 727 package SelectColors;
 728
 729 # use warnings;
 730 # use strict;
 731 # use diagnostics;
 732 # use 5.008;
 733
 734 my (@data,@rows,%configs,%status);
 735 my ($type,$w_fh);
 736 my $safe_color_count = 12; # null/normal + default color group
 737 my $count = 0;
 738
 739 # args: 1 - type
 740 sub new {
 741         my $class = shift;
 742         ($type) = @_;
 743         my $self = {};
 744         return bless $self, $class;
 745 }
 746 sub select_schema {
 747         eval $start if $b_log;
 748         assign_selectors();
 749         main::set_color_scheme(0);
 750         set_status();
 751         start_selector();
 752         create_color_selections();
 753         if (! $b_irc ){
 754                 main::check_config_file();
 755                 get_selection();
 756         }
 757         else {
 758                 print_irc_message();
 759         }
 760         eval $end if $b_log;
 761 }
 762
 763 sub set_status {
 764         $status{'console'} = (defined $colors{'console'}) ? "Set: $colors{'console'}" : 'Not Set';
 765         $status{'virt-term'} = (defined $colors{'virt-term'}) ? "Set: $colors{'virt-term'}" : 'Not Set';
 766         $status{'irc-console'} = (defined $colors{'irc-console'}) ? "Set: $colors{'irc-console'}" : 'Not Set';
 767         $status{'irc-gui'} = (defined $colors{'irc-gui'}) ? "Set: $colors{'irc-gui'}" : 'Not Set';
 768         $status{'irc-virt-term'} = (defined $colors{'irc-virt-term'}) ? "Set: $colors{'irc-virt-term'}" : 'Not Set';
 769         $status{'global'} = (defined $colors{'global'}) ? "Set: $colors{'global'}" : 'Not Set';
 770 }
 771
 772 sub assign_selectors {
 773         if ($type == 94){
 774                 $configs{'variable'} = 'CONSOLE_COLOR_SCHEME';
 775                 $configs{'selection'} = 'console';
 776         }
 777         elsif ($type == 95){
 778                 $configs{'variable'} = 'VIRT_TERM_COLOR_SCHEME';
 779                 $configs{'selection'} = 'virt-term';
 780         }
 781         elsif ($type == 96){
 782                 $configs{'variable'} = 'IRC_COLOR_SCHEME';
 783                 $configs{'selection'} = 'irc-gui';
 784         }
 785         elsif ($type == 97){
 786                 $configs{'variable'} = 'IRC_X_TERM_COLOR_SCHEME';
 787                 $configs{'selection'} = 'irc-virt-term';
 788         }
 789         elsif ($type == 98){
 790                 $configs{'variable'} = 'IRC_CONS_COLOR_SCHEME';
 791                 $configs{'selection'} = 'irc-console';
 792         }
 793         elsif ($type == 99){
 794                 $configs{'variable'} = 'GLOBAL_COLOR_SCHEME';
 795                 $configs{'selection'} = 'global';
 796         }
 797 }
 798 sub start_selector {
 799         my $whoami = getpwuid($<) || "unknown???";
 800         if ( ! $b_irc ){
 801                 @data = (
 802                 [ 0, '', '', "Welcome to $self_name! Please select the default
 803                 $configs{'selection'} color scheme."],
 804                 );
 805         }
 806         @rows = (
 807         [ 0, '', '', "Because there is no way to know your $configs{'selection'}
 808         foreground/background colors, you can set your color preferences from
 809         color scheme option list below:"],
 810         [ 0, '', '', "0 is no colors; 1 is neutral."],
 811         [ 0, '', '', "After these, there are 4 sets:"],
 812         [ 0, '', '', "1-dark^or^light^backgrounds; 2-light^backgrounds;
 813         3-dark^backgrounds; 4-miscellaneous"],
 814         [ 0, '', '', ""],
 815         );
 816         push @data, @rows;
 817         if ( ! $b_irc ){
 818                 @rows = (
 819                 [ 0, '', '', "Please note that this will set the $configs{'selection'}
 820                 preferences only for user: $whoami"],
 821                 );
 822                 push @data, @rows;
 823         }
 824         @rows = (
 825         [ 0, '', '', "$line1"],
 826         );
 827         push @data, @rows;
 828         main::print_basic(@data);
 829         @data = ();
 830 }
 831 sub create_color_selections {
 832         my $spacer = '^^'; # printer removes double spaces, but replaces ^ with ' '
 833         $count = ( main::get_color_scheme('count') - 1 );
 834         for my $i (0 .. $count){
 835                 if ($i > 9){
 836                         $spacer = '^';
 837                 }
 838                 if ($configs{'selection'} =~ /^global|irc-gui|irc-console|irc-virt-term$/ && $i > $safe_color_count ){
 839                         last;
 840                 }
 841                 main::set_color_scheme($i);
 842                 @rows = (
 843                 [0, '', '', "$i)$spacer$colors{'c1'}Card:$colors{'c2'}^nVidia^GT218
 844                 $colors{'c1'}Display^Server$colors{'c2'}^x11^(X.Org^1.7.7)$colors{'cn'}"],
 845                 );
 846                 push @data, @rows;
 847         }
 848         main::print_basic(@data);
 849         @data = ();
 850         main::set_color_scheme(0);
 851 }
 852 sub get_selection {
 853         my $number = $count + 1;
 854         @data = (
 855         [0, '', '', ($number++) . ")^Remove all color settings. Restore $self_name default."],
 856         [0, '', '', ($number++) . ")^Continue, no changes or config file setting."],
 857         [0, '', '', ($number++) . ")^Exit, use another terminal, or set manually."],
 858         [0, '', '', "$line1"],
 859         [0, '', '', "Simply type the number for the color scheme that looks best to your
 860         eyes for your $configs{'selection'} settings and hit <ENTER>. NOTE: You can bring this
 861         option list up by starting $self_name with option: -c plus one of these numbers:"],
 862         [0, '', '', "94^-^console,^not^in^desktop^-^$status{'console'}"],
 863         [0, '', '', "95^-^terminal,^desktop^-^$status{'virt-term'}"],
 864         [0, '', '', "96^-^irc,^gui,^desktop^-^$status{'irc-gui'}"],
 865         [0, '', '', "97^-^irc,^desktop,^in^terminal^-^$status{'irc-virt-term'}"],
 866         [0, '', '', "98^-^irc,^not^in^desktop^-^$status{'irc-console'}"],
 867         [0, '', '', "99^-^global^-^$status{'global'}"],
 868         [0, '', '',  ""],
 869         [0, '', '', "Your selection(s) will be stored here: $user_config_file"],
 870         [0, '', '', "Global overrides all individual color schemes. Individual
 871         schemes remove the global setting."],
 872         [0, '', '', "$line1"],
 873         );
 874         main::print_basic(@data);
 875         @data = ();
 876         my $response = <STDIN>;
 877         chomp $response;
 878         if ($response =~ /([^0-9]|^$)/ || ( $response =~ /^[0-9]+$/ && $response > ($count + 3) )){
 879                 @data = (
 880                 [0, '', '', "Error - Invalid Selection. You entered this: $response. Hit <ENTER> to continue."],
 881                 [0, '', '',  "$line1"],
 882                 );
 883                 main::print_basic(@data);
 884                 my $response = <STDIN>;
 885                 start_selector();
 886                 create_color_selections();
 887                 get_selection();
 888         }
 889         else {
 890                 process_selection($response);
 891         }
 892 }
 893 sub process_selection {
 894         my $response = shift;
 895         if ($response == ($count + 3) ){
 896                 @data = ([0, '', '', "Ok, exiting $self_name now. You can set the colors later."],);
 897                 main::print_basic(@data);
 898                 exit 1;
 899         }
 900         elsif ($response == ($count + 2)){
 901                 @data = (
 902                 [0, '', '', "Ok, continuing $self_name unchanged."],
 903                 [0, '', '',  "$line1"],
 904                 );
 905                 main::print_basic(@data);
 906                 if ( defined $colors{'console'} && !$b_display ){
 907                         main::set_color_scheme($colors{'console'});
 908                 }
 909                 if ( defined $colors{'virt-term'} ){
 910                         main::set_color_scheme($colors{'virt-term'});
 911                 }
 912                 else {
 913                         main::set_color_scheme($colors{'default'});
 914                 }
 915         }
 916         elsif ($response == ($count + 1)){
 917                 @data = (
 918                 [0, '', '', "Removing all color settings from config file now..."],
 919                 [0, '', '',  "$line1"],
 920                 );
 921                 main::print_basic(@data);
 922                 delete_all_config_colors();
 923                 main::set_color_scheme($colors{'default'});
 924         }
 925         else {
 926                 main::set_color_scheme($response);
 927                 @data = (
 928                 [0, '', '', "Updating config file for $configs{'selection'} color scheme now..."],
 929                 [0, '', '',  "$line1"],
 930                 );
 931                 main::print_basic(@data);
 932                 if ($configs{'selection'} eq 'global'){
 933                         delete_all_config_colors();
 934                 }
 935                 set_config_color_scheme($response);
 936         }
 937 }
 938 sub delete_all_config_colors {
 939         my @file_lines = main::reader( $user_config_file );
 940         open( $w_fh, '>', $user_config_file ) or error_handler('open', $user_config_file, $!);
 941         foreach ( @file_lines ) {
 942                 if ( $_ !~ /^(CONSOLE_COLOR_SCHEME|GLOBAL_COLOR_SCHEME|IRC_COLOR_SCHEME|IRC_CONS_COLOR_SCHEME|IRC_X_TERM_COLOR_SCHEME|VIRT_TERM_COLOR_SCHEME)/){
 943                         print {$w_fh} "$_";
 944                 }
 945         }
 946         close $w_fh;
 947 }
 948 sub set_config_color_scheme {
 949         my $value = shift;
 950         my @file_lines = main::reader( $user_config_file );
 951         my $b_found = 0;
 952         open( $w_fh, '>', $user_config_file ) or error_handler('open', $user_config_file, $!);
 953         foreach ( @file_lines ) {
 954                 if ( $_ =~ /^$configs{'variable'}/ ){
 955                         $_ = "$configs{'variable'}=$value";
 956                         $b_found = 1;
 957                 }
 958                 print $w_fh "$_\n";
 959         }
 960         if (! $b_found ){
 961                 print $w_fh "$configs{'variable'}=$value\n";
 962         }
 963         close $w_fh;
 964 }
 965
 966 sub print_irc_message {
 967         @data = (
 968         [ 0, '', '', "$line1"],
 969         [ 0, '', '', "After finding the scheme number you like, simply run this again
 970         in a terminal to set the configuration data file for your irc client. You can
 971         set color schemes for the following: start inxi with -c plus:"],
 972         [ 0, '', '', "94 (console,^not^in^desktop^-^$status{'console'})"],
 973         [ 0, '', '', "95 (terminal, desktop^-^$status{'virt-term'})"],
 974         [ 0, '', '', "96 (irc,^gui,^desktop^-^$status{'irc-gui'})"],
 975         [ 0, '', '', "97 (irc,^desktop,^in terminal^-^$status{'irc-virt-term'})"],
 976         [ 0, '', '', "98 (irc,^not^in^desktop^-^$status{'irc-console'})"],
 977         [ 0, '', '', "99 (global^-^$status{'global'})"]
 978         );
 979         main::print_basic(@data);
 980         exit 1;
 981 }
 982
 983 }
 984
 985 #### -------------------------------------------------------------------
 986 #### CONFIGS
 987 #### -------------------------------------------------------------------
 988
 989 sub check_config_file {
 990         $user_config_file = "$user_config_dir/$self_name.conf";
 991         if ( ! -f $user_config_file ){
 992                 open( my $fh, '>', $user_config_file ) or error_handler('create', $user_config_file, $!);
 993         }
 994 }
 995
 996 sub get_configs {
 997         my (@configs) = @_;
 998         my ($key, $val,@config_files);
 999         if (!@configs){
1000                 @config_files = (
1001                 qq(/etc/$self_name.conf),
1002                 qq($user_config_dir/$self_name.conf)
1003                 );
1004         }
1005         else {
1006                 @config_files = (@configs);
1007         }
1008         # Config files should be passed in an array as a param to this function.
1009         # Default intended use: global @CONFIGS;
1010         foreach (@config_files) {
1011                 next unless open (my $fh, '<', "$_");
1012                 while (<$fh>) {
1013                         chomp;
1014                         s/#.*//;
1015                         s/^\s+//;
1016                         s/\s+$//;
1017                         s/'|"//g;
1018                         s/true/1/; # switch to 1/0 perl boolean
1019                         s/false/0/; # switch to 1/0 perl boolean
1020                         next unless length;
1021                         ($key, $val) = split(/\s*=\s*/, $_, 2);
1022                         get_config_item($key,$val);
1023                         # print "f: $file key: $key val: $val\n";
1024                 }
1025                 close $fh;
1026         }
1027 }
1028
1029 # args: 0: key; 1: value
1030 sub get_config_item {
1031         my ($key,$val) = @_;
1032         if ($key eq 'ALLOW_UPDATE' || $key eq 'B_ALLOW_UPDATE') {$b_update = int($val)}
1033         elsif ($key eq 'ALLOW_WEATHER' || $key eq 'B_ALLOW_WEATHER') {$b_weather = int($val)}
1034         elsif ($key eq 'CPU_SLEEP') {$cpu_sleep = $val if $val =~ /^[0-9\.]$/}
1035         elsif ($key eq 'DL_TIMEOUT') {$dl_timeout = int($val)}
1036         elsif ($key eq 'DOWNLOADER') {
1037                 if ($val =~ /^(curl|fetch|ftp|perl|wget)$/){
1038                         # this dumps all the other data and resets %dl for only the
1039                         # desired downloader.
1040                         $val = set_perl_downloader($val);
1041                         %dl = ('dl' => $val, $val => 1);
1042                 }}
1043         elsif ($key eq 'FILTER_STRING') {$filter_string = $val}
1044         elsif ($key eq 'LANGUAGE') {$language = $val if $val =~ /^(en)$/}
1045         elsif ($key eq 'LIMIT') {$limit = int($val)}
1046         elsif ($key eq 'OUTPUT_TYPE') {$output_type = $val if $val =~ /^json|screen|xml/}
1047         elsif ($key eq 'PS_COUNT') {$ps_count = int($val) }
1048         elsif ($key eq 'SENSORS_CPU_NO') {$sensors_cpu_nu = int($val)}
1049         elsif ($key eq 'SHOW_HOST' || $key eq 'B_SHOW_HOST') { $show{'host'} = int($val)}
1050         elsif ($key eq 'WEATHER_UNIT') {
1051                 $val = lc($val) if $val;
1052                 if ($val && $val =~ /^(c|f|cf|fc|i|m|im|mi)$/){
1053                         my %units = ('c'=>'m','f'=>'i','cf'=>'mi','fc'=>'im');
1054                         $val = $units{$val} if defined $units{$val};
1055                         $weather_unit = $val;
1056                 }
1057         }
1058         # layout
1059         elsif ($key eq 'CONSOLE_COLOR_SCHEME') {$colors{'console'} = int($val)}
1060         elsif ($key eq 'GLOBAL_COLOR_SCHEME') {$colors{'global'} = int($val)}
1061         elsif ($key eq 'IRC_COLOR_SCHEME') {$colors{'irc-gui'} = int($val)}
1062         elsif ($key eq 'IRC_CONS_COLOR_SCHEME') {$colors{'irc-console'} = int($val)}
1063         elsif ($key eq 'IRC_X_TERM_COLOR_SCHEME') {$colors{'irc-virt-term'} = int($val)}
1064         elsif ($key eq 'VIRT_TERM_COLOR_SCHEME') {$colors{'virt-term'} = int($val)}
1065         # note: not using the old short SEP1/SEP2
1066         elsif ($key eq 'SEP1_IRC') {$sep{'s1-irc'} = $val}
1067         elsif ($key eq 'SEP1_CONSOLE') {$sep{'s1-console'} = $val}
1068         elsif ($key eq 'SEP[23]_IRC') {$sep{'s2-irc'} = $val}
1069         elsif ($key eq 'SEP[23]_CONSOLE') {$sep{'s2-console'} = $val}
1070         # size
1071         elsif ($key eq 'COLS_MAX_CONSOLE') {$size{'console'} = int($val)}
1072         elsif ($key eq 'COLS_MAX_IRC') {$size{'irc'} = int($val)}
1073         elsif ($key eq 'COLS_MAX_NO_DISPLAY') {$size{'no-display'} = int($val)}
1074         elsif ($key eq 'INDENT') {$size{'indent'} = int($val)}
1075         elsif ($key eq 'INDENT_MIN') {$size{'indent-min'} = int($val)}
1076         #  print "mc: key: $key val: $val\n";
1077         # print Dumper (keys %size) . "\n";
1078 }
1079
1080 #### -------------------------------------------------------------------
1081 #### DEBUGGERS
1082 #### -------------------------------------------------------------------
1083
1084 # called in the initial -@ 10 program args setting so we can get logging
1085 # as soon as possible # will have max 3 files, inxi.log, inxi.1.log,
1086 # inxi.2.log
1087 sub begin_logging {
1088         return 1 if $fh_l; # if we want to start logging for testing before options
1089         my $log_file_2="$user_data_dir/$self_name.1.log";
1090         my $log_file_3="$user_data_dir/$self_name.2.log";
1091         my $data = '';
1092         $end='main::log_data("fe", (caller(1))[3], "");';
1093         $start='main::log_data("fs", (caller(1))[3], \@_);';
1094         #$t3 = tv_interval ($t0, [gettimeofday]);
1095         $t3 = eval 'Time::HiRes::tv_interval (\@t0, [Time::HiRes::gettimeofday()]);' if $b_hires;
1096         #print Dumper $@;
1097         my $now = strftime "%Y-%m-%d %H:%M:%S", localtime;
1098         return if $b_debug_timers;
1099         # do the rotation if logfile exists
1100         if ( -f $log_file ){
1101                 # copy if present second to third
1102                 if ( -f $log_file_2 ){
1103                         rename $log_file_2, $log_file_3 or error_handler('rename', "$log_file_2 -> $log_file_3", "$!");
1104                 }
1105                 # then copy initial to second
1106                 rename $log_file, $log_file_2 or error_handler('rename', "$log_file -> $log_file_2", "$!");
1107         }
1108         # now create the logfile
1109         # print "Opening log file for reading: $log_file\n";
1110         open $fh_l, '>', $log_file or error_handler(4, $log_file, "$!");
1111         # and echo the start data
1112         $data = $line2;
1113         $data .= "START $self_name LOGGING:\n";
1114         $data .= "NOTE: HiRes timer not available.\n" if !$b_hires;
1115         $data .= "$now\n";
1116         $data .= "Elapsed since start: $t3\n";
1117         $data .= "n: $self_name v: $self_version p: $self_patch d: $self_date\n";
1118         $data .= '@paths:' . joiner(\@paths, '::', 'unset') . "\n";
1119         $data .= $line2;
1120
1121         print $fh_l $data;
1122 }
1123
1124 # NOTE: no logging available until get_parameters is run, since that's what
1125 # sets logging # in order to trigger earlier logging manually set $b_log
1126 # to true in top variables.
1127 # args: $1 - type [fs|fe|cat|dump|raw] OR data to log
1128 # arg: $2 -
1129 # arg: $one type (fs/fe/cat/dump/raw) or logged data;
1130 # [$two is function name; [$three - function args]]
1131 sub log_data {
1132         return if ! $b_log;
1133         my ($one, $two, $three) = @_;
1134         my ($args,$data,$timer) = ('','','');
1135         my $spacer = '   ';
1136         # print "1: $one 2: $two 3: $three\n";
1137         if ($one eq 'fs') {
1138                 if (ref $three eq 'ARRAY'){
1139                         my @temp = @$three;
1140                         # print Data::Dumper::Dumper \@$three;
1141                         $args = "\n${spacer}Args: " . joiner($three, '; ', 'unset');
1142                 }
1143                 else {
1144                         $args = "\n${spacer}Args: None";
1145                 }
1146                 # $t1 = [gettimeofday];
1147                 #$t3 = tv_interval ($t0, [gettimeofday]);
1148                 $t3 = eval 'Time::HiRes::tv_interval(\@t0, [Time::HiRes::gettimeofday()])' if $b_hires;
1149                 #print Dumper $@;
1150                 $data = "Start: Function: $two$args\n${spacer}Elapsed: $t3\n";
1151                 $spacer='';
1152                 $timer = $data if $b_debug_timers;
1153         }
1154         elsif ( $one eq 'fe') {
1155                 # print 'timer:', Time::HiRes::tv_interval(\@t0, [Time::HiRes::gettimeofday()]),"\n";
1156                 #$t3 = tv_interval ($t0, [gettimeofday]);
1157                 eval '$t3 = Time::HiRes::tv_interval(\@t0, [Time::HiRes::gettimeofday()])' if $b_hires;
1158                 #print Dumper $t3;
1159                 $data = "${spacer}Elapsed: $t3\nEnd: Function: $two\n";
1160                 $spacer='';
1161                 $timer = $data if $b_debug_timers;
1162         }
1163         elsif ( $one eq 'cat') {
1164                 if ( $b_log_full ){
1165                         for my $file ($two){
1166                                 my $contents = do { local( @ARGV, $/ ) = $file; <> }; # or: qx(cat $file)
1167                                 $data = "$data${line3}Full file data: $file\n\n$contents\n$line3\n";
1168                         }
1169                         $spacer='';
1170                 }
1171         }
1172         elsif ($one eq 'cmd'){
1173                 $data = "Command: $two\n";
1174                 $data .= qx($two);
1175         }
1176         elsif ($one eq 'data'){
1177                 $data = "$two\n";
1178         }
1179         elsif ( $one eq 'dump') {
1180                 $data = "$two:\n";
1181                 if (ref $three eq 'HASH'){
1182                         $data .= Data::Dumper::Dumper \%$three;
1183                 }
1184                 elsif (ref $three eq 'ARRAY'){
1185                         # print Data::Dumper::Dumper \@$three;
1186                         $data .= Data::Dumper::Dumper \@$three;
1187                 }
1188                 else {
1189                         $data .= Data::Dumper::Dumper $three;
1190                 }
1191                 $data .= "\n";
1192                 # print $data;
1193         }
1194         elsif ( $one eq 'raw') {
1195                 if ( $b_log_full ){
1196                         $data = "\n${line3}Raw System Data:\n\n$two\n$line3";
1197                         $spacer='';
1198                 }
1199         }
1200         else {
1201                 $data = "$two\n";
1202         }
1203         if ($b_debug_timers){
1204                 print $timer if $timer;
1205         }
1206         #print "d: $data";
1207         elsif ($data){
1208                 print $fh_l "$spacer$data";
1209         }
1210 }
1211
1212 sub set_debugger {
1213         if ( $debug >= 20){
1214                 error_handler('not-in-irc', 'debug data generator') if $b_irc;
1215                 my $option = ( $debug > 22 ) ? 'main-full' : 'main';
1216                 $b_debug_gz = 1 if ($debug == 22 || $debug == 24);
1217                 my $ob_sys = SystemDebugger->new($option);
1218                 $ob_sys->run_debugger();
1219                 $ob_sys->upload_file($ftp_alt) if $debug > 20;
1220                 exit 0;
1221         }
1222         elsif ($debug >= 10 && $debug <= 12){
1223                 $b_log = 1;
1224                 if ($debug == 11){
1225                         $b_log_full = 1;
1226                 }
1227                 elsif ($debug == 12){
1228                         $b_log_colors = 1;
1229                 }
1230                 begin_logging();
1231         }
1232         elsif ($debug <= 3){
1233                 if ($debug == 3){
1234                         $b_log = 1;
1235                         $b_debug_timers = 1;
1236                         begin_logging();
1237                 }
1238                 else {
1239                         $end = '';
1240                         $start = '';
1241                 }
1242         }
1243 }
1244
1245 ## SystemDebugger
1246 {
1247 package SystemDebugger;
1248
1249 # use File::Find q(find);
1250 #no warnings 'File::Find';
1251 # use File::Spec::Functions;
1252 #use File::Copy;
1253 #use POSIX qw(strftime);
1254
1255 my $option = 'main';
1256 my ($data_dir,$debug_dir,$debug_gz,$parse_src,$upload) = ('','','','','');
1257 my @content = ();
1258 my $b_debug = 0;
1259 my $b_delete_dir = 1;
1260 # args: 1 - type
1261 # args: 2 - upload
1262 sub new {
1263         my $class = shift;
1264         ($option) = @_;
1265         my $self = {};
1266         # print "$f\n";
1267         # print "$option\n";
1268         return bless $self, $class;
1269 }
1270
1271 sub run_debugger {
1272         require File::Copy;
1273         import File::Copy;
1274         require File::Spec::Functions;
1275         import File::Spec::Functions;
1276
1277         print "Starting $self_name debugging data collector...\n";
1278         create_debug_directory();
1279         print "Note: for dmidecode data you must be root.\n" if !$b_root;
1280         print $line3;
1281         if (!$b_debug){
1282                 audio_data();
1283                 disk_data();
1284                 display_data();
1285                 network_data();
1286                 perl_modules();
1287                 system_data();
1288         }
1289         system_files();
1290         print $line3;
1291         if (!$b_debug){
1292                 if ( -d '/sys' && main::count_dir_files('/sys') ){
1293                         build_tree('sys');
1294                         sys_traverse_data();
1295                 }
1296                 else {
1297                         print "Skipping /sys data collection. /sys not present, or empty.\n";
1298                 }
1299                 print $line3;
1300                 # note: proc has some files that are apparently kernel processes, I've tried
1301                 # filtering them out but more keep appearing, so only run proc debugger if not root
1302                 if ( (!$b_root || $b_proc_debug ) && -d '/proc' && main::count_dir_files('/proc') ){
1303                         build_tree('proc');
1304                         proc_traverse_data();
1305                 }
1306                 else {
1307                         print "Skipping /proc data collection. /proc not present, or empty.\n";
1308                 }
1309                 print $line3;
1310         }
1311         run_self();
1312         print $line3;
1313         compress_dir();
1314 }
1315
1316 sub create_debug_directory {
1317         my $host = main::get_hostname();
1318         $host =~ s/ /-/g;
1319         $host = 'no-host' if !$host || $host eq 'N/A';
1320         my ($alt_string,$bsd_string,$root_string) = ('','','');
1321         # note: Time::Piece was introduced in perl 5.9.5
1322         my ($sec,$min,$hour,$mday,$mon,$year) = localtime;
1323         $year = $year+1900;
1324         $mon += 1;
1325         if (length($sec)  == 1) {$sec = "0$sec";}
1326         if (length($min)  == 1) {$min = "0$min";}
1327         if (length($hour) == 1) {$hour = "0$hour";}
1328         if (length($mon)  == 1) {$mon = "0$mon";}
1329         if (length($mday) == 1) {$mday = "0$mday";}
1330
1331         my $today = "$year-$mon-${mday}_$hour$min$sec";
1332         # my $date = strftime "-%Y-%m-%d_", localtime;
1333         if ($b_root){
1334                 $root_string = '-root';
1335         }
1336         $bsd_string = "-BSD-$bsd_type" if $bsd_type;
1337         if ($b_arm ){$alt_string = '-ARM'}
1338         elsif ($b_mips) {$alt_string = '-MIPS'}
1339         $debug_dir = "$self_name$alt_string$bsd_string-$host-$today$root_string-$self_version";
1340         $debug_gz = "$debug_dir.tar.gz";
1341         $data_dir = "$user_data_dir/$debug_dir";
1342         if ( -d $data_dir ){
1343                 unlink $data_dir or main::error_handler('remove', "$data_dir", "$!");
1344         }
1345         mkdir $data_dir or main::error_handler('mkdir', "$data_dir", "$!");
1346         if ( -e "$user_data_dir/$debug_gz" ){
1347                 #rmdir "$user_data_dir$debug_gz" or main::error_handler('remove', "$user_data_dir/$debug_gz", "$!");
1348                 print "Failed removing leftover directory:\n$user_data_dir$debug_gz error: $?" if system('rm','-rf',"$user_data_dir$debug_gz");
1349         }
1350         print "Data going into:\n$data_dir\n";
1351 }
1352 sub compress_dir {
1353         print "Creating tar.gz compressed file of this material...\n";
1354         print "File: $debug_gz\n";
1355         system("cd $user_data_dir; tar -czf $debug_gz $debug_dir");
1356         print "Removing $data_dir...\n";
1357         #rmdir $data_dir or print "failed removing: $data_dir error: $!\n";
1358         return 1 if !$b_delete_dir;
1359         if (system('rm','-rf',$data_dir) ){
1360                 print "Failed removing: $data_dir\nError: $?\n";
1361         }
1362         else {
1363                 print "Directory removed.\n";
1364         }
1365 }
1366 # NOTE: incomplete, don't know how to ever find out
1367 # what sound server is actually running, and is in control
1368 sub audio_data {
1369         my (%data,@files,@files2);
1370         print "Collecting audio data...\n";
1371         my @cmds = (
1372         ['aplay', '-l'], # alsa
1373         ['pactl', 'list'], # pulseaudio
1374         );
1375         run_commands(\@cmds,'audio');
1376         @files = main::globber('/proc/asound/card*/codec*');
1377         if (@files){
1378                 my $asound = qx(head -n 1 /proc/asound/card*/codec* 2>&1);
1379                 $data{'proc-asound-codecs'} = $asound;
1380         }
1381         else {
1382                 $data{'proc-asound-codecs'} = undef;
1383         }
1384
1385         write_data(\%data,'audio');
1386         @files = (
1387         '/proc/asound/cards',
1388         '/proc/asound/version',
1389         );
1390         @files2 = main::globber('/proc/asound/*/usbid');
1391         @files = (@files,@files2) if @files2;
1392         copy_files(\@files,'audio');
1393 }
1394 ## NOTE: >/dev/null 2>&1 is sh, and &>/dev/null is bash, fix this
1395 # ls -w 1 /sysrs > tester 2>&1
1396 sub disk_data {
1397         my (%data,@files,@files2);
1398         print "Collecting dev, label, disk, uuid data, df...\n";
1399         @files = (
1400         '/etc/fstab',
1401         '/etc/mtab',
1402         '/proc/mdstat',
1403         '/proc/mounts',
1404         '/proc/partitions',
1405         '/proc/scsi/scsi',
1406         '/proc/sys/dev/cdrom/info',
1407         );
1408         # very old systems
1409         if (-d '/proc/ide/'){
1410                 my @ides = main::globber('/proc/ide/*/*');
1411                 @files = (@files, @ides) if @ides;
1412         }
1413         else {
1414                 push (@files, '/proc-ide-directory');
1415         }
1416         copy_files(\@files, 'disk');
1417         my @cmds = (
1418         ['btrfs', 'filesystem show'],
1419         ['btrfs', 'filesystem show --mounted'],
1420         # ['btrfs', 'filesystem show --all-devices'],
1421         ['df', '-h -T'],
1422         ['df', '-h'],
1423         ['df', '-k'],
1424         ['df', '-k -T'],
1425         ['df', '-k -T -P'],
1426         ['df', '-P'],
1427         ['lsblk', '-fs'],
1428         ['lsblk', '-fsr'],
1429         ['lsblk', '-fsP'],
1430         ['lsblk', '-a'],
1431         ['lsblk', '-aP'],
1432         ['lsblk', '-ar'],
1433         ['lsblk', '-p'],
1434         ['lsblk', '-pr'],
1435         ['lsblk', '-pP'],
1436         ['lsblk', '-r'],
1437         ['lsblk', '-r --output NAME,PKNAME,TYPE,RM,FSTYPE,SIZE,LABEL,UUID,MOUNTPOINT'],
1438         ['lsblk', '-rb --output NAME,PKNAME,TYPE,RM,FSTYPE,SIZE,LABEL,UUID,MOUNTPOINT'],
1439         ['lsblk', '-Pb --output NAME,PKNAME,TYPE,RM,FSTYPE,SIZE'],
1440         ['lsblk', '-Pb --output NAME,TYPE,RM,FSTYPE,SIZE,LABEL,UUID,SERIAL,MOUNTPOINT'],
1441         ['gpart', 'list'],
1442         ['gpart', 'show'],
1443         ['gpart', 'status'],
1444         ['ls', '-l /dev'],
1445         ['ls', '-l /dev/disk'],
1446         ['ls', '-l /dev/disk/by-id'],
1447         ['ls', '-l /dev/disk/by-label'],
1448         ['ls', '-l /dev/disk/by-uuid'],
1449         # http://comments.gmane.org/gmane.linux.file-systems.zfs.user/2032
1450         ['ls', '-l /dev/disk/by-wwn'],
1451         ['ls', '-l /dev/disk/by-path'],
1452         ['ls', '-l /dev/mapper'],
1453         # LSI raid https://hwraid.le-vert.net/wiki/LSIMegaRAIDSAS
1454         ['megacli', '-AdpAllInfo -aAll'],
1455         ['megacli', '-LDInfo -L0 -a0'],
1456         ['megacli', '-PDList -a0'],
1457         ['megaclisas-status', ''],
1458         ['megaraidsas-status', ''],
1459         ['megasasctl', ''],
1460         ['mount', ''],
1461         ['nvme', 'present'],
1462         ['readlink', '/dev/root'],
1463         ['swapon', '-s'],
1464         # 3ware-raid
1465         ['tw-cli', 'info'],
1466         ['zfs', 'list'],
1467         ['zpool', 'list'],
1468         ['zpool', 'list -v'],
1469         );
1470         run_commands(\@cmds,'disk');
1471         @cmds = (
1472         ['atacontrol', 'list'],
1473         ['camcontrol', 'devlist'],
1474         ['glabel', 'status'],
1475         ['swapctl', '-l -k'],
1476         ['swapctl', '-l -k'],
1477         ['vmstat', '-H'],
1478         );
1479         run_commands(\@cmds,'disk-bsd');
1480 }
1481 sub display_data {
1482         my (%data,@files,@files2);
1483         my $working = '';
1484         if ( ! $b_display ){
1485                 print "Warning: only some of the data collection can occur if you are not in X\n";
1486                 main::toucher("$data_dir/display-data-warning-user-not-in-x");
1487         }
1488         if ( $b_root ){
1489                 print "Warning: only some of the data collection can occur if you are running as Root user\n";
1490                 main::toucher("$data_dir/display-data-warning-root-user");
1491         }
1492         print "Collecting Xorg log and xorg.conf files...\n";
1493         if ( -d "/etc/X11/xorg.conf.d/" ){
1494                 @files = main::globber("/etc/X11/xorg.conf.d/*");
1495         }
1496         else {
1497                 @files = ('/xorg-conf-d');
1498         }
1499         push (@files, $files{'xorg-log'});
1500         push (@files, '/etc/X11/xorg.conf');
1501         copy_files(\@files,'display-xorg');
1502         print "Collecting X, xprop, glxinfo, xrandr, xdpyinfo data, wayland, weston...\n";
1503         %data = (
1504         'desktop-session' => $ENV{'DESKTOP_SESSION'},
1505         'gdmsession' => $ENV{'GDMSESSION'},
1506         'gnome-desktop-session-id' => $ENV{'GNOME_DESKTOP_SESSION_ID'},
1507         'kde-full-session' => $ENV{'KDE_FULL_SESSION'},
1508         'kde-session-version' => $ENV{'KDE_SESSION_VERSION'},
1509         'vdpau-driver' => $ENV{'VDPAU_DRIVER'},
1510         'xdg-current-desktop' => $ENV{'XDG_CURRENT_DESKTOP'},
1511         'xdg-session-desktop' => $ENV{'XDG_SESSION_DESKTOP'},
1512         'xdg-vtnr' => $ENV{'XDG_VTNR'},
1513         # wayland data collectors:
1514         'xdg-session-type' => $ENV{'XDG_SESSION_TYPE'},
1515         'wayland-display' =>  $ENV{'WAYLAND_DISPLAY'},
1516         'gdk-backend' => $ENV{'GDK_BACKEND'},
1517         'qt-qpa-platform' => $ENV{'QT_QPA_PLATFORM'},
1518         'clutter-backend' => $ENV{'CLUTTER_BACKEND'},
1519         'sdl-videodriver' => $ENV{'SDL_VIDEODRIVER'},
1520         # program display values
1521         'size-indent' => $size{'indent'},
1522         'size-indent-min' => $size{'indent-min'},
1523         'size-cols-max' => $size{'max'},
1524         );
1525         write_data(\%data,'display');
1526         my @cmds = (
1527         # kde 5/plasma desktop 5, this is maybe an extra package and won't be used
1528         ['about-distro',''],
1529         ['aticonfig','--adapter=all --od-gettemperature'],
1530         ['glxinfo',''],
1531         ['glxinfo','-B'],
1532         ['kded','--version'],
1533         ['kded1','--version'],
1534         ['kded2','--version'],
1535         ['kded3','--version'],
1536         ['kded4','--version'],
1537         ['kded5','--version'],
1538         ['kded6','--version'],
1539         ['kf4-config','--version'],
1540         ['kf5-config','--version'],
1541         ['kf6-config','--version'],
1542         ['kwin_x11','--version'],
1543         ['loginctl','--no-pager list-sessions'],
1544         ['nvidia-settings','-q screens'],
1545         ['nvidia-settings','-c :0.0 -q all'],
1546         ['nvidia-smi','-q'],
1547         ['nvidia-smi','-q -x'],
1548         ['plasmashell','--version'],
1549         ['vainfo',''],
1550         ['vdpauinfo',''],
1551         ['weston-info',''],
1552         ['wmctrl','-m'],
1553         ['weston','--version'],
1554         ['xdpyinfo',''],
1555         ['Xorg','-version'],
1556         ['xprop','-root'],
1557         ['xrandr',''],
1558         );
1559         run_commands(\@cmds,'display');
1560 }
1561 sub network_data {
1562         print "Collecting networking data...\n";
1563 #       no warnings 'uninitialized';
1564         my @cmds = (
1565         ['ifconfig',''],
1566         ['ip','addr'],
1567         ['ip','-s link'],
1568         );
1569         run_commands(\@cmds,'network');
1570 }
1571 sub perl_modules {
1572         print "Collecting Perl module data (this can take a while)...\n";
1573         my @modules = ();
1574         my ($dirname,$holder,$mods,$value) = ('','','','');
1575         my $filename = 'perl-modules.txt';
1576         my @inc;
1577         foreach (sort @INC){
1578                 # some BSD installs have '.' n @INC path
1579                 if (-d $_ && $_ ne '.'){
1580                         $_ =~ s/\/$//; # just in case, trim off trailing slash
1581                         $value .= "EXISTS: $_\n";
1582                         push @inc, $_;
1583                 }
1584                 else {
1585                         $value .= "ABSENT: $_\n";
1586                 }
1587         }
1588         main::writer("$data_dir/perl-inc-data.txt",$value);
1589         File::Find::find { wanted => sub {
1590                 push @modules, File::Spec->canonpath($_) if /\.pm\z/
1591         }, no_chdir => 1 }, @inc;
1592         @modules = sort(@modules);
1593         foreach (@modules){
1594                 my $dir = $_;
1595                 $dir =~ s/[^\/]+$//;
1596                 if (!$holder || $holder ne $dir ){
1597                         $holder = $dir;
1598                         $value = "DIR: $dir\n";
1599                         $_ =~ s/^$dir//;
1600                         $value .= " $_\n";
1601                 }
1602                 else {
1603                         $value = $_;
1604                         $value =~ s/^$dir//;
1605                         $value = " $value\n";
1606                 }
1607                 $mods .= $value;
1608         }
1609         open (my $fh, '>', "$data_dir/$filename");
1610         print $fh $mods;
1611         close $fh;
1612 }
1613 sub system_data {
1614         print "Collecting system data...\n";
1615         my %data = (
1616         'cc' => $ENV{'CC'},
1617         # @(#)MIRBSD KSH R56 2018/03/09: ksh and mksh
1618         'ksh-version' => system('echo -n $KSH_VERSION'), # shell, not env, variable
1619         'manpath' => $ENV{'MANPATH'},
1620         'path' => $ENV{'PATH'},
1621         'xdg-config-home' => $ENV{'XDG_CONFIG_HOME'},
1622         'xdg-config-dirs' => $ENV{'XDG_CONFIG_DIRS'},
1623         'xdg-data-home' => $ENV{'XDG_DATA_HOME'},
1624         'xdg-data-dirs' => $ENV{'XDG_DATA_DIRS'},
1625         );
1626         my @files = main::globber('/usr/bin/gcc*');
1627         if (@files){
1628                 $data{'gcc-versions'} = join "\n",@files;
1629         }
1630         else {
1631                 $data{'gcc-versions'} = undef;
1632         }
1633         @files = main::globber('/sys/*');
1634         if (@files){
1635                 $data{'sys-tree-ls-1-basic'} = join "\n", @files;
1636         }
1637         else {
1638                 $data{'sys-tree-ls-1-basic'} = undef;
1639         }
1640         write_data(\%data,'system');
1641         # bsd tools http://cb.vu/unixtoolbox.xhtml
1642         my @cmds = (
1643         # general
1644         ['sysctl', '-b kern.geom.conftxt'],
1645         ['sysctl', '-b kern.geom.confxml'],
1646         ['usbdevs','-v'],
1647         # freebsd
1648         ['pciconf','-l -cv'],
1649         ['pciconf','-vl'],
1650         ['pciconf','-l'],
1651         # openbsd
1652         ['pcidump',''],
1653         ['pcidump','-v'],
1654         # netbsd
1655         ['kldstat',''],
1656         ['pcictl','list'],
1657         ['pcictl','list -ns'],
1658         );
1659         run_commands(\@cmds,'system-bsd');
1660         # diskinfo -v <disk>
1661         # fdisk <disk>
1662         @cmds = (
1663         ['clang','--version'],
1664         ['dmidecode',''],
1665         ['dmesg',''],
1666         ['gcc','--version'],
1667         ['hciconfig','-a'],
1668         ['initctl','list'],
1669         ['ipmi-sensors',''],
1670         ['ipmi-sensors','--output-sensor-thresholds'],
1671         ['ipmitool','sensor'],
1672         ['lscpu',''],
1673         ['lspci',''],
1674         ['lspci','-k'],
1675         ['lspci','-n'],
1676         ['lspci','-nn'],
1677         ['lspci','-nnk'],
1678         ['lspci','-nnkv'],# returns ports
1679         ['lspci','-nnv'],
1680         ['lspci','-mm'],
1681         ['lspci','-mmk'],
1682         ['lspci','-mmkv'],
1683         ['lspci','-mmv'],
1684         ['lspci','-mmnn'],
1685         ['lspci','-v'],
1686         ['lsusb',''],
1687         ['lsusb','-v'],
1688         ['ps','aux'],
1689         ['ps','-e'],
1690         ['ps','-p 1'],
1691         ['runlevel',''],
1692         ['rc-status','-a'],
1693         ['rc-status','-l'],
1694         ['rc-status','-r'],
1695         ['sensors',''],
1696         # leaving this commented out to remind that some systems do not
1697         # support strings --version, but will just simply hang at that command
1698         # which you can duplicate by simply typing: strings then hitting enter.
1699         # ['strings','--version'],
1700         ['strings','present'],
1701         ['sysctl','-a'],
1702         ['systemctl','list-units'],
1703         ['systemctl','list-units --type=target'],
1704         ['systemd-detect-virt',''],
1705         ['upower','-e'],
1706         ['uptime',''],
1707         ['vcgencmd','get_mem arm'],
1708         ['vcgencmd','get_mem gpu'],
1709         );
1710         run_commands(\@cmds,'system');
1711         @files = main::globber('/dev/bus/usb/*/*');
1712         copy_files(\@files, 'system');
1713 }
1714 sub system_files {
1715         print "Collecting system files data...\n";
1716         my (%data,@files,@files2);
1717         @files = RepoData::get($data_dir);
1718         copy_files(\@files, 'repo');
1719         # chdir "/etc";
1720         @files = main::globber('/etc/*[-_]{[rR]elease,[vV]ersion,issue}*');
1721         push (@files, '/etc/issue');
1722         push (@files, '/etc/lsb-release');
1723         push (@files, '/etc/os-release');
1724         copy_files(\@files,'system-distro');
1725         @files = main::globber('/etc/upstream[-_]{[rR]elease,[vV]ersion}/*');
1726         copy_files(\@files,'system-distro');
1727         @files = (
1728         '/proc/1/comm',
1729         '/proc/cpuinfo',
1730         '/proc/meminfo',
1731         '/proc/modules',
1732         '/proc/net/arp',
1733         '/proc/version',
1734         );
1735         @files2=main::globber('/sys/class/power_supply/*/uevent');
1736         if (@files2){
1737                 @files = (@files,@files2);
1738         }
1739         else {
1740                 push (@files, '/sys-class-power-supply-empty');
1741         }
1742         copy_files(\@files, 'system');
1743         @files = (
1744         '/etc/make.conf',
1745         '/etc/src.conf',
1746         '/var/run/dmesg.boot',
1747         );
1748         copy_files(\@files,'system-bsd');
1749 }
1750 ## SELF EXECUTE FOR LOG/OUTPUT
1751 sub run_self {
1752         print "Creating $self_name output file now. This can take a few seconds...\n";
1753         print "Starting $self_name from: $self_path\n";
1754         my $i = ($option eq 'main-full')? ' -i' : '';
1755         my $cmd = "$self_path/$self_name -FRfrploudmxxx$i -c 0 --usb --slots --debug 10 -y 120 > $data_dir/$self_name-FRfrploudmxxxyusbslots120.txt 2>&1";
1756         system($cmd);
1757         copy($log_file, "$data_dir") or main::error_handler('copy-failed', "$log_file", "$!");
1758         system("$self_path/$self_name --recommends -y 120 > $data_dir/$self_name-recommends-120.txt 2>&1");
1759 }
1760
1761 ## UTILITIES COPY/CMD/WRITE
1762 sub copy_files {
1763         my ($files_ref,$type,$alt_dir) = @_;
1764         my ($absent,$error,$good,$name,$unreadable);
1765         my $directory = ($alt_dir) ? $alt_dir : $data_dir;
1766         my $working = ($type ne 'proc') ? "$type-file-": '';
1767         foreach (@$files_ref) {
1768                 $name = $_;
1769                 $name =~ s/^\///;
1770                 $name =~ s/\//~/g;
1771                 # print "$name\n" if $type eq 'proc';
1772                 $name = "$directory/$working$name";
1773                 $good = $name . '.txt';
1774                 $absent = $name . '-absent';
1775                 $error = $name . '-error';
1776                 $unreadable = $name . '-unreadable';
1777                 # proc have already been tested for readable/exists
1778                 if ($type eq 'proc' || -e $_ ) {
1779                         if ($type eq 'proc' || -r $_){
1780                                 copy($_,"$good") or main::toucher($error);
1781                         }
1782                         else {
1783                                 main::toucher($unreadable);
1784                         }
1785                 }
1786                 else {
1787                         main::toucher($absent);
1788                 }
1789         }
1790 }
1791 sub run_commands {
1792         my ($cmds,$type) = @_;
1793         my $holder = '';
1794         my ($name,$cmd,$args);
1795         foreach (@$cmds){
1796                 my @rows = @$_;
1797                 if (my $program = main::check_program($rows[0])){
1798                         if ($rows[1] eq 'present'){
1799                                 $name = "$data_dir/$type-cmd-$rows[0]-present";
1800                                 main::toucher($name);
1801                         }
1802                         else {
1803                                 $args = $rows[1];
1804                                 $args =~ s/\s|--|\/|=/-/g; # for:
1805                                 $args =~ s/--/-/g;# strip out -- that result from the above
1806                                 $args =~ s/^-//g;
1807                                 $args = "-$args" if $args;
1808                                 $name = "$data_dir/$type-cmd-$rows[0]$args.txt";
1809                                 $cmd = "$program $rows[1] >$name 2>&1";
1810                                 system($cmd);
1811                         }
1812                 }
1813                 else {
1814                         if ($holder ne $rows[0]){
1815                                 $name = "$data_dir/$type-cmd-$rows[0]-absent";
1816                                 main::toucher($name);
1817                                 $holder = $rows[0];
1818                         }
1819                 }
1820         }
1821 }
1822 sub write_data {
1823         my ($data_ref, $type) = @_;
1824         my ($empty,$error,$fh,$good,$name,$undefined,$value);
1825         foreach (keys %$data_ref) {
1826                 $value = $$data_ref{$_};
1827                 $name = "$data_dir/$type-data-$_";
1828                 $good = $name . '.txt';
1829                 $empty = $name . '-empty';
1830                 $error = $name . '-error';
1831                 $undefined = $name . '-undefined';
1832                 if (defined $value) {
1833                         if ($value || $value eq '0'){
1834                                 open($fh, '>', $good) or main::toucher($error);
1835                                 print $fh "$value";
1836                         }
1837                         else {
1838                                 main::toucher($empty);
1839                         }
1840                 }
1841                 else {
1842                         main::toucher($undefined);
1843                 }
1844         }
1845 }
1846 ## TOOLS FOR DIRECTORY TREE/LS/TRAVERSE; UPLOADER
1847 sub build_tree {
1848         my ($which) = @_;
1849         if ( $which eq 'sys' && main::check_program('tree') ){
1850                 print "Constructing /$which tree data...\n";
1851                 my $dirname = '/sys';
1852                 my $cmd;
1853                 system("tree -a -L 10 /sys > $data_dir/sys-data-tree-full-10.txt");
1854                 opendir my($dh), $dirname or main::error_handler('open-dir',"$dirname", "$!");
1855                 my @files = readdir $dh;
1856                 closedir $dh;
1857                 foreach (@files){
1858                         next if /^\./;
1859                         $cmd = "tree -a -L 10 $dirname/$_ > $data_dir/sys-data-tree-$_-10.txt";
1860                         #print "$cmd\n";
1861                         system($cmd);
1862                 }
1863         }
1864         print "Constructing /$which ls data...\n";
1865         if ($which eq 'sys'){
1866                 directory_ls($which,1);
1867                 directory_ls($which,2);
1868                 directory_ls($which,3);
1869                 directory_ls($which,4);
1870         }
1871         elsif ($which eq 'proc') {
1872                 directory_ls('proc',1);
1873                 directory_ls('proc',2,'[a-z]');
1874                 # don't want the /proc/self or /proc/thread-self directories, those are
1875                 # too invasive
1876                 #directory_ls('proc',3,'[a-z]');
1877                 #directory_ls('proc',4,'[a-z]');
1878         }
1879 }
1880
1881 # include is basic regex for ls path syntax, like [a-z]
1882 sub directory_ls {
1883         my ( $dir,$depth,$include) = @_;
1884         $include ||= '';
1885         my ($exclude) = ('');
1886         # wd do NOT want to see anything in self or thread-self!!
1887         # $exclude = 'I self -I thread-self' if $dir eq 'proc';
1888         my $cmd = do {
1889                 if ( $depth == 1 ){ "ls -l $exclude /$dir/$include 2>/dev/null" }
1890                 elsif ( $depth == 2 ){ "ls -l $exclude /$dir/$include*/ 2>/dev/null" }
1891                 elsif ( $depth == 3 ){ "ls -l $exclude /$dir/$include*/*/ 2>/dev/null" }
1892                 elsif ( $depth == 4 ){ "ls -l $exclude /$dir/$include*/*/*/ 2>/dev/null" }
1893                 elsif ( $depth == 5 ){ "ls -l $exclude /$dir/$include*/*/*/*/ 2>/dev/null" }
1894                 elsif ( $depth == 5 ){ "ls -l $exclude /$dir/$include*/*/*/*/ 2>/dev/null" }
1895         };
1896         my @working = ();
1897         my $output = '';
1898         my ($type);
1899         my $result = qx($cmd);
1900         open my $ch, '<', \$result or main::error_handler('open-data',"$cmd", "$!");
1901         while ( my $line = <$ch> ){
1902                 chomp($line);
1903                 $line =~ s/^\s+|\s+$//g;
1904                 @working = split /\s+/, $line;
1905                 $working[0] ||= '';
1906                 if ( scalar @working > 7 ){
1907                         if ($working[0] =~ /^d/ ){
1908                                 $type = "d - ";
1909                         }
1910                         elsif ($working[0] =~ /^l/){
1911                                 $type = "l - ";
1912                         }
1913                         else {
1914                                 $type = "f - ";
1915                         }
1916                         $working[9] ||= '';
1917                         $working[10] ||= '';
1918                         $output = $output . "  $type$working[8] $working[9] $working[10]\n";
1919                 }
1920                 elsif ( $working[0] !~ /^total/ ){
1921                         $output = $output . $line . "\n";
1922                 }
1923         }
1924         close $ch;
1925         my $file = "$data_dir/$dir-data-ls-$depth.txt";
1926         open my $fh, '>', $file or main::error_handler('create',"$file", "$!");
1927         print $fh $output;
1928         close $fh;
1929         # print "$output\n";
1930 }
1931 sub proc_traverse_data {
1932         print "Building /proc file list...\n";
1933         # get rid pointless error:Can't cd to (/sys/kernel/) debug: Permission denied
1934         no warnings 'File::Find';
1935         $parse_src = 'proc';
1936         File::Find::find( \&wanted, "/proc");
1937         proc_traverse_processor();
1938         @content = ();
1939 }
1940 sub proc_traverse_processor {
1941         my ($data,$fh,$result,$row,$sep);
1942         my $proc_dir = "$data_dir/proc";
1943         print "Adding /proc files...\n";
1944         mkdir $proc_dir or main::error_handler('mkdir', "$proc_dir", "$!");
1945         # @content = sort @content;
1946         copy_files(\@content,'proc',$proc_dir);
1947 #       foreach (@content){
1948 #               print "$_\n";
1949 #       }
1950 }
1951
1952 sub sys_traverse_data {
1953         print "Building /sys file list...\n";
1954         # get rid pointless error:Can't cd to (/sys/kernel/) debug: Permission denied
1955         no warnings 'File::Find';
1956         $parse_src = 'sys';
1957         File::Find::find( \&wanted, "/sys");
1958         sys_traverse_processsor();
1959         @content = ();
1960 }
1961 sub sys_traverse_processsor {
1962         my ($data,$fh,$result,$row,$sep);
1963         my $filename = "sys-data-parse.txt";
1964         print "Parsing /sys files...\n";
1965         # no sorts, we want the order it comes in
1966         # @content = sort @content;
1967         foreach (@content){
1968                 $data='';
1969                 $sep='';
1970                 my $b_fh = 1;
1971                 open($fh, '<', $_) or $b_fh = 0;
1972                 # needed for removing -T test and root
1973                 if ($b_fh){
1974                         while ($row = <$fh>) {
1975                                 chomp $row;
1976                                 $data .= $sep . '"' . $row . '"';
1977                                 $sep=', ';
1978                         }
1979                 }
1980                 else {
1981                         $data = '<unreadable>';
1982                 }
1983                 $result .= "$_:[$data]\n";
1984                 # print "$_:[$data]\n"
1985         }
1986         # print scalar @content . "\n";
1987         open ($fh, '>', "$data_dir/$filename");
1988         print $fh $result;
1989         close $fh;
1990         # print $fh "$result";
1991 }
1992 sub wanted {
1993         return if -d; # not directory
1994         return unless -e; # Must exist
1995         return unless -f; # Must be file
1996         return unless -r; # Must be readable
1997         if ($parse_src eq 'sys'){
1998                 # note: a new file in 4.11 /sys can hang this, it is /parameter/ then
1999                 # a few variables. Since inxi does not need to see that file, we will
2000                 # not use it. Also do not need . files or __ starting files
2001                 # print $File::Find::name . "\n";
2002                 # block maybe: cfgroup\/
2003                 return if $File::Find::name =~ /\/(\.[a-z]|kernel\/|parameters\/|debug\/)/;
2004                 # comment this one out if you experience hangs or if
2005                 # we discover syntax of foreign language characters
2006                 # Must be ascii like. This is questionable and might require further
2007                 # investigation, it is removing some characters that we might want
2008                 # NOTE: this made a bunch of files on arm systems unreadable so we handle
2009                 # the readable tests in copy_files()
2010                 # return unless -T;
2011         }
2012         elsif ($parse_src eq 'proc') {
2013                 return if $File::Find::name =~ /^\/proc\/[0-9]+\//;
2014                 return if $File::Find::name =~ /^\/proc\/bus\/pci\//;
2015                 return if $File::Find::name =~ /^\/proc\/(irq|spl|sys)\//;
2016                 # these choke on sudo/root: kmsg kcore kpage and we don't want keys or kallsyms
2017                 return if $File::Find::name =~ /^\/proc\/k/;
2018                 return if $File::Find::name =~ /(\/mb_groups|debug)$/;
2019         }
2020         # print $File::Find::name . "\n";
2021         push (@content, $File::Find::name);
2022         return;
2023 }
2024 # args: 1 - path to file to be uploaded
2025 # args: 2 - optional: alternate ftp upload url
2026 # NOTE: must be in format: ftp.site.com/incoming
2027 sub upload_file {
2028         require Net::FTP;
2029         import Net::FTP;
2030         my ($self, $ftp_url) = @_;
2031         my ($ftp, $domain, $host, $user, $pass, $dir, $error);
2032         $ftp_url ||= main::get_defaults('ftp-upload');
2033         $ftp_url =~ s/\/$//g; # trim off trailing slash if present
2034         my @url = split(/\//, $ftp_url);
2035         my $file_path = "$user_data_dir/$debug_gz";
2036         $host = $url[0];
2037         $dir = $url[1];
2038         $domain = $host;
2039         $domain =~ s/^ftp\.//;
2040         $user = "anonymous";
2041         $pass = "anonymous\@$domain";
2042
2043         print $line3;
2044         print "Uploading to: $ftp_url\n";
2045         # print "$host $domain $dir $user $pass\n";
2046         print "File to be uploaded:\n$file_path\n";
2047
2048         if ($host && ( $file_path && -e $file_path ) ){
2049                 # NOTE: important: must explicitly set to passive true/1
2050                 $ftp = Net::FTP->new($host, Debug => 0, Passive => 1);
2051                 $ftp->login($user, $pass) || main::error_handler('ftp-login', $ftp->message);
2052                 $ftp->binary();
2053                 $ftp->cwd($dir);
2054                 print "Connected to FTP server.\n";
2055                 $ftp->put($file_path) || main::error_handler('ftp-upload', $ftp->message);
2056                 $ftp->quit;
2057                 print "Uploaded file successfully!\n";
2058                 print $ftp->message;
2059                 if ($b_debug_gz){
2060                         print "Removing debugger gz file:\n$file_path\n";
2061                         unlink $file_path or main::error_handler('remove',"$file_path", "$!");
2062                         print "File removed.\n";
2063                 }
2064                 print "Debugger data generation and upload completed. Thank you for your help.\n";
2065         }
2066         else {
2067                 main::error_handler('ftp-bad-path', "$file_path");
2068         }
2069 }
2070 }
2071
2072 #### -------------------------------------------------------------------
2073 #### DOWNLOADER
2074 #### -------------------------------------------------------------------
2075
2076 sub download_file {
2077         my ($type, $url, $file) = @_;
2078         my ($cmd,$args,$timeout) = ('','','');
2079         my $debug_data = '';
2080         my $result = 1;
2081         $dl{'no-ssl-opt'} ||= '';
2082         $dl{'spider'} ||= '';
2083         $file ||= 'N/A'; # to avoid debug error
2084         if ( ! $dl{'dl'} ){
2085                 return 0;
2086         }
2087         if ($dl{'timeout'}){
2088                 $timeout = "$dl{'timeout'}$dl_timeout";
2089         }
2090         # print "$dl{'no-ssl-opt'}\n";
2091         # print "$dl{'dl'}\n";
2092         # tiny supports spider sort of
2093         ## NOTE: 1 is success, 0 false for Perl
2094         if ($dl{'dl'} eq 'tiny' ){
2095                 $cmd = "Using tiny: type: $type \nurl: $url \nfile: $file";
2096                 $result = get_file($type, $url, $file);
2097                 $debug_data = ($type ne 'stdout') ? $result : 'Success: stdout data not null.';
2098         }
2099         # But: 0 is success, and 1 is false for these
2100         # when strings are returned, they will be taken as true
2101         else {
2102                 if ($type eq 'stdout'){
2103                         $args = $dl{'stdout'};
2104                         $cmd = "$dl{'dl'} $dl{'no-ssl-opt'} $timeout $args $url $dl{'null'}";
2105                         $result = qx($cmd);
2106                         $debug_data = ($result) ? 'Success: stdout data not null.' : 'Download resulted in null data!';
2107                 }
2108                 elsif ($type eq 'file') {
2109                         $args = $dl{'file'};
2110                         $cmd = "$dl{'dl'} $dl{'no-ssl-opt'} $timeout $args $file $url $dl{'null'}";
2111                         system($cmd);
2112                         $result = ($?) ? 0 : 1; # reverse these into Perl t/f
2113                         $debug_data = $result;
2114                 }
2115                 elsif ( $dl{'dl'} eq 'wget' && $type eq 'spider'){
2116                         $cmd = "$dl{'dl'} $dl{'no-ssl-opt'} $timeout $dl{'spider'} $url";
2117                         system($cmd);
2118                         $result = ($?) ? 0 : 1; # reverse these into Perl t/f
2119                         $debug_data = $result;
2120                 }
2121         }
2122         print "-------\nDownloader Data:\n$cmd\nResult: $debug_data\n" if $test[1];
2123         log_data('data',"$cmd\nResult: $result") if $b_log;
2124         return $result;
2125 }
2126
2127 sub get_file {
2128         my ($type, $url, $file) = @_;
2129         my $response = HTTP::Tiny->new->get($url);
2130         my $return = 1;
2131         my $debug = 0;
2132         my $fh;
2133         $file ||= 'N/A';
2134         log_data('dump','%{$response}',\%{$response}) if $b_log;
2135         # print Dumper \%{$response};
2136         if ( ! $response->{success} ){
2137                 my $content = $response->{content};
2138                 $content ||= "N/A\n";
2139                 my $msg = "Failed to connect to server/file!\n";
2140                 $msg .= "Response: ${content}Downloader: HTTP::Tiny URL: $url\nFile: $file";
2141                 log_data('data',$msg) if $b_log;
2142                 print error_defaults('download-error',$msg) if $test[1];
2143                 $return = 0;
2144         }
2145         else {
2146                 if ( $debug ){
2147                         print "$response->{success}\n";
2148                         print "$response->{status} $response->{reason}\n";
2149                         while (my ($key, $value) = each %{$response->{headers}}) {
2150                                 for (ref $value eq "ARRAY" ? @$value : $value) {
2151                                         print "$key: $_\n";
2152                                 }
2153                         }
2154                 }
2155                 if ( $type eq "stdout" || $type eq "ua-stdout" ){
2156                         $return = $response->{content};
2157                 }
2158                 elsif ($type eq "spider"){
2159                         # do nothing, just use the return value
2160                 }
2161                 elsif ($type eq "file"){
2162                         open($fh, ">", $file);
2163                         print $fh $response->{content}; # or die "can't write to file!\n";
2164                         close $fh;
2165                 }
2166         }
2167         return $return;
2168 }
2169
2170 sub set_downloader {
2171         eval $start if $b_log;
2172         $dl{'no-ssl'} = '';
2173         $dl{'null'} = '';
2174         $dl{'spider'} = '';
2175         # we only want to use HTTP::Tiny if it's present in user system.
2176         # It is NOT part of core modules. IO::Socket::SSL is also required
2177         # For some https connections so only use tiny as option if both present
2178         if ($dl{'tiny'}){
2179                 if (check_module('HTTP::Tiny') && check_module('IO::Socket::SSL')){
2180                         import HTTP::Tiny;
2181                         import IO::Socket::SSL;
2182                         $dl{'tiny'} = 1;
2183                 }
2184                 else {
2185                         $dl{'tiny'} = 0;
2186                 }
2187         }
2188         #print $dl{'tiny'} . "\n";
2189         if ($dl{'tiny'}){
2190                 $dl{'dl'} = 'tiny';
2191                 $dl{'file'} = '';
2192                 $dl{'stdout'} = '';
2193                 $dl{'timeout'} = '';
2194         }
2195         elsif ( $dl{'curl'} && check_program('curl')  ){
2196                 $dl{'dl'} = 'curl';
2197                 $dl{'file'} = '  -L -s -o ';
2198                 $dl{'no-ssl'} = ' --insecure';
2199                 $dl{'stdout'} = ' -L -s ';
2200                 $dl{'timeout'} = ' -y ';
2201         }
2202         elsif ($dl{'wget'} && check_program('wget') ){
2203                 $dl{'dl'} = 'wget';
2204                 $dl{'file'} = ' -q -O ';
2205                 $dl{'no-ssl'} = ' --no-check-certificate';
2206                 $dl{'spider'} = ' -q --spider';
2207                 $dl{'stdout'} = '  -q -O -';
2208                 $dl{'timeout'} = ' -T ';
2209         }
2210         elsif ($dl{'fetch'} && check_program('fetch')){
2211                 $dl{'dl'} = 'fetch';
2212                 $dl{'file'} = ' -q -o ';
2213                 $dl{'no-ssl'} = ' --no-verify-peer';
2214                 $dl{'stdout'} = ' -q -o -';
2215                 $dl{'timeout'} = ' -T ';
2216         }
2217         elsif ( $bsd_type eq 'openbsd' && check_program('ftp') ){
2218                 $dl{'dl'} = 'ftp';
2219                 $dl{'file'} = ' -o ';
2220                 $dl{'null'} = ' 2>/dev/null';
2221                 $dl{'stdout'} = ' -o - ';
2222                 $dl{'timeout'} = '';
2223         }
2224         else {
2225                 $dl{'dl'} = '';
2226         }
2227         # no-ssl-opt is set to 1 with --no-ssl, so it is true, then assign
2228         $dl{'no-ssl-opt'} = $dl{'no-ssl'} if $dl{'no-ssl-opt'};
2229         eval $end if $b_log;
2230 }
2231
2232 sub set_perl_downloader {
2233         my ($downloader) = @_;
2234         $downloader =~ s/perl/tiny/;
2235         return $downloader;
2236 }
2237
2238 #### -------------------------------------------------------------------
2239 #### ERROR HANDLER
2240 #### -------------------------------------------------------------------
2241
2242 sub error_handler {
2243         eval $start if $b_log;
2244         my ( $err, $one, $two) = @_;
2245         my ($b_help,$b_recommends);
2246         my ($b_exit,$errno) = (1,0);
2247         my $message = do {
2248                 if ( $err eq 'empty' ) { 'empty value' }
2249                 ## Basic rules
2250                 elsif ( $err eq 'not-in-irc' ) {
2251                         $errno=1; "You can't run option $one in an IRC client!" }
2252                 ## Internal/external options
2253                 elsif ( $err eq 'bad-arg' ) {
2254                         $errno=10; $b_help=1; "Unsupported value: $two for option: $one" }
2255                 elsif ( $err eq 'bad-arg-int' ) {
2256                         $errno=11; "Bad internal argument: $one" }
2257                 elsif ( $err eq 'distro-block' ) {
2258                         $errno=20; "Option: $one has been disabled by the $self_name distribution maintainer." }
2259                 elsif ( $err eq 'option-feature-incomplete' ) {
2260                         $errno=21; "Option: '$one' feature: '$two' has not been implemented yet." }
2261                 elsif ( $err eq 'unknown-option' ) {
2262                         $errno=22; $b_help=1; "Unsupported option: $one" }
2263                 ## Data
2264                 elsif ( $err eq 'open-data' ) {
2265                         $errno=32; "Error opening data for reading: $one \nError: $two" }
2266                 elsif ( $err eq 'download-error' ) {
2267                         $errno=33; "Error downloading file with $dl{'dl'}: $one \nError: $two" }
2268                 ## Files:
2269                 elsif ( $err eq 'copy-failed' ) {
2270                         $errno=40; "Error copying file: $one \nError: $two" }
2271                 elsif ( $err eq 'create' ) {
2272                         $errno=41; "Error creating file: $one \nError: $two" }
2273                 elsif ( $err eq 'downloader-error' ) {
2274                         $errno=42; "Error downloading file: $one \nfor download source: $two" }
2275                 elsif ( $err eq 'file-corrupt' ) {
2276                         $errno=43; "Downloaded file is corrupted: $one" }
2277                 elsif ( $err eq 'mkdir' ) {
2278                         $errno=44; "Error creating directory: $one \nError: $two" }
2279                 elsif ( $err eq 'open' ) {
2280                         $errno=45; $b_exit=0; "Error opening file: $one \nError: $two" }
2281                 elsif ( $err eq 'open-dir' ) {
2282                         $errno=46; "Error opening directory: $one \nError: $two" }
2283                 elsif ( $err eq 'output-file-bad' ) {
2284                         $errno=47; "Value for --output-file must be full path, a writable directory, \nand include file name. Path: $two" }
2285                 elsif ( $err eq 'not-writable' ) {
2286                         $errno=48; "The file: $one is not writable!" }
2287                 elsif ( $err eq 'open-dir-failed' ) {
2288                         $errno=49; "The directory: $one failed to open with error: $two" }
2289                 elsif ( $err eq 'remove' ) {
2290                         $errno=50; "Failed to remove file: $one Error: $two" }
2291                 elsif ( $err eq 'rename' ) {
2292                         $errno=51; "There was an error moving files: $one\nError: $two" }
2293                 elsif ( $err eq 'write' ) {
2294                         $errno=52; "Failed writing file: $one - Error: $two!" }
2295                 ## Downloaders
2296                 elsif ( $err eq 'missing-downloader' ) {
2297                         $errno=60; "Downloader program $two could not be located on your system." }
2298                 elsif ( $err eq 'missing-perl-downloader' ) {
2299                         $errno=61; $b_recommends=1; "Perl downloader missing required module." }
2300                 ## FTP
2301                 elsif ( $err eq 'ftp-bad-path' ) {
2302                         $errno=70; "Unable to locate for FTP upload file:\n$one" }
2303                 elsif ( $err eq 'ftp-login' ) {
2304                         $errno=71; "There was an error with login to ftp server: $one" }
2305                 elsif ( $err eq 'ftp-upload' ) {
2306                         $errno=72; "There was an error with upload to ftp server: $one" }
2307                 ## Modules
2308                 elsif ( $err eq 'required-module' ) {
2309                         $errno=80; $b_recommends=1; "The required $one Perl module is not installed:\n$two" }
2310                 ## DEFAULT
2311                 else {
2312                         $errno=255; "Error handler ERROR!! Unsupported options: $err!"}
2313         };
2314         print_line("Error $errno: $message\n");
2315         if ($b_help){
2316                 print_line("Check -h for correct parameters.\n");
2317         }
2318         if ($b_recommends){
2319                 print_line("See --recommends for more information.\n");
2320         }
2321         eval $end if $b_log;
2322         exit 0 if $b_exit;
2323 }
2324
2325 sub error_defaults {
2326         my ($type,$one) = @_;
2327         $one ||= '';
2328         my %errors = (
2329         'download-error' => "Download Failure:\n$one\n",
2330         );
2331         return $errors{$type};
2332 }
2333
2334 #### -------------------------------------------------------------------
2335 #### RECOMMENDS
2336 #### -------------------------------------------------------------------
2337
2338 ## CheckRecommends
2339 {
2340 package CheckRecommends;
2341 sub run {
2342         main::error_handler('not-in-irc', 'recommends') if $b_irc;
2343         my (@data,@rows);
2344         my $line = make_line();
2345         my $pm = get_pm();
2346         @data = basic_data($line);
2347         push @rows,@data;
2348         if (!$bsd_type){
2349                 @data = check_items('required system directories',$line,$pm);
2350                 push @rows,@data;
2351         }
2352         @data = check_items('recommended system programs',$line,$pm);
2353         push @rows,@data;
2354         @data = check_items('recommended display information programs',$line,$pm);
2355         push @rows,@data;
2356         @data = check_items('recommended downloader programs',$line,$pm);
2357         push @rows,@data;
2358         @data = check_items('recommended Perl modules',$line,$pm);
2359         push @rows,@data;
2360         @data = check_items('recommended directories',$line,'');
2361         push @rows,@data;
2362         @data = check_items('recommended files',$line,'');
2363         push @rows,@data;
2364         @data = (
2365         ['0', '', '', "$line"],
2366         ['0', '', '', "Ok, all done with the checks. Have a nice day."],
2367         ['0', '', '', " "],
2368         );
2369         push @rows,@data;
2370         #print Data::Dumper::Dumper \@rows;
2371         main::print_basic(@rows);
2372         exit 1;
2373 }
2374
2375 sub basic_data {
2376         my ($line) = @_;
2377         my (@data,@rows);
2378         my $client = $client{'name-print'};
2379         $client .= ' ' . $client{'version'} if $client{'version'};
2380         my $default_shell = 'N/A';
2381         if ($ENV{'SHELL'}){
2382                 $default_shell = $ENV{'SHELL'};
2383                 $default_shell =~ s/.*\///;
2384         }
2385         my $sh = main::check_program('sh');
2386         my $sh_real = Cwd::abs_path($sh);
2387         @rows = (
2388         ['0', '', '', "$self_name will now begin checking for the programs it needs
2389         to operate."],
2390         ['0', '', '', "" ],
2391         ['0', '', '', "Check $self_name --help or the man page (man $self_name)
2392         to see what options are available." ],
2393         ['0', '', '', "$line" ],
2394         ['0', '', '', "Test: core tools:" ],
2395         ['0', '', '', "" ],
2396         ['0', '', '', "Perl version: ^$]" ],
2397         ['0', '', '', "Current shell: " . $client ],
2398         ['0', '', '', "Default shell: " . $default_shell ],
2399         ['0', '', '', "sh links to: $sh_real" ],
2400         );
2401         return @rows;
2402 }
2403 sub check_items {
2404         my ($type,$line,$pm) = @_;
2405         my (@data,%info,@missing,$row,@rows,$result,@unreadable);
2406         my ($b_dir,$b_file,$b_module,$b_program,$item);
2407         my ($about,$extra,$extra2,$extra3,$extra4,$info_os,$install) = ('','','','','','info','');
2408         if ($type eq 'required system directories'){
2409                 @data = qw(/proc /sys);
2410                 $b_dir = 1;
2411                 $item = 'Directory';
2412         }
2413         elsif ($type eq 'recommended system programs'){
2414                 if ($bsd_type){
2415                         @data = qw(camcontrol dig dmidecode fdisk file glabel gpart ifconfig ipmi-sensors
2416                         ipmitool lsusb sudo smartctl sysctl tree upower uptime usbdevs);
2417                         $info_os = 'info-bsd';
2418                 }
2419                 else {
2420                         @data = qw(dig dmidecode fdisk file hddtemp ifconfig ip ipmitool ipmi-sensors
2421                         lsblk lsusb modinfo runlevel sensors strings sudo tree upower uptime);
2422                 }
2423                 $b_program = 1;
2424                 $item = 'Program';
2425                 $extra2 = "Note: IPMI sensors are generally only found on servers. To access
2426                 that data, you only need one of the ipmi items.";
2427         }
2428         elsif ($type eq 'recommended display information programs'){
2429                 if ($bsd_type){
2430                         @data = qw(glxinfo wmctrl xdpyinfo xprop xrandr);
2431                         $info_os = 'info-bsd';
2432                 }
2433                 else {
2434                         @data = qw(glxinfo wmctrl xdpyinfo xprop xrandr);
2435                 }
2436                 $b_program = 1;
2437                 $item = 'Program';
2438         }
2439         elsif ($type eq 'recommended downloader programs'){
2440                 if ($bsd_type){
2441                         @data = qw(curl dig fetch ftp wget);
2442                         $info_os = 'info-bsd';
2443                 }
2444                 else {
2445                         @data = qw(curl dig wget);
2446                 }
2447                 $b_program = 1;
2448                 $extra = ' (You only need one of these)';
2449                 $extra2 = "Perl HTTP::Tiny is the default downloader tool if IO::Socket::SSL is present.
2450                 See --help --alt 40-44 options for how to override default downloader(s) in case of issues. ";
2451                 $extra3 = "If dig is installed, it is the default for WAN IP data.
2452                 Strongly recommended. Dig is fast and accurate.";
2453                 $extra4 = ". However, you really only need dig in most cases. All systems should have ";
2454                 $extra4 .= "at least one of the downloader options present.";
2455                 $item = 'Program';
2456         }
2457         elsif ($type eq 'recommended Perl modules'){
2458                 @data = qw(HTTP::Tiny IO::Socket::SSL Time::HiRes Cpanel::JSON::XS JSON::XS XML::Dumper);
2459                 $b_module = 1;
2460                 $item = 'Perl Module';
2461                 $extra = ' (Optional)';
2462                 $extra2 = "None of these are strictly required, but if you have them all, you can eliminate
2463                 some recommended non Perl programs from the install. ";
2464                 $extra3 = "HTTP::Tiny and IO::Socket::SSL must both be present to use as a downloader option.
2465                 For json export Cpanel::JSON::XS is preferred over JSON::XS.";
2466         }
2467         elsif ($type eq 'recommended directories'){
2468                 if ($bsd_type){
2469                         @data = qw(/dev);
2470                 }
2471                 else {
2472                         @data = qw(/dev /dev/disk/by-id /dev/disk/by-label /dev/disk/by-path
2473                         /dev/disk/by-uuid /sys/class/dmi/id);
2474                 }
2475                 $b_dir = 1;
2476                 $item = 'Directory';
2477         }
2478         elsif ($type eq 'recommended files'){
2479                 if ($bsd_type){
2480                         @data = qw(/var/run/dmesg.boot /var/log/Xorg.0.log);
2481                 }
2482                 else {
2483                         @data = qw(/etc/lsb-release /etc/os-release /proc/asound/cards
2484                         /proc/asound/version /proc/cpuinfo /proc/mdstat /proc/meminfo /proc/modules
2485                         /proc/mounts /proc/scsi/scsi /var/log/Xorg.0.log );
2486                 }
2487                 $b_file = 1;
2488                 $item = 'File';
2489                 $extra2 = "Note that not all of these are used by every system,
2490                 so if one is missing it's usually not a big deal.";
2491         }
2492         @rows = (
2493         ['0', '', '', "$line" ],
2494         ['0', '', '', "Test: $type$extra:" ],
2495         ['0', '', '', " " ],
2496         );
2497         if ($extra2){
2498                 $rows[scalar @rows] = (['0', '', '', $extra2]);
2499                 $rows[scalar @rows] = (['0', '', '', ' ']);
2500         }
2501         if ($extra3){
2502                 $rows[scalar @rows] = (['0', '', '', $extra3]);
2503                 $rows[scalar @rows] = (['0', '', '', ' ']);
2504         }
2505         foreach (@data){
2506                 $install = '';
2507                 $about = '';
2508                 %info = item_data($_);
2509                 $about = $info{$info_os};
2510                 if ( ( $b_dir && -d $_ ) || ( $b_file && -r $_ ) ||
2511                      ($b_program && main::check_program($_) ) || ($b_module && main::check_module($_)) ){
2512                         $result = 'Present';
2513                 }
2514                 elsif ($b_file && -f $_){
2515                         $result = 'Unreadable';
2516                         push @unreadable, "$_";
2517                 }
2518                 else {
2519                         $result = 'Missing';
2520                         $install = " ~ Install package: $info{$pm}" if (($b_program || $b_module) && $pm);
2521                         push @missing, "$_$install";
2522                 }
2523                 $row = make_row($_,$about,$result);
2524                 $rows[scalar @rows] = (['0', '', '', $row]);
2525         }
2526         $rows[scalar @rows] = (['0', '', '', " "]);
2527         if (@missing){
2528                 $rows[scalar @rows] = (['0', '', '', "The following $type are missing$extra4:"]);
2529                 foreach (@missing) {
2530                         $rows[scalar @rows] = (['0', '', '', "$item: $_"]);
2531                 }
2532         }
2533         if (@unreadable){
2534                 $rows[scalar @rows] = (['0', '', '', "The following $type are not readable: "]);
2535                 foreach (@unreadable) {
2536                         $rows[scalar @rows] = (['0', '', '', "$item: $_"]);
2537                 }
2538         }
2539         if (!@missing && !@unreadable){
2540                 $rows[scalar @rows] = (['0', '', '', "All $type are present"]);
2541         }
2542         return @rows;
2543 }
2544
2545 sub item_data {
2546         my ($type) = @_;
2547         my %data = (
2548         # directory data
2549         '/sys/class/dmi/id' => ({
2550         'info' => '-M system, motherboard, bios',
2551         }),
2552         '/dev' => ({
2553         'info' => '-l,-u,-o,-p,-P,-D disk partition data',
2554         }),
2555         '/dev/disk/by-id' => ({
2556         'info' => '-D serial numbers',
2557         }),
2558         '/dev/disk/by-path' => ({
2559         'info' => '-D extra data',
2560         }),
2561         '/dev/disk/by-label' => ({
2562         'info' => '-l,-o,-p,-P partition labels',
2563         }),
2564         '/dev/disk/by-uuid' => ({
2565         'info' => '-u,-o,-p,-P partition uuid',
2566         }),
2567         '/proc' => ({
2568         'info' => '',
2569         }),
2570         '/sys' => ({
2571         'info' => '',
2572         }),
2573         # file data
2574         '/etc/lsb-release' => ({
2575         'info' => '-S distro version data (older version)',
2576         }),
2577         '/etc/os-release' => ({
2578         'info' => '-S distro version data (newer version)',
2579         }),
2580         '/proc/asound/cards' => ({
2581         'info' => '-A sound card data',
2582         }),
2583         '/proc/asound/version' => ({
2584         'info' => '-A ALSA data',
2585         }),
2586         '/proc/cpuinfo' => ({
2587         'info' => '-C cpu data',
2588         }),
2589         '/proc/mdstat' => ({
2590         'info' => '-R mdraid data (if you use dm-raid)',
2591         }),
2592         '/proc/meminfo' => ({
2593         'info' => '-I,-tm, -m memory data',
2594         }),
2595         '/proc/modules' => ({
2596         'info' => '-G module data (sometimes)',
2597         }),
2598         '/proc/mounts' => ({
2599         'info' => '-P,-p partition advanced data',
2600         }),
2601         '/proc/scsi/scsi' => ({
2602         'info' => '-D Advanced hard disk data (used rarely)',
2603         }),
2604         '/var/log/Xorg.0.log' => ({
2605         'info' => '-G graphics driver load status',
2606         }),
2607         '/var/run/dmesg.boot' => ({
2608         'info' => '-D,-d disk data',
2609         }),
2610         # system tools
2611         # apt-dpkg,apt-get; pm-arch,pacman; rpm-redhat,suse
2612         'curl' => ({
2613         'info' => '-i (if no dig); -w,-W; -U',
2614         'info-bsd' => '-i (if no dig); -w,-W; -U',
2615         'apt' => 'curl',
2616         'pacman' => 'curl',
2617         'rpm' => 'curl',
2618         }),
2619         'camcontrol' => ({
2620         'info' => '',
2621         'info-bsd' => '-R; -D; -P. Get actual gptid /dev path',
2622         'apt' => '',
2623         'pacman' => '',
2624         'rpm' => '',
2625         }),
2626         'dig' => ({
2627         'info' => '-i wlan IP',
2628         'info-bsd' => '-i wlan IP',
2629         'apt' => 'dnsutils',
2630         'pacman' => 'dnsutils',
2631         'rpm' => 'bind-utils',
2632         }),
2633         'dmidecode' => ({
2634         'info' => '-M if no sys machine data; -m',
2635         'info-bsd' => '-M if null sysctl; -m; -B if null sysctl',
2636         'apt' => 'dmidecode',
2637         'pacman' => 'dmidecode',
2638         'rpm' => 'dmidecode',
2639         }),
2640         'fdisk' => ({
2641         'info' => '-D partition scheme (fallback)',
2642         'info-bsd' => '-D partition scheme',
2643         'apt' => 'fdisk',
2644         'pacman' => 'util-linux',
2645         'rpm' => 'util-linux',
2646         }),
2647         'fetch' => ({
2648         'info' => '',
2649         'info-bsd' => '-i (if no dig); -w,-W; -U',
2650         'apt' => '',
2651         'pacman' => '',
2652         'rpm' => '',
2653         }),
2654         'file' => ({
2655         'info' => '-o unmounted file system (if no lsblk)',
2656         'info-bsd' => '-o unmounted file system',
2657         'apt' => 'file',
2658         'pacman' => 'file',
2659         'rpm' => 'file',
2660         }),
2661         'ftp' => ({
2662         'info' => '',
2663         'info-bsd' => '-i (if no dig); -w,-W; -U',
2664         'apt' => '',
2665         'pacman' => '',
2666         'rpm' => '',
2667         }),
2668         'glabel' => ({
2669         'info' => '',
2670         'info-bsd' => '-R; -D; -P. Get actual gptid /dev path',
2671         'apt' => '',
2672         'pacman' => '',
2673         'rpm' => '',
2674         }),
2675         'gpart' => ({
2676         'info' => '',
2677         'info-bsd' => '-p,-P file system, size',
2678         'apt' => '',
2679         'pacman' => '',
2680         'rpm' => '',
2681         }),
2682         'hciconfig' => ({
2683         'info' => 'Experimental',
2684         'info-bsd' => '',
2685         'apt' => 'bluez',
2686         'pacman' => 'bluez-utils',
2687         'rpm' => 'bluez-utils',
2688         }),
2689         'hddtemp' => ({
2690         'info' => '-Dx show hdd temp',
2691         'info-bsd' => '-Dx show hdd temp',
2692         'apt' => 'hddtemp',
2693         'pacman' => 'hddtemp',
2694         'rpm' => 'hddtemp',
2695         }),
2696         'ifconfig' => ({
2697         'info' => '-i ip LAN (deprecated)',
2698         'info-bsd' => '-i ip LAN',
2699         'apt' => 'net-tools',
2700         'pacman' => 'net-tools',
2701         'rpm' => 'net-tools',
2702         }),
2703         'ip' => ({
2704         'info' => '-i ip LAN',
2705         'info-bsd' => '',
2706         'apt' => 'iproute',
2707         'pacman' => 'iproute2',
2708         'rpm' => 'iproute',
2709         }),
2710         'ipmi-sensors' => ({
2711         'info' => '-s IPMI sensors (servers)',
2712         'info-bsd' => '',
2713         'apt' => 'freeipmi-tools',
2714         'pacman' => 'freeipmi',
2715         'rpm' => 'freeipmi',
2716         }),
2717         'ipmitool' => ({
2718         'info' => '-s IPMI sensors (servers)',
2719         'info-bsd' => '-s IPMI sensors (servers)',
2720         'apt' => 'ipmitool',
2721         'pacman' => 'ipmitool',
2722         'rpm' => 'ipmitool',
2723         }),
2724         'lsblk' => ({
2725         'info' => '-o unmounted file system (best option)',
2726         'info-bsd' => '-o unmounted file system',
2727         'apt' => 'util-linux',
2728         'pacman' => 'util-linux',
2729         'rpm' => 'util-linux-ng',
2730         }),
2731         'lsusb' => ({
2732         'info' => '-A usb audio; -N usb networking; --usb',
2733         'info-bsd' => '-A; -N; --usb. Alternate to usbdevs',
2734         'apt' => 'usbutils',
2735         'pacman' => 'usbutils',
2736         'rpm' => 'usbutils',
2737         }),
2738         'modinfo' => ({
2739         'info' => 'Ax; -Nx module version',
2740         'info-bsd' => '',
2741         'apt' => 'module-init-tools',
2742         'pacman' => 'module-init-tools',
2743         'rpm' => 'module-init-tools',
2744         }),
2745         'runlevel' => ({
2746         'info' => '-I fallback to Perl',
2747         'info-bsd' => '',
2748         'apt' => 'systemd or sysvinit',
2749         'pacman' => 'systemd',
2750         'rpm' => 'systemd or sysvinit',
2751         }),
2752         'sensors' => ({
2753         'info' => '-s sensors output',
2754         'info-bsd' => '',
2755         'apt' => 'lm-sensors',
2756         'pacman' => 'lm-sensors',
2757         'rpm' => 'lm-sensors',
2758         }),
2759         'smartctl' => ({
2760         'info' => '-Dx show hdd temp',
2761         'info-bsd' => '-Dx show hdd temp',
2762         'apt' => '',
2763         'pacman' => '',
2764         'rpm' => '',
2765         }),
2766         'strings' => ({
2767         'info' => '-I sysvinit version',
2768         'info-bsd' => '',
2769         'apt' => 'binutils',
2770         'pacman' => '?',
2771         'rpm' => '?',
2772         }),
2773         'sysctl' => ({
2774         'info' => '',
2775         'info-bsd' => '-C; -I; -m; -tm',
2776         'apt' => '?',
2777         'pacman' => '?',
2778         'rpm' => '?',
2779         }),
2780         'sudo' => ({
2781         'info' => '-Dx hddtemp-user; -o file-user',
2782         'info-bsd' => '-Dx hddtemp-user; -o file-user',
2783         'apt' => 'sudo',
2784         'pacman' => 'sudo',
2785         'rpm' => 'sudo',
2786         }),
2787         'tree' => ({
2788         'info' => '--debugger 20,21 /sys tree',
2789         'info-bsd' => '--debugger 20,21 /sys tree',
2790         'apt' => 'tree',
2791         'pacman' => 'tree',
2792         'rpm' => 'tree',
2793         }),
2794         'upower' => ({
2795         'info' => '-sx attached device battery info',
2796         'info-bsd' => '-sx attached device battery info',
2797         'apt' => 'upower',
2798         'pacman' => 'upower',
2799         'rpm' => 'upower',
2800         }),
2801         'uptime' => ({
2802         'info' => '-I uptime',
2803         'info-bsd' => '-I uptime',
2804         'apt' => 'procps',
2805         'pacman' => 'procps',
2806         'rpm' => 'procps',
2807         }),
2808         'usbdevs' => ({
2809         'info' => '',
2810         'info-bsd' => '-A; -N; --usb;',
2811         'apt' => 'usbutils',
2812         'pacman' => 'usbutils',
2813         'rpm' => 'usbutils',
2814         }),
2815         'wget' => ({
2816         'info' => '-i (if no dig); -w,-W; -U',
2817         'info-bsd' => '-i (if no dig); -w,-W; -U',
2818         'apt' => 'wget',
2819         'pacman' => 'wget',
2820         'rpm' => 'wget',
2821         }),
2822         # display tools
2823         'glxinfo' => ({
2824         'info' => '-G glx info',
2825         'info-bsd' => '-G glx info',
2826         'apt' => 'mesa-utils',
2827         'pacman' => 'mesa-demos',
2828         'rpm' => 'glx-utils (openSUSE 12.3 and later Mesa-demo-x)',
2829         }),
2830         'wmctrl' => ({
2831         'info' => '-S active window manager (fallback)',
2832         'info-bsd' => '-S active window managerr (fallback)',
2833         'apt' => 'wmctrl',
2834         'pacman' => 'wmctrl',
2835         'rpm' => 'wmctrl',
2836         }),
2837         'xdpyinfo' => ({
2838         'info' => '-G multi screen resolution',
2839         'info-bsd' => '-G multi screen resolution',
2840         'apt' => 'X11-utils',
2841         'pacman' => 'xorg-xdpyinfo',
2842         'rpm' => 'xorg-x11-utils',
2843         }),
2844         'xprop' => ({
2845         'info' => '-S desktop data',
2846         'info-bsd' => '-S desktop data',
2847         'apt' => 'X11-utils',
2848         'pacman' => 'xorg-xprop',
2849         'rpm' => 'x11-utils',
2850         }),
2851         'xrandr' => ({
2852         'info' => '-G single screen resolution',
2853         'info-bsd' => '-G single screen resolution',
2854         'apt' => 'x11-xserver-utils',
2855         'pacman' => 'xrandr',
2856         'rpm' => 'x11-server-utils',
2857         }),
2858         # Perl modules
2859         'Cpanel::JSON::XS' => ({
2860         'info' => '--output json - required for export.',
2861         'info-bsd' => '--output json - required for export.',
2862         'apt' => 'libcpanel-json-xs-perl',
2863         'pacman' => 'perl-cpanel-json-xs',
2864         'rpm' => 'perl-Cpanel-JSON-XS',
2865         }),
2866         'HTTP::Tiny' => ({
2867         'info' => '-U; -w,-W; -i (if dig not installed).',
2868         'info-bsd' => '-U; -w,-W; -i (if dig not installed)',
2869         'apt' => 'libhttp-tiny-perl',
2870         'pacman' => 'Core Modules',
2871         'rpm' => 'Perl-http-tiny',
2872         }),
2873         'IO::Socket::SSL' => ({
2874         'info' => '-U; -w,-W; -i (if dig not installed).',
2875         'info-bsd' => '-U; -w,-W; -i (if dig not installed)',
2876         'apt' => 'libio-socket-ssl-perl',
2877         'pacman' => 'perl-io-socket-ssl',
2878         'rpm' => 'perl-IO-Socket-SSL',
2879         }),
2880         'JSON::XS' => ({
2881         'info' => '--output json - required for export (legacy).',
2882         'info-bsd' => '--output json - required for export (legacy).',
2883         'apt' => 'libjson-xs-perl',
2884         'pacman' => 'perl-json-xs',
2885         'rpm' => 'perl-JSON-XS',
2886         }),
2887         'Time::HiRes' => ({
2888         'info' => '-C cpu sleep (not required); --debug timers',
2889         'info-bsd' => '-C cpu sleep (not required); --debug timers',
2890         'apt' => 'Core Modules',
2891         'pacman' => 'Core Modules',
2892         'rpm' => 'perl-Time-HiRes',
2893         }),
2894         'XML::Dumper' => ({
2895         'info' => '--output xml - Crude and raw.',
2896         'info-bsd' => '--output xml - Crude and raw.',
2897         'apt' => 'libxml-dumper-perl',
2898         'pacman' => 'perl-xml-dumper',
2899         'rpm' => 'perl-XML-Dumper',
2900         }),
2901         );
2902         my $ref = $data{$type};
2903         my %values = %$ref;
2904         return %values;
2905 }
2906 sub get_pm {
2907         my ($pm) = ('');
2908         if (main::check_program('dpkg')){
2909                 $pm = 'apt';
2910         }
2911         elsif (main::check_program('pacman')){
2912                 $pm = 'pacman';
2913         }
2914         elsif (main::check_program('rpm')){
2915                 $pm = 'rpm';
2916         }
2917         return $pm;
2918 }
2919 # note: end will vary, but should always be treated as longest value possible.
2920 # expected values: Present/Missing
2921 sub make_row {
2922         my ($start,$middle,$end) = @_;
2923         my ($dots,$line,$sep) = ('','',': ');
2924         foreach (0 .. ($size{'max'} - 16 - length("$start$middle"))){
2925                 $dots .= '.';
2926         }
2927         $line = "$start$sep$middle$dots $end";
2928         return $line;
2929 }
2930 sub make_line {
2931         my $line = '';
2932         foreach (0 .. $size{'max'} - 2 ){
2933                 $line .= '-';
2934         }
2935         return $line;
2936 }
2937 }
2938
2939 #### -------------------------------------------------------------------
2940 #### TOOLS
2941 #### -------------------------------------------------------------------
2942
2943 # Duplicates the functionality of awk to allow for one liner
2944 # type data parsing. note: -1 corresponds to awk NF
2945 # args 1: array of data; 2: search term; 3: field result; 4: separator
2946 # correpsonds to: awk -F='separator' '/search/ {print $2}' <<< @data
2947 # array is sent by reference so it must be dereferenced
2948 # NOTE: if you just want the first row, pass it \S as search string
2949 # NOTE: if $num is undefined, it will skip the second step
2950 sub awk {
2951         eval $start if $b_log;
2952         my ($ref,$search,$num,$sep) = @_;
2953         my ($result);
2954         # print "search: $search\n";
2955         return if ! @$ref || ! $search;
2956         foreach (@$ref){
2957                 if (/$search/i){
2958                         $result = $_;
2959                         $result =~ s/^\s+|\s+$//g;
2960                         last;
2961                 }
2962         }
2963         if ($result && defined $num){
2964                 $sep ||= '\s+';
2965                 $num-- if $num > 0; # retain the negative values as is
2966                 $result = (split /$sep/, $result)[$num];
2967                 $result =~ s/^\s+|,|\s+$//g if $result;
2968         }
2969         eval $end if $b_log;
2970         return $result;
2971 }
2972
2973 # $1 - Perl module to check
2974 sub check_module {
2975         my ($module) = @_;
2976         my $b_present = 0;
2977         eval "require $module";
2978         $b_present = 1 if !$@;
2979         return $b_present;
2980 }
2981
2982 # arg: 1 - string or path to search gneerated @paths data for.
2983 # note: a few nano seconds are saved by using raw $_[0] for program
2984 sub check_program {
2985         (grep { return "$_/$_[0]" if -e "$_/$_[0]"} @paths)[0];
2986 }
2987
2988 sub cleanup {
2989         # maybe add in future: , $fh_c, $fh_j, $fh_x
2990         foreach my $fh ($fh_l){
2991                 if ($fh){
2992                         close $fh;
2993                 }
2994         }
2995 }
2996
2997 # returns count of files in directory, if 0, dir is empty
2998 sub count_dir_files {
2999         return unless -d $_[0];
3000         opendir my $dh, $_[0] or error_handler('open-dir-failed', "$_[0]", $!);
3001         my $count = grep { ! /^\.{1,2}/ } readdir $dh; # strips out . and ..
3002         return $count;
3003 }
3004
3005 # args: 1 - the string to get piece of
3006 # 2 - the position in string, starting at 1 for 0 index.
3007 # 3 - the separator, default is ' '
3008 sub get_piece {
3009         eval $start if $b_log;
3010         my ($string, $num, $sep) = @_;
3011         $num--;
3012         $sep ||= '\s+';
3013         $string =~ s/^\s+|\s+$//g;
3014         my @temp = split(/$sep/, $string);
3015         eval $end if $b_log;
3016         if ( exists $temp[$num] ){
3017                 $temp[$num] =~ s/,//g;
3018                 return $temp[$num];
3019         }
3020 }
3021
3022 # arg: 1 - command to turn into an array; 2 - optional: splitter
3023 # 3 - optionsl, strip and clean data
3024 # similar to reader() except this creates an array of data
3025 # by lines from the command arg
3026 sub grabber {
3027         eval $start if $b_log;
3028         my ($cmd,$split,$strip) = @_;
3029         $split ||= "\n";
3030         my @rows = split /$split/, qx($cmd);
3031         if ($strip && @rows){
3032                 @rows = grep {/^\s*[^#]/} @rows;
3033                 @rows = map {s/^\s+|\s+$//g; $_} @rows if @rows;
3034         }
3035         eval $end if $b_log;
3036         return @rows;
3037 }
3038
3039 # args: 1 - string value to glob
3040 sub globber {
3041         eval $start if $b_log;
3042         my @files = <$_[0]>;
3043         eval $end if $b_log;
3044         return @files;
3045 }
3046
3047 # gets array ref, which may be undefined, plus join string
3048 # this helps avoid debugger print errors when we are printing arrays
3049 # which we don't know are defined or not null.
3050 # args: 1 - array ref; 2 - join string; 3 - default value, optional
3051 sub joiner {
3052         my ($ref,$join,$default) = @_;
3053         my @arr = @$ref;
3054         $default ||= '';
3055         my $string = '';
3056         foreach (@arr){
3057                 if (defined $_){
3058                         $string .= $_ . $join;
3059                 }
3060                 else {
3061                         $string .= $default . $join;
3062                 }
3063         }
3064         return $string;
3065 }
3066
3067 # returns array of:
3068 # 0 - match string; 1 - search number; 2 - version string; 3 - Print name
3069 # 4 - console 0/1; 5 - 0/1 exit version loop at first iteration;
3070 # 6 - 0/1 write to stderr
3071 # arg: 1 - program lower case name
3072 sub program_values {
3073         my ($app) = @_;
3074         my (@client_data);
3075         # note: setting index 1 and 2 to 0 will trip flags to not do version
3076         my %data = (
3077         ## Clients
3078         'bitchx' => ['bitchx',2,'','BitchX',1,0,0],# special
3079         'finch' => ['finch',2,'-v','Finch',1,1,0],
3080         'gaim' => ['[0-9.]+',2,'-v','Gaim',0,1,0],
3081         'ircii' => ['[0-9.]+',3,'-v','ircII',1,1,0],
3082         'irssi' => ['irssi',2,'-v','Irssi',1,1,0],
3083         'irssi-text' => ['irssi',2,'-v','Irssi',1,1,0],
3084         'konversation' => ['konversation',2,'-v','Konversation',0,0,0],
3085         'kopete' => ['Kopete',2,'-v','Kopete',0,0,0],
3086         'kvirc' => ['[0-9.]+',2,'-v','KVIrc',0,0,1], # special
3087         'pidgin' => ['[0-9.]+',2,'-v','Pidgin',0,1,0],
3088         'quassel' => ['',1,'-v','Quassel [M]',0,0,0], # special
3089         'quasselclient' => ['',1,'-v','Quassel',0,0,0],# special
3090         'quasselcore' => ['',1,'-v','Quassel (core)',0,0,0],# special
3091         'gribble' => ['^Supybot',2,'--version','Gribble',1,0,0],# special
3092         'limnoria' => ['^Supybot',2,'--version','Limnoria',1,0,0],# special
3093         'supybot' => ['^Supybot',2,'--version','Supybot',1,0,0],# special
3094         'weechat' => ['[0-9.]+',1,'-v','WeeChat',1,0,0],
3095         'weechat-curses' => ['[0-9.]+',1,'-v','WeeChat',1,0,0],
3096         'xchat-gnome' => ['[0-9.]+',2,'-v','X-Chat-Gnome',1,1,0],
3097         'xchat' => ['[0-9.]+',2,'-v','X-Chat',1,1,0],
3098         ## Desktops / wm
3099         '3dwm' => ['^3dwm',0,'0','3dwm',0,1,0], # unknown syntax
3100         '9wm' => ['^9wm',3,'-version','9wm',0,1,0],
3101         'afterstep' => ['^afterstep',3,'--version','AfterStep',0,1,0],
3102         'amiwm' => ['^amiwm',0,'0','AmiWM',0,1,0],
3103         'awesome' => ['^awesome',2,'--version','Awesome',0,1,0],
3104         'blackbox' => ['^Blackbox',2,'--version','Blackbox',0,1,0],
3105         'budgie' => ['^budgie-desktop',2,'--version','Budgie',0,1,0],
3106         'cinnamon' => ['^cinnamon',2,'--version','Cinnamon',0,1,0],
3107         'compiz' => ['^compiz',2,'--version','Compiz',0,1,0],
3108         'dwm' => ['^dwm',1,'-v','Dwm',0,1,1],
3109         'fluxbox' => ['^fluxbox',2,'--version','Fluxbox',0,1,0],
3110         'flwm' => ['^flwm',0,'0','FLWM',0,0,1],
3111         'fvwm' => ['^fvwm',2,'--version','FVWM',0,0,1],
3112         'fvwm2' => ['^fvwm',2,'--version','FVWM2',0,0,1],
3113         # command: fvwm
3114         'fvwm-crystal' => ['^fvwm',2,'--version','FVWM-Crystal',0,0,0],
3115         'gala' => ['^gala',2,'--version','gala',0,1,0], # super slow result
3116         'gnome-about' => ['gnome',3,'--version','Gnome',0,1,0],
3117         'gnome-shell' => ['gnome',3,'--version','Gnome',0,1,0],
3118         # fails to return version when in wm, but outside does. weird.
3119         'herbstluftwm' => ['^herbstluftwm',2,'--version','herbstluftwm',0,1,0],
3120         'jwm' => ['^jwm',2,'--version','JWM',0,1,0],
3121         # i3 version 4.13 (2016-11-08) © 2009 Michael Stapelberg and contributors
3122         'i3' => ['^i3',3,'--version','i3',0,1,0],
3123         'icewm' => ['^icewm',2,'--version','IceWM',0,1,0],
3124         'kded' => ['^KDE Development Platform:',4,'--version','KDE',0,1,0],
3125         'kded1' => ['^KDE Development Platform:',4,'--version','KDE',0,1,0],
3126         'kded2' => ['^KDE Development Platform:',4,'--version','KDE',0,1,0],
3127         'kded3' => ['^KDE Development Platform:',4,'--version','KDE',0,1,0],
3128         'kded4' => ['^KDE Development Platform:',4,'--version','KDE',0,1,0],
3129         'lxde' => ['^lxpanel',2,'--version','LXDE',0,1,0],
3130         # command: lxqt-panel
3131         'lxqt' => ['^lxqt-panel',2,'--version','LXQt',0,1,0],
3132         'marco' => ['^marco',2,'--version','marco',0,1,0],
3133         'matchbox' => ['^matchbox',0,'0','Matchbox',0,1,0],
3134         'matchbox-window-manager' => ['^matchbox',2,'--help','Matchbox',0,0,0],
3135         'mate-about' => ['^MATE[[:space:]]DESKTOP',-1,'--version','MATE',0,1,0],
3136         # note, mate-session when launched with full path returns full path in version string
3137         'mate-session' => ['mate-session',-1,'--version','MATE',0,1,0],
3138         'metacity' => ['^metacity',2,'--version','Metacity',0,1,0],
3139         'muffin' => ['^muffin',2,'--version','muffin',0,1,0],
3140         'mwm' => ['^mwm',0,'0','mwm',0,1,0],
3141         'notion' => ['^.',1,'--version','notion',0,1,0],
3142         'openbox' => ['^openbox',2,'--version','Openbox',0,1,0],
3143         'pantheon' => ['^pantheon',0,'0','Pantheon',0,1,0],
3144         'pekwm' => ['^pekwm',3,'--version','PekWM',0,1,0],
3145         'plasmashell' => ['^plasmashell',2,'--version','KDE Plasma',0,1,0],
3146         'qtdiag' => ['^qt',2,'--version','Qt',0,1,0],
3147         'ratpoison' => ['^ratpoison',2,'--version','Ratpoison',0,1,0],
3148         'sawfish' => ['^sawfish',3,'--version','Sawfish',0,1,0],
3149         'scrotwm' => ['^scrotwm.*welcome.*',5,'-v','Scrotwm',0,1,1],
3150         'spectrwm' => ['^spectrwm.*welcome.*wm',5,'-v','Spectrwm',0,1,0],
3151         'twm' => ['^twm',0,'0','twm',0,1,0],
3152         'unity' => ['^unity',2,'--version','Unity',0,1,0],
3153         'windowlab' => ['^windowlab',2,'-about','WindowLab',0,1,0],
3154         'wm2' => ['^wm2',0,'0','wm2',0,1,0],
3155         'wmaker' => ['^Window[[:space:]]*Maker',-1,'--version','WindowMaker',0,1,0],
3156         'wmii' => ['^wmii',0,'0','wmii',0,1,0], # note: in debian, wmii is wmii3
3157         'wmii2' => ['^wmii2',1,'--version','wmii2',0,1,0],
3158         'xfce4-panel' => ['^xfce4-panel',2,'--version','Xfce',0,1,0],
3159         'xfce5-panel' => ['^xfce5-panel',2,'--version','Xfce',0,1,0],
3160         'xfdesktop' => ['xfdesktop[[:space:]]version',5,'--version','Xfce',0,1,0],
3161         # command: xfdesktop
3162         'xfdesktop-toolkit' => ['Built[[:space:]]with[[:space:]]GTK',4,'--version','Gtk',0,1,0],
3163         'xmonad' => ['^xmonad',2,'--version','XMonad',0,1,0],
3164         ## Shells
3165         'bash' => ['^GNU[[:space:]]bash,[[:space:]]version',4,'--version','Bash',1,0,0],
3166         'csh' => ['^tcsh',2,'--version','csh',1,0,0],
3167         'dash' => ['dash',3,'--version','Dash',1,0,0], # no version, uses dpkg query, sigh
3168         # ksh/lksh/mksh/pdksh can't be handled with version but we'll use the search string to
3169         # trigger version return and tests
3170         'ksh' => ['ksh',5,'-v','ksh',1,0,0],
3171         'lksh' => ['ksh',5,'-v','lksh',1,0,0],
3172         'loksh' => ['ksh',5,'-v','lksh',1,0,0],
3173         'mksh' => ['ksh',5,'-v','mksh',1,0,0],
3174         'pdksh' => ['ksh',5,'-v','pdksh',1,0,0],
3175         'tcsh' => ['^tcsh',2,'--version','tcsh',1,0,0],
3176         'zsh' => ['^zsh',2,'--version','zsh',1,0,0],
3177         ## Tools
3178         'clang' => ['clang',3,'--version','Clang',1,0,0],
3179         'gcc' => ['^gcc',3,'--version','GCC',1,0,0],
3180         'gcc-apple' => ['Apple[[:space:]]LLVM',2,'--version','LLVM',1,0,0],
3181         'sudo' => ['^Sudo',3,'-V','Sudo',1,1,0], # sudo pre 1.7 does not have --version
3182         );
3183         if ( defined $data{$app} ){
3184                 my $ref = $data{$app};
3185                 @client_data = @$ref;
3186         }
3187         #my $debug = main::Dumper \@client_data;
3188         main::log_data('dump',"Client Data",\@client_data) if $b_log;
3189         return @client_data;
3190 }
3191
3192 # args: 1 - desktop/app command for --version; 2 - search string;
3193 # 3 - space print number; 4 - [optional] version arg: -v, version, etc
3194 # 5 - [optional] exit first find 0/1; 6 - [optional] 0/1 stderr output
3195 sub program_version {
3196         eval $start if $b_log;
3197         my ($app, $search, $num,$version,$exit,$b_stderr) = @_;
3198         my ($cmd,$line,$output);
3199         my $version_nu = '';
3200         my $count = 0;
3201         #print "app:$app\n";
3202         $exit ||= 100; # basically don't exit ever
3203         $version ||= '--version';
3204         # adjust to array index, not human readable
3205         $num-- if (defined $num && $num > 0);
3206         # ksh: Version JM 93t+ 2010--03-05
3207         # mksh: @(#)MIRBSD KSH R56 2018/03/09
3208         # loksh: @(#)PD KSH v5.2.14 99/07/13.2
3209         # --version opens a new ksh, sigh... This so far does not work
3210         # because the ENV/Shell variable is not visible in subshells
3211         if ($search eq 'ksh'){
3212                 my $ksh = system('echo -n $KSH_VERSION');
3213                 if ( $ksh ){
3214                         my @temp = split /\s+/, $ksh;
3215                         if ($temp[2]){
3216                                 $temp[2] =~ s/^v//i; # trim off leading v
3217                                 log_data('data',"Program *ksh array: @temp version: $temp[2]") if $b_log;
3218                                 return $temp[2];
3219                         }
3220                 }
3221                 return 0;
3222         }
3223         # konvi in particular doesn't like using $ENV{'PATH'} as set, so we need
3224         # to always assign the full path if it hasn't already been done
3225         if ( $app !~ /^\// ){
3226                 if (my $program = check_program($app) ){
3227                         $app = $program;
3228                 }
3229                 else {
3230                         log_data('data',"$app not found in path.");
3231                         return 0;
3232                 }
3233         }
3234         # note, some wm/apps send version info to stderr instead of stdout
3235         if ( $b_stderr ) {
3236                 $cmd = "$app $version 2>&1";
3237         }
3238 #       elsif ( $app eq 'csh' ){
3239 #               $app = 'tcsh';
3240 #       }
3241         # quick debian/buntu hack until I find a universal way to get version for these
3242         elsif ( $app eq 'dash' ){
3243                 $cmd = "dpkg -l $app 2>/dev/null";
3244         }
3245         else {
3246                 $cmd = "$app $version 2>/dev/null";
3247         }
3248         log_data('data',"version: $version num: $num search: $search command: $cmd") if $b_log;
3249         $output = qx($cmd);
3250         # print "$cmd : $output\n";
3251         # sample: dwm-5.8.2, ©.. etc, why no space? who knows. Also get rid of v in number string
3252         # xfce, and other, output has , in it, so dump all commas and parentheses
3253         if ($output){
3254                 open my $ch, '<', \$output or error_handler('open-data',"$cmd", "$!");
3255                 while (<$ch>){
3256                         #chomp;
3257                         last if $count > $exit;
3258                         if ( $_ =~ /$search/i ) {
3259                                 $_ = trimmer($_);
3260                                 # print "$_ ::$num\n";
3261                                 my @data = split /\s+/, $_;
3262                                 $version_nu = $data[$num];
3263                                 last if ! defined $version_nu;
3264                                 # some distros add their distro name before the version data, which
3265                                 # breaks version detection. A quick fix attempt is to just add 1 to $num
3266                                 # to get the next value.
3267                                 $version_nu = $data[$num+1] if $data[$num+1] && $version_nu =~ /version/i;
3268                                 $version_nu =~ s/(\([^)]+\)|,|dwm-|wmii2-|wmii-|\||\(|\))//g if $version_nu;
3269                                 # trim off leading v but only when followed by a number
3270                                 $version_nu =~ s/^v([0-9])/$1/i if $version_nu;
3271                                 # print "$version_nu\n";
3272                                 last;
3273                         }
3274                         $count++;
3275                 }
3276                 close $ch if $ch;
3277         }
3278         log_data('data',"Program version: $version_nu") if $b_log;
3279         eval $end if $b_log;
3280         return $version_nu;
3281 }
3282 # print program_version('bash', 'bash', 4) . "\n";
3283
3284 # arg: 1 - full file path, returns array of file lines.
3285 # 2 - optionsl, strip and clean data
3286 # note: chomp has to chomp the entire action, not just <$fh>
3287 sub reader {
3288         eval $start if $b_log;
3289         my ($file,$strip) = @_;
3290         return if ! $file;
3291         open( my $fh, '<', $file ) or error_handler('open', $file, $!);
3292         chomp(my @rows = <$fh>);
3293         if ($strip && @rows){
3294                 @rows = grep {/^\s*[^#]/} @rows;
3295                 @rows = map {s/^\s+|\s+$//g; $_} @rows if @rows;
3296         }
3297         eval $end if $b_log;
3298         return @rows;
3299 }
3300
3301 # args: 1 - the file to create if not exists
3302 sub toucher {
3303         my $file = shift;
3304         if ( ! -e $file ){
3305                 open( my $fh, '>', $file ) or error_handler('create', $file, $!);
3306         }
3307 }
3308
3309 # calling it trimmer to avoid conflicts with existing trim stuff
3310 # arg: 1 - string to be right left trimmed. Also slices off \n so no chomp needed
3311 # this thing is super fast, no need to log its times etc, 0.0001 seconds or less
3312 sub trimmer {
3313         #eval $start if $b_log;
3314         my ($str) = @_;
3315         $str =~ s/^\s+|\s+$|\n$//g;
3316         #eval $end if $b_log;
3317         return $str;
3318 }
3319
3320 # args: 1 - hash
3321 # send array, assign to hash, return array, uniq values only.
3322 sub uniq {
3323         my %seen;
3324         grep !$seen{$_}++, @_;
3325 }
3326
3327
3328 # arg: 1 file full  path to write to; 2 - arrayof data to write.
3329 # note: turning off strict refs so we can pass it a scalar or an array reference.
3330 sub writer {
3331         my ($path, $ref_content) = @_;
3332         my ($content);
3333         no strict 'refs';
3334         # print Dumper $ref_content, "\n";
3335         if (ref $ref_content eq 'ARRAY'){
3336                 $content = join "\n", @$ref_content or die "failed with error $!";
3337         }
3338         else {
3339                 $content = scalar $ref_content;
3340         }
3341         open(my $fh, ">", $path) or error_handler('open',"$path", "$!");
3342         print $fh $content;
3343         close $fh;
3344 }
3345
3346 #### -------------------------------------------------------------------
3347 #### UPDATER
3348 ##### -------------------------------------------------------------------
3349
3350 # arg 1: type to return
3351 sub get_defaults {
3352         my ($type) = @_;
3353         my %defaults = (
3354         'ftp-upload' => 'ftp.techpatterns.com/incoming',
3355         'inxi-branch-1' => 'https://github.com/smxi/inxi/raw/one/',
3356         'inxi-branch-2' => 'https://github.com/smxi/inxi/raw/two/',
3357         'inxi-dev' => 'https://smxi.org/in/',
3358         'inxi-main' => 'https://github.com/smxi/inxi/raw/master/',
3359         'inxi-pinxi' => 'https://github.com/smxi/inxi/raw/inxi-perl/',
3360         'inxi-man' => "https://smxi.org/in/$self_name.1.gz",
3361         'inxi-man-gh' => "https://github.com/smxi/inxi/raw/master/$self_name.1",
3362         'pinxi-man' => "https://smxi.org/in/$self_name.1.gz",
3363         'pinxi-man-gh' => "https://github.com/smxi/inxi/raw/inxi-perl/$self_name.1",
3364         );
3365         if ( exists $defaults{$type}){
3366                 return $defaults{$type};
3367         }
3368         else {
3369                 error_handler('bad-arg-int', $type);
3370         }
3371 }
3372
3373 # args: 1 - download url, not including file name; 2 - string to print out
3374 # 3 - update type option
3375 # note that 1 must end in / to properly construct the url path
3376 sub update_me {
3377         eval $start if $b_log;
3378         my ( $self_download, $download_id ) = @_;
3379         my $downloader_error=1;
3380         my $file_contents='';
3381         my $output = '';
3382         $self_path =~ s/\/$//; # dirname sometimes ends with /, sometimes not
3383         $self_download =~ s/\/$//; # dirname sometimes ends with /, sometimes not
3384         my $full_self_path = "$self_path/$self_name";
3385
3386         if ( $b_irc ){
3387                 error_handler('not-in-irc', "-U/--update" )
3388         }
3389         if ( ! -w $full_self_path ){
3390                 error_handler('not-writable', "$self_name", '');
3391         }
3392         $output .= "Starting $self_name self updater.\n";
3393         $output .= "Using $dl{'dl'} as downloader.\n";
3394         $output .= "Currently running $self_name version number: $self_version\n";
3395         $output .= "Current version patch number: $self_patch\n";
3396         $output .= "Current version release date: $self_date\n";
3397         $output .= "Updating $self_name in $self_path using $download_id as download source...\n";
3398         print $output;
3399         $output = '';
3400         $self_download = "$self_download/$self_name";
3401         $file_contents = download_file('stdout', $self_download);
3402
3403         # then do the actual download
3404         if (  $file_contents ){
3405                 # make sure the whole file got downloaded and is in the variable
3406                 if ( $file_contents =~ /###\*\*EOF\*\*###/ ){
3407                         open(my $fh, '>', $full_self_path);
3408                         print $fh $file_contents or error_handler('write', "$full_self_path", "$!" );
3409                         close $fh;
3410                         qx( chmod +x '$self_path/$self_name' );
3411                         set_version_data();
3412                         $output .= "Successfully updated to $download_id version: $self_version\n";
3413                         $output .= "New $download_id version patch number: $self_patch\n";
3414                         $output .= "New $download_id version release date: $self_date\n";
3415                         $output .= "To run the new version, just start $self_name again.\n";
3416                         $output .= "$line3\n";
3417                         $output .= "Starting download of man page file now.\n";
3418                         print $output;
3419                         $output = '';
3420                         if ($b_man){
3421                                 update_man($download_id);
3422                         }
3423                         else {
3424                                 print "Skipping man download because branch version is being used.\n";
3425                         }
3426                         exit 1;
3427                 }
3428                 else {
3429                         error_handler('file-corrupt', "$self_name");
3430                 }
3431         }
3432         # now run the error handlers on any downloader failure
3433         else {
3434                 error_handler('download-error', $self_download, $download_id);
3435         }
3436         eval $end if $b_log;
3437 }
3438
3439 sub update_man {
3440         my ($download_id) = @_;
3441         my $man_file_location=set_man_location();
3442         my $man_file_path="$man_file_location/$self_name.1" ;
3443         my ($man_file_url,$output) = ('','');
3444
3445         my $b_downloaded = 0;
3446         if ( ! -d $man_file_location ){
3447                 print "The required man directory was not detected on your system.\n";
3448                 print "Unable to continue: $man_file_location\n";
3449                 return 0;
3450         }
3451         if ( ! -w $man_file_location ){
3452                 print "Cannot write to $man_file_location! Are you root?\n";
3453                 print "Unable to continue: $man_file_location\n";
3454                 return 0;
3455         }
3456         if ( -f "/usr/share/man/man8/inxi.8.gz" ){
3457                 print "Updating man page location to man1.\n";
3458                 rename "/usr/share/man/man8/inxi.8.gz", "$man_file_location/inxi.1.gz";
3459                 if ( check_program('mandb') ){
3460                         system( 'mandb' );
3461                 }
3462         }
3463          # first choice is inxi.1/pinxi.1 from gh, second gz from smxi.org
3464         if ( $download_id ne 'dev server' && (my $program = check_program('gzip'))){
3465                 $man_file_url=get_defaults($self_name . '-man-gh');
3466                 print "Downloading Man page file...\n";
3467                 $b_downloaded = download_file('file', $man_file_url, $man_file_path);
3468                 if ($b_downloaded){
3469                         print "Download successful. Compressing file...\n";
3470                         system("$program -9 -f $man_file_path > $man_file_path.gz");
3471                         my $err = $?;
3472                         if ($err > 0){
3473                                 print "Oh no! Something went wrong compressing the manfile:\n";
3474                                 print "Local path: $man_file_path Error: $err\n";
3475                         }
3476                         else {
3477                                 print "Download and install of man page successful.\nCheck to make sure it works: man $self_name\n";
3478                         }
3479                 }
3480         }
3481         else {
3482                 $man_file_url = get_defaults($self_name . '-man');
3483                 # used to use spider tests, but only wget supports that, so no need
3484                 print "Downloading Man page file gz...\n";
3485                 $man_file_path .= '.gz';
3486                 # returns perl, 1 for true, 0 for false, even when using shell tool returns
3487                 $b_downloaded = download_file('file', $man_file_url,  $man_file_path );
3488                 if ($b_downloaded) {
3489                         print "Download and install of man page successful.\nCheck to make sure it works: man $self_name\n";
3490                 }
3491         }
3492         if ( !$b_downloaded ){
3493                 print "Oh no! Something went wrong downloading the Man file at:\n$man_file_url\n";
3494                 print "Try -U with --dbg 1 for more information on the failure.\n";
3495         }
3496 }
3497
3498 sub set_man_location {
3499         my $location='';
3500         my $default_location='/usr/share/man/man1';
3501         my $man_paths=qx(man --path 2>/dev/null);
3502         my $man_local='/usr/local/share/man';
3503         my $b_use_local=0;
3504         if ( $man_paths && $man_paths =~ /$man_local/ ){
3505                 $b_use_local=1;
3506         }
3507         # for distro installs
3508         if ( -f "$default_location/inxi.1.gz" ){
3509                 $location=$default_location;
3510         }
3511         else {
3512                 if ( $b_use_local ){
3513                         if ( ! -d "$man_local/man1" ){
3514                                 mkdir "$man_local/man1";
3515                         }
3516                         $location="$man_local/man1";
3517                 }
3518         }
3519         if ( ! $location ){
3520                 $location=$default_location;
3521         }
3522         return $location;
3523 }
3524
3525 # update for updater output version info
3526 # note, this is only now used for self updater function so it can get
3527 # the values from the UPDATED file, NOT the running program!
3528 sub set_version_data {
3529         open (my $fh, '<', "$self_path/$self_name");
3530         while( my $row = <$fh>){
3531                 chomp $row;
3532                 $row =~ s/'|;//g;
3533                 if ($row =~ /^my \$self_name/ ){
3534                         $self_name = (split /=/, $row)[1];
3535                 }
3536                 elsif ($row =~ /^my \$self_version/ ){
3537                         $self_version = (split /=/, $row)[1];
3538                 }
3539                 elsif ($row =~ /^my \$self_date/ ){
3540                         $self_date = (split /=/, $row)[1];
3541                 }
3542                 elsif ($row =~ /^my \$self_patch/ ){
3543                         $self_patch = (split /=/, $row)[1];
3544                 }
3545                 elsif ($row =~ /^## END INXI INFO/){
3546                         last;
3547                 }
3548         }
3549         close $fh;
3550 }
3551
3552 ########################################################################
3553 #### OPTIONS HANDLER / VERSION
3554 ########################################################################
3555
3556 sub get_options{
3557         eval $start if $b_log;
3558         my (@args) = @_;
3559         $show{'short'} = 1;
3560         my ($b_downloader,$b_help,$b_no_man,$b_no_man_force,$b_recommends,$b_updater,$b_version,
3561         $b_use_man,$self_download, $download_id);
3562         GetOptions (
3563         'admin' => sub {
3564                 $b_admin = 1;},
3565         'A|audio' => sub {
3566                 $show{'short'} = 0;
3567                 $show{'audio'} = 1;},
3568         'b|basic' => sub {
3569                 $show{'short'} = 0;
3570                 $show{'battery'} = 1;
3571                 $show{'cpu-basic'} = 1;
3572                 $show{'raid-basic'} = 1;
3573                 $show{'disk-total'} = 1;
3574                 $show{'graphic'} = 1;
3575                 $show{'info'} = 1;
3576                 $show{'machine'} = 1;
3577                 $show{'network'} = 1;
3578                 $show{'system'} = 1;},
3579         'B|battery' => sub {
3580                 $show{'short'} = 0;
3581                 $show{'battery'} = 1;
3582                 $show{'battery-forced'} = 1; },
3583         'c|color:i' => sub {
3584                 my ($opt,$arg) = @_;
3585                 if ( $arg >= 0 && $arg < get_color_scheme('count') ){
3586                         set_color_scheme($arg);
3587                 }
3588                 elsif ( $arg >= 94 && $arg <= 99 ){
3589                         $colors{'selector'} = $arg;
3590                 }
3591                 else {
3592                         error_handler('bad-arg', $opt, $arg);
3593                 } },
3594         'C|cpu' => sub {
3595                 $show{'short'} = 0;
3596                 $show{'cpu'} = 1; },
3597         'd|disk-full|optical' => sub {
3598                 $show{'short'} = 0;
3599                 $show{'disk'} = 1;
3600                 $show{'optical'} = 1; },
3601         'D' => sub {
3602                 $show{'short'} = 0;
3603                 $show{'disk'} = 1; },
3604         'f|flags|flag' => sub {
3605                 $show{'short'} = 0;
3606                 $show{'cpu'} = 1;
3607                 $show{'cpu-flag'} = 1; },
3608         'F|full' => sub {
3609                 $show{'short'} = 0;
3610                 $show{'audio'} = 1;
3611                 $show{'battery'} = 1;
3612                 $show{'cpu'} = 1;
3613                 $show{'disk'} = 1;
3614                 $show{'graphic'} = 1;
3615                 $show{'info'} = 1;
3616                 $show{'machine'} = 1;
3617                 $show{'network'} = 1;
3618                 $show{'network-advanced'} = 1;
3619                 $show{'partition'} = 1;
3620                 $show{'raid'} = 1;
3621                 $show{'sensor'} = 1;
3622                 $show{'system'} = 1; },
3623         'G|graphics|graphic' => sub {
3624                 $show{'short'} = 0;
3625                 $show{'graphic'} = 1; },
3626         'i|ip' => sub {
3627                 $show{'short'} = 0;
3628                 $show{'ip'} = 1;
3629                 $show{'network'} = 1;
3630                 $show{'network-advanced'} = 1;
3631                 $b_downloader = 1 if ! check_program('dig');},
3632         'I|info' => sub {
3633                 $show{'short'} = 0;
3634                 $show{'info'} = 1; },
3635         'l|labels|label' => sub {
3636                 $show{'short'} = 0;
3637                 $show{'label'} = 1;
3638                 $show{'partition'} = 1; },
3639         'limit:i' => sub {
3640                 my ($opt,$arg) = @_;
3641                 if ($arg != 0){
3642                         $limit = $arg;
3643                 }
3644                 else {
3645                         error_handler('bad-arg',$opt,$arg);
3646                 } },
3647         'm|memory' => sub {
3648                 $show{'short'} = 0;
3649                 $show{'ram'} = 1; },
3650         'M|machine' => sub {
3651                 $show{'short'} = 0;
3652                 $show{'machine'} = 1; },
3653         'n|network-advanced' => sub {
3654                 $show{'short'} = 0;
3655                 $show{'network'} = 1;
3656                 $show{'network-advanced'} = 1; },
3657         'N|network' => sub {
3658                 $show{'short'} = 0;
3659                 $show{'network'} = 1; },
3660         'o|unmounted' => sub {
3661                 $show{'short'} = 0;
3662                 $show{'unmounted'} = 1; },
3663         'p|partition-full' => sub {
3664                 $show{'short'} = 0;
3665                 $show{'partition'} = 0;
3666                 $show{'partition-full'} = 1; },
3667         'P|partitions|partition' => sub {
3668                 $show{'short'} = 0;
3669                 $show{'partition'} = 1; },
3670         'r|repos|repo' => sub {
3671                 $show{'short'} = 0;
3672                 $show{'repo'} = 1; },
3673         'R|raid' => sub {
3674                 $show{'short'} = 0;
3675                 $show{'raid'} = 1;
3676                 $show{'raid-forced'} = 1; },
3677         's|sensors|sensor' => sub {
3678                 $show{'short'} = 0;
3679                 $show{'sensor'} = 1; },
3680         'sleep:s' => sub {
3681                 my ($opt,$arg) = @_;
3682                 $arg ||= 0;
3683                 if ($arg >= 0){
3684                         $cpu_sleep = $arg;
3685                 }
3686                 else {
3687                         error_handler('bad-arg',$opt,$arg);
3688                 } },
3689         'slots|slot' => sub {
3690                 $show{'short'} = 0;
3691                 $show{'slot'} = 1; },
3692         'S|system' => sub {
3693                 $show{'short'} = 0;
3694                 $show{'system'} = 1; },
3695         't|processes|process:s' => sub {
3696                 my ($opt,$arg) = @_;
3697                 $show{'short'} = 0;
3698                 $arg ||= 'cm';
3699                 my $num = $arg;
3700                 $num =~ s/^[cm]+// if $num;
3701                 if ( $arg =~ /^([cm]+)([0-9]+)?$/ && (!$num || $num =~ /^\d+/) ){
3702                         $show{'process'} = 1;
3703                         if ($arg =~ /c/){
3704                                 $show{'ps-cpu'} = 1;
3705                         }
3706                         if ($arg =~ /m/){
3707                                 $show{'ps-mem'} = 1;
3708                         }
3709                         $ps_count = $num if $num;
3710                 }
3711                 else {
3712                         error_handler('bad-arg',$opt,$arg);
3713                 } },
3714         'usb' => sub {
3715                 $show{'short'} = 0;
3716                 $show{'usb'} = 1; },
3717         'u|uuid' => sub {
3718                 $show{'short'} = 0;
3719                 $show{'partition'} = 1;
3720                 $show{'uuid'} = 1; },
3721         'v|verbosity:i' => sub {
3722                 my ($opt,$arg) = @_;
3723                 $show{'short'} = 0;
3724                 if ( $arg =~ /^[0-8]$/ ){
3725                         if ($arg == 0 ){
3726                                 $show{'short'} = 1;
3727                         }
3728                         if ($arg >= 1 ){
3729                                 $show{'cpu-basic'} = 1;
3730                                 $show{'disk-total'} = 1;
3731                                 $show{'graphic'} = 1;
3732                                 $show{'info'} = 1;
3733                                 $show{'system'} = 1;
3734                         }
3735                         if ($arg >= 2 ){
3736                                 $show{'battery'} = 1;
3737                                 $show{'disk-basic'} = 1;
3738                                 $show{'raid-basic'} = 1;
3739                                 $show{'machine'} = 1;
3740                                 $show{'network'} = 1;
3741                         }
3742                         if ($arg >= 3 ){
3743                                 $show{'network-advanced'} = 1;
3744                                 $show{'cpu'} = 1;
3745                                 $extra = 1;
3746                         }
3747                         if ($arg >= 4 ){
3748                                 $show{'disk'} = 1;
3749                                 $show{'partition'} = 1;
3750                         }
3751                         if ($arg >= 5 ){
3752                                 $show{'audio'} = 1;
3753                                 $show{'ram'} = 1;
3754                                 $show{'label'} = 1;
3755                                 $show{'optical-basic'} = 1;
3756                                 $show{'ram'} = 1;
3757                                 $show{'raid'} = 1;
3758                                 $show{'sensor'} = 1;
3759                                 $show{'uuid'} = 1;
3760                         }
3761                         if ($arg >= 6 ){
3762                                 $show{'optical'} = 1;
3763                                 $show{'partition-full'} = 1;
3764                                 $show{'unmounted'} = 1;
3765                                 $show{'usb'} = 1;
3766                                 $extra = 2;
3767                         }
3768                         if ($arg >= 7 ){
3769                                 $b_downloader = 1 if ! check_program('dig');
3770                                 $show{'cpu-flag'} = 1;
3771                                 $show{'ip'} = 1;
3772                                 $show{'raid-forced'} = 1;
3773                                 $extra = 3;
3774                         }
3775                         if ($arg >= 8 ){
3776                                 $b_downloader = 1;
3777                                 $show{'slot'} = 1;
3778                                 $show{'process'} = 1;
3779                                 $show{'ps-cpu'} = 1;
3780                                 $show{'ps-mem'} = 1;
3781                                 $show{'repo'} = 1;
3782                                 #$show{'weather'} = 1;
3783                         }
3784                 }
3785                 else {
3786                         error_handler('bad-arg',$opt,$arg);
3787                 } },
3788         'w|weather' => sub {
3789                 my ($opt) = @_;
3790                 $show{'short'} = 0;
3791                 $b_downloader = 1;
3792                 if ( $b_weather ){
3793                         $show{'weather'} = 1;
3794                 }
3795                 else {
3796                         error_handler('distro-block', $opt);
3797                 } },
3798         'W|weather-location:s' => sub {
3799                 my ($opt,$arg) = @_;
3800                 $arg ||= '';
3801                 $arg =~ s/\s//g;
3802                 $show{'short'} = 0;
3803                 $b_downloader = 1;
3804                 if ( $b_weather ){
3805                         if ($arg){
3806                                 $show{'weather'} = 1;
3807                                 $show{'weather-location'} = $arg;
3808                         }
3809                         else {
3810                                 error_handler('bad-arg',$opt,$arg);
3811                         }
3812                 }
3813                 else {
3814                         error_handler('distro-block', $opt);
3815                 } },
3816         'weather-unit:s' => sub {
3817                 my ($opt,$arg) = @_;
3818                 $arg ||= '';
3819                 $arg =~ s/\s//g;
3820                 $arg = lc($arg) if $arg;
3821                 if ($arg && $arg =~ /^(c|f|cf|fc|i|m|im|mi)$/){
3822                         my %units = ('c'=>'m','f'=>'i','cf'=>'mi','fc'=>'im');
3823                         $arg = $units{$arg} if defined $units{$arg};
3824                         $weather_unit = $arg;
3825                 }
3826                 else {
3827                         error_handler('bad-arg',$opt,$arg);
3828                 } },
3829         'x|extra:i' => sub {
3830                 my ($opt,$arg) = @_;
3831                 if ($arg > 0){
3832                         $extra = $arg;
3833                 }
3834                 else {
3835                         $extra++;
3836                 } },
3837         'y|width:i' => sub {
3838                 my ($opt, $arg) = @_;
3839                 $arg = 2000 if defined $arg && $arg == -1;
3840                 if ( $arg =~ /\d/ && $arg >= 80 ){
3841                         set_display_width($arg);
3842                 }
3843                 else {
3844                         error_handler('bad-arg', $opt, $arg);
3845                 } },
3846         'z|filter' => sub {
3847                 $show{'filter'} = 1; },
3848         'Z|filter-override' => sub {
3849                 $show{'filter-override'} = 1; },
3850         ## Start non data options
3851         'alt:i' => sub {
3852                 my ($opt,$arg) = @_;
3853                 if ($arg == 40) {
3854                         $dl{'tiny'} = 0;
3855                         $b_downloader = 1;}
3856                 elsif ($arg == 41) {
3857                         $dl{'curl'} = 0;
3858                         $b_downloader = 1;}
3859                 elsif ($arg == 42) {
3860                         $dl{'fetch'} = 0;
3861                         $b_downloader = 1;}
3862                 elsif ($arg == 43) {
3863                         $dl{'wget'} = 0;
3864                         $b_downloader = 1;}
3865                 elsif ($arg == 44) {
3866                         $dl{'curl'} = 0;
3867                         $dl{'fetch'} = 0;
3868                         $dl{'wget'} = 0;
3869                         $b_downloader = 1;}
3870                 else {
3871                         error_handler('bad-arg', $opt, $arg);
3872                 }},
3873         'arm' => sub {
3874                 $b_arm = 1 },
3875         'bsd:s' => sub {
3876                 my ($opt,$arg) = @_;
3877                 if ($arg =~ /^(darwin|dragonfly|freebsd|openbsd|netbsd)$/i){
3878                         $bsd_type = lc($arg);
3879                         $b_fake_bsd = 1;
3880                 }
3881                 else {
3882                         error_handler('bad-arg', $opt, $arg);
3883                 }
3884         },
3885         'bsd-data:s' => sub {
3886                 my ($opt,$arg) = @_;
3887                 if ($arg =~ /^(dboot|pciconf|sysctl|usbdevs)$/i){
3888                         $b_fake_dboot = 1 if $arg eq 'dboot';
3889                         $b_fake_pciconf = 1 if $arg eq 'pciconf';
3890                         $b_fake_sysctl = 1 if $arg eq 'sysctl';
3891                         $b_fake_usbdevs = 1 if $arg eq 'usbdevs';
3892                 }
3893                 else {
3894                         error_handler('bad-arg', $opt, $arg);
3895                 }
3896         },
3897         'dbg:i' => sub {
3898                 my ($opt,$arg) = @_;
3899                 if ($arg > 0) {
3900                         $test[$arg] = 1;
3901                 }
3902                 else {
3903                         error_handler('bad-arg', $opt, $arg);
3904                 }},
3905         'debug:i' => sub {
3906                 my ($opt,$arg) = @_;
3907                 if ($arg =~ /^[1-3]|1[0-3]|2[0-4]$/){
3908                         $debug=$arg;
3909                 }
3910                 else {
3911                         error_handler('bad-arg', $opt, $arg);
3912                 } },
3913         'display:s' => sub {
3914                 my ($opt,$arg) = @_;
3915                 if ($arg =~ /^:?([0-9]+)?$/){
3916                         $display=$arg;
3917                         $display ||= ':0';
3918                         $display = ":$display" if $display !~ /^:/;
3919                         $b_display = ($b_root) ? 0 : 1;
3920                         $b_force_display = 1;
3921                         $display_opt = "-display $display";
3922                 }
3923                 else {
3924                         error_handler('bad-arg', $opt, $arg);
3925                 } },
3926         'dmidecode' => sub {
3927                 $b_dmidecode_force = 1 },
3928         'downloader:s' => sub {
3929                 my ($opt,$arg) = @_;
3930                 $arg = lc($arg);
3931                 if ($arg =~ /^(curl|fetch|ftp|perl|wget)$/){
3932                         if ($arg eq 'perl' && (!check_module('HTTP::Tiny') || !check_module('IO::Socket::SSL') )){
3933                                 error_handler('missing-perl-downloader', $opt, $arg);
3934                         }
3935                         elsif ( !check_program($arg)) {
3936                                 error_handler('missing-downloader', $opt, $arg);
3937                         }
3938                         else {
3939                                 # this dumps all the other data and resets %dl for only the
3940                                 # desired downloader.
3941                                 $arg = set_perl_downloader($arg);
3942                                 %dl = ('dl' => $arg, $arg => 1);
3943                                 $b_downloader = 1;
3944                         }
3945                 }
3946                 else {
3947                         error_handler('bad-arg', $opt, $arg);
3948                 } },
3949         'ftp:s'  => sub {
3950                 my ($opt,$arg) = @_;
3951                 # pattern: ftp.x.x/x
3952                 if ($arg =~ /^ftp\..+\..+\/[^\/]+$/ ){
3953                         $ftp_alt = $arg;
3954                 }
3955                 else {
3956                         error_handler('bad-arg', $opt, $arg);
3957                 }},
3958         'h|help|?' => sub {
3959                 $b_help = 1; },
3960         'host|hostname' => sub {
3961                 $show{'host'} = 1 },
3962         'indent-min:i' => sub {
3963                 my ($opt,$arg) = @_;
3964                 if ($arg =~ /^\d+$/){
3965                         $size{'indent-min'} = 1;
3966                 }
3967                 else {
3968                         error_handler('bad-arg', $opt, $arg);
3969                 }},
3970         'irc' => sub {
3971                 $b_irc = 1; },
3972         'man' => sub {
3973                 $b_use_man = 1; },
3974         'output:s' => sub {
3975                 my ($opt,$arg) = @_;
3976                 if ($arg =~ /^(json|screen|xml)$/){
3977                         if ($arg =~ /json|screen|xml/){
3978                                 $output_type = $arg;
3979                         }
3980                         else {
3981                                 error_handler('option-feature-incomplete', $opt, $arg);
3982                         }
3983                 }
3984                 else {
3985                         error_handler('bad-arg', $opt, $arg);
3986                 }},
3987         'no-host|no-hostname' => sub {
3988                 $show{'host'} = 0 },
3989         'no-man' => sub {
3990                 $b_no_man_force = 0; },
3991         'no-ssl' => sub {
3992                 $dl{'no-ssl-opt'}=1 },
3993         'output-file:s' => sub {
3994                 my ($opt,$arg) = @_;
3995                 if ($arg){
3996                         if ($arg eq 'print' || check_output_path($arg)){
3997                                 $output_file = $arg;
3998                         }
3999                         else {
4000                                 error_handler('output-file-bad', $opt, $arg);
4001                         }
4002                 }
4003                 else {
4004                         error_handler('bad-arg', $opt, $arg);
4005                 }},
4006         'proc' => sub {
4007                 $b_proc_debug = 1; },
4008         'recommends' => sub {
4009                 $b_recommends = 1; },
4010         'U|update:s' => sub { # 1,2,3 OR http://myserver/path/inxi
4011                 my ($opt,$arg) = @_;
4012                 $b_downloader = 1;
4013                 if ( $b_update ){
4014                         $b_updater = 1;
4015                         if (!$arg && $self_name eq 'pinxi'){
4016                                 $b_man = 1;
4017                                 $download_id = 'inxi-perl branch';
4018                                 $self_download = get_defaults('inxi-pinxi');
4019                         }
4020                         elsif ($arg && $arg eq '3'){
4021                                 $b_man = 1;
4022                                 $download_id = 'dev server';
4023                                 $self_download = get_defaults('inxi-dev');
4024                         }
4025                         else {
4026                                 if (!$arg){
4027                                         $download_id = 'main branch';
4028                                         $self_download = get_defaults('inxi-main');
4029                                         $b_man = 1;
4030                                         $b_use_man = 1;
4031                                 }
4032                                 elsif ( $arg =~ /^[12]$/){
4033                                         $download_id = "branch $arg";
4034                                         $self_download = get_defaults("inxi-branch-$arg");
4035                                 }
4036                                 elsif ( $arg =~ /^http/){
4037                                         $download_id = 'alt server';
4038                                         $self_download = $arg;
4039                                 }
4040                         }
4041                         if (!$self_download){
4042                                 error_handler('bad-arg', $opt, $arg);
4043                         }
4044                 }
4045                 else {
4046                         error_handler('distro-block', $opt);
4047                 } },
4048         'V|version' => sub {
4049                 $b_version = 1 },
4050         'wm' => sub {
4051                 $b_wmctrl = 1 },
4052         '<>' => sub {
4053                 my ($opt) = @_;
4054                 error_handler('unknown-option', "$opt", "" ); }
4055         ) ; #or error_handler('unknown-option', "@ARGV", '');
4056         ## run all these after so that we can change widths, downloaders, etc
4057         eval $end if $b_log;
4058         CheckRecommends::run() if $b_recommends;
4059         set_downloader() if $b_downloader;
4060         show_version() if $b_version;
4061         show_options() if $b_help;
4062         $b_man = 0 if (!$b_use_man || $b_no_man_force);
4063         update_me( $self_download, $download_id ) if $b_updater;
4064         if ($output_type){
4065                 if ($output_type ne 'screen' && ! $output_file){
4066                         error_handler('bad-arg', '--output', '--output-file not provided');
4067                 }
4068         }
4069         if ( $show{'ram'} || $show{'slot'} ||
4070              ( ( $bsd_type || $b_dmidecode_force ) && ($show{'machine'} || $show{'battery'}) ) ){
4071                 $b_dmi = 1;
4072         }
4073         if ($show{'audio'} || $show{'graphic'} || $show{'network'} || $show{'raid'} || $show{'raid-forced'} ){
4074                 $b_pci = 1;
4075         }
4076         if ($show{'usb'} || $show{'audio'}  || $show{'network'} ){
4077                 # to detect wan/lan, we have to use long form to get as much data as possible
4078                 $usb_level = ($show{'usb'} || $show{'network'}) ? 2 : 1;
4079         }
4080         if ($bsd_type && ($show{'short'} || $show{'battery'} || $show{'cpu'} || $show{'cpu-basic'} ||
4081            $show{'info'} || $show{'machine'} || $show{'process'} || $show{'ram'}  || $show{'sensor'} ) ){
4082                 $b_sysctl = 1;
4083         }
4084         if ($show{'filter-override'}){
4085                 $show{'filter'} = 0;
4086         }
4087         $b_sudo = 1 if ( $show{'unmounted'} || ($extra > 0 && $show{'disk'}) );
4088         # override for things like -b or -v2 to -v3
4089         $show{'cpu-basic'} = 0 if $show{'cpu'};
4090         $show{'optical-basic'} = 0 if $show{'optical'};
4091         $show{'partition'} = 0 if $show{'partition-full'};
4092         if ($show{'disk'} || $show{'optical'} ){
4093                 $show{'disk-basic'} = 0;
4094                 $show{'disk-total'} = 0;
4095         }
4096         if ($bsd_type && ($show{'short'} || $show{'disk-basic'} || $show{'disk-total'} || $show{'disk'})){
4097                 $b_dm_boot_disk = 1;
4098         }
4099         if ($bsd_type && ($show{'optical-basic'} || $show{'optical'})){
4100                 $b_dm_boot_optical = 1
4101         }
4102 }
4103
4104 sub show_options {
4105         error_handler('not-in-irc', 'help') if $b_irc;
4106         my (@row,@rows,@data);
4107         my $line = '';
4108         my $color_scheme_count = get_color_scheme('count') - 1;
4109         my $partition_string='partition';
4110         my $partition_string_u='Partition';
4111         my $flags = ($b_arm) ? 'features' : 'flags' ;
4112         if ( $bsd_type ){
4113                 $partition_string='slice';
4114                 $partition_string_u='Slice';
4115         }
4116         # fit the line to the screen!
4117         for my $i ( 0 .. ( ( $size{'max'} / 2 ) - 2 ) ){
4118                 $line = $line . '- ';
4119         }
4120         @rows = (
4121         ['0', '', '', "$self_name supports the following options. You can combine
4122         these or list them one by one. For more detailed information, see man^$self_name.
4123         Examples:^$self_name^-v4^-c6 OR
4124         $self_name^-bDc^6. If you start $self_name with no arguments, it will display
4125         a short system summary." ],
4126         ['0', '', '', '' ],
4127         ['0', '', '', "The following options, if used without -F, -b, or -v, will
4128         show option line(s): A, B, C, D, G, I, M, N, P, R, S, W, d, f, i, l, m, n,
4129         o, p, r, s, t, u, w, --slots, --usb - you can use these alone or together
4130         to show just the line(s) you want to see. If you use them with -v [level],
4131         -b or -F, $self_name will combine the outputs." ],
4132         ['0', '', '', $line ],
4133         ['0', '', '', "Output Control Options:" ],
4134         ['1', '-A', '--audio', "Audio/sound card(s), driver, sound server." ],
4135         ['1', '-b', '--basic', "Basic output, short form. Same as $self_name^-v^2." ],
4136         ['1', '-B', '--battery', "System battery info, including charge and condition, plus
4137         extra info (if battery present)." ],
4138         ['1', '-c', '--color', "Set color scheme (0-42). Example:^$self_name^-c^11" ],
4139         ['1', '', '', "Color selectors let you set the config file value for the
4140         selection (NOTE: IRC and global only show safe color set)" ],
4141         ['2', '94', '', "Console, out of X" ],
4142         ['2', '95', '', "Terminal, running in X - like xTerm" ],
4143         ['2', '96', '', "Gui IRC, running in X - like Xchat, Quassel, Konversation etc." ],
4144         ['2', '97', '', "Console IRC running in X - like irssi in xTerm" ],
4145         ['2', '98', '', "Console IRC not in  X" ],
4146         ['2', '99', '', "Global - Overrides/removes all settings. Setting specific
4147         removes global." ],
4148         ['1', '-C', '--cpu', "CPU output, including per CPU clock speed and max
4149         CPU speed (if available)." ],
4150         ['1', '-d', '--disk-full, --optical', "Optical drive data (and floppy disks,
4151         if present). Triggers -D." ],
4152         ['1', '-D', '--disk', "Hard Disk info, including total storage and details
4153         for each disk. Disk total used percentage includes swap partition size(s)." ],
4154         ['1', '-f', '--flags', "All CPU $flags. Triggers -C. Not shown with -F to
4155         avoid spamming." ],
4156         ['1', '-F', '--full', "Full output. Includes all Upper Case line letters
4157         except -W, plus -s and -n. Does not show extra verbose options such
4158         as -d -f -i -l -m -o -p -r -t -u -x, unless specified." ],
4159         ['1', '-G', '--graphics', "Graphics info (card(s), driver, display protocol
4160         (if available), display server, resolution, renderer, OpenGL version)." ],
4161         ['1', '-i', '--ip', "WAN IP address and local interfaces (requires ifconfig
4162         or ip network tool). Triggers -n. Not shown with -F for user security reasons.
4163         You shouldn't paste your local/WAN IP." ],
4164         ['1', '-I', '--info', "General info, including processes, uptime, memory,
4165         IRC client or shell type, $self_name version." ],
4166         ['1', '-l', '--label', "$partition_string_u labels. Triggers -P.
4167         For full -p output, use -pl." ],
4168         ['1', '-m', '--memory', "Memory (RAM) data. Requires root. Numbers of
4169         devices (slots) supported and individual memory devices (sticks of memory etc).
4170         For devices, shows device locator, size, speed, type (e.g. DDR3).
4171         If neither -I nor -tm are selected, also shows RAM used/total." ],
4172         ['1', '-M', '--machine', "Machine data. Device type (desktop, server, laptop,
4173         VM etc.), motherboard, BIOS and, if    present, system builder (e.g. Lenovo).
4174         Shows UEFI/BIOS/UEFI [Legacy]. Older systems/kernels without the required /sys
4175         data can use dmidecode instead, run as root. Dmidecode can be forced with --dmidecode" ],
4176         ['1', '-n', '--network-advanced', "Advanced Network card info. Triggers -N. Shows
4177         interface, speed, MAC id, state, etc. " ],
4178         ['1', '-N', '--network', "Network card(s), driver." ],
4179         ['1', '-o', '--unmounted', "Unmounted $partition_string info (includes UUID
4180         and Label if available). Shows file system type if you have lsblk installed
4181         (Linux) or, for BSD/GNU Linux, if 'file' installed and you are root or if
4182         you have added to /etc/sudoers (sudo v. 1.7 or newer)." ],
4183         ['1', '', '', "Example: ^<username>^ALL^=^NOPASSWD:^/usr/bin/file^" ],
4184         ['1', '-p', '--partitions-full', "Full $partition_string information (-P plus all other
4185         detected ${partition_string}s)." ],
4186         ['1', '-P', '--partitions', "Basic $partition_string info. Shows, if detected:
4187         / /boot /home /opt /tmp /usr /var /var/log /var/tmp. Use -p to see all
4188         mounted ${partition_string}s." ],
4189         ['1', '-r', '--repos', "Distro repository data. Supported repo types: APK,
4190         APT, EOPKG, PACMAN, PACMAN-G2, PISI, PORTAGE, PORTS (BSDs), SLACKPKG,
4191         URPMQ, YUM/ZYPP." ],
4192         ['1', '-R', '--raid', "RAID data. Shows RAID devices, states, levels,
4193         and components. md-raid: If device is resyncing, also shows resync progress line." ],
4194         ['1', '-s', '--sensors', "Sensors output (if sensors installed/configured):
4195         mobo/CPU/GPU temp; detected fan speeds. GPU temp only for Fglrx/Nvidia drivers.
4196         Nvidia shows screen number for > 1 screen. IPMI sensors if present." ],
4197         ['1', '', '--slots', "PCI slots: type, speed, status. Requires root." ],
4198         ['1', '-S', '--system', "System info: host name, kernel, desktop environment
4199         (if in X/Wayland), distro." ],
4200         ['1', '-t', '--processes', "Processes. Requires extra options: c (CPU), m
4201         (memory), cm (CPU+memory). If followed by numbers 1-x, shows that number
4202         of processes for each type (default: 5; if in IRC, max: 5). " ],
4203         ['1', '', '', "Make sure that there is no space between letters and
4204         numbers (e.g.^-t^cm10)." ],
4205         ['1', '', '--usb', "Show USB data: Hubs and Devices." ],
4206         ['1', '-u', '--uuid', "$partition_string_u UUIDs. Triggers -P. For full -p
4207         output, use -pu." ],
4208         ['1', '-v', '--verbosity', "Set $self_name verbosity level (0-8).
4209         Should not be used with -b or -F. Example: $self_name^-v^4" ],
4210         ['2', '0', '', "Same as: $self_name" ],
4211         ['2', '1', '', "Basic verbose, -S + basic CPU + -G + basic Disk + -I." ],
4212         ['2', '2', '', "Networking card (-N), Machine (-M), Battery (-B; if present),
4213         and, if present, basic RAID (devices only; notes if inactive).
4214         Same as $self_name^-b" ],
4215         ['2', '3', '', "Advanced CPU (-C), battery (-B), network (-n);
4216         triggers -x. " ],
4217         ['2', '4', '', "$partition_string_u size/used data (-P) for
4218         (if present) /, /home, /var/, /boot. Shows full disk data (-D). " ],
4219         ['2', '5', '', "Audio card (-A), sensors (-s), memory/RAM (-m),
4220         $partition_string label^(-l), UUID^(-u), short form of optical drives,
4221         standard RAID data (-R). " ],
4222         ['2', '6', '', "Full $partition_string (-p), unmounted $partition_string (-o),
4223         optical drive (-d), USB (--usb), full RAID; triggers -xx." ],
4224         ['2', '7', '', "Network IP data (-i); triggers -xxx."],
4225         ['2', '8', '', "Everything available, including repos (-r), processes
4226         (-tcm), PCI slots (--slots)."],
4227         );
4228         push @data, @rows;
4229         # if distro maintainers don't want the weather feature disable it
4230         if ( $b_weather ){
4231                 @rows = (
4232                 ['1', '-w', '--weather', "Local weather data/time. To check an alternate
4233                 location, see -W."],
4234                 ['1', '-W', '--weather-location', "[location] Supported options for
4235                 [location]: postal code; city, state/country; latitude, longitude.
4236                 Only use if you want the weather somewhere other than the machine running
4237                 $self_name. Use only ASCII characters, replace spaces in city/state/country
4238                 names with '+'. Example:^$self_name^-W^new+york,ny"],
4239                 ['1', '', '--weather-unit', "Set weather units to metric (m), imperial (i),
4240                 metric/imperial (mi), or imperial/metric (im)."],
4241                 );
4242                 push @data, @rows;
4243         }
4244         @rows = (
4245         ['1', '-x', '--extra', "Adds the following extra data (only works with
4246         verbose or line output, not short form):" ],
4247         ['2', '-B', '', "Vendor/model, status (if available); attached devices
4248         (e.g. wireless mouse, keyboard, if present)." ],
4249         ['2', '-C', '', "CPU $flags, Bogomips on CPU; CPU microarchitecture +
4250         revision (if found, or unless --admin, then shows as 'stepping')." ],
4251         ['2', '-d', '', "Extra optical drive features data; adds rev version to
4252         optical drive." ],
4253         ['2', '-D', '', "HDD temp with disk data if you have hddtemp installed,
4254         if you are root, or if you have added to /etc/sudoers (sudo v. 1.7 or newer).
4255         Example:^<username>^ALL^=^NOPASSWD:^/usr/sbin/hddtemp" ],
4256         ['2', '-G', '', "Direct rendering status (in X); Screen number GPU is
4257         running on (Nvidia only)." ],
4258         ['2', '-i', '', "For IPv6, show additional scope addresses: Global, Site,
4259         Temporary, Unknown. See --limit for large counts of IP addresses." ],
4260         ['2', '-I', '', "Default system GCC. With -xx, also shows other installed
4261         GCC versions. If running in shell, not in IRC client, shows shell version
4262         number, if detected. Init/RC type and runlevel (if available)." ],
4263         ['2', '-m', '', "Max memory module size (if available), device type." ],
4264         ['2', '-N -A', '', "Version/port(s)/driver version (if available)." ],
4265         ['2', '-N -A -G', '', "PCI Bus ID/USB ID number of card." ],
4266         ['2', '-R', '', "md-raid: second RAID Info line with extra data:
4267         blocks, chunk size, bitmap (if present). Resync line, shows blocks
4268         synced/total blocks. Hardware RAID driver version, bus ID." ],
4269         ['2', '-s', '', "Basic voltages (ipmi, lm-sensors if present): 12v, 5v, 3.3v, vbat." ],
4270         ['2', '-S', '', "Kernel gcc version; system base of distro (if relevant
4271         and detected)" ],
4272         ['2', '-t', '', "Adds memory use output to CPU (-xt c), and CPU use to
4273         memory (-xt m)." ],
4274         ['2', '--usb', '', "For Devices, shows USB version/speed." ],
4275         );
4276         push @data, @rows;
4277         if ( $b_weather ){
4278                 @rows = (['2', '-w -W', '', "Wind speed and direction, humidity, pressure,
4279                 and (-w only) time zone." ]);
4280                 push @data, @rows;
4281         }
4282         @rows = (
4283         ['1', '-xx', '--extra 2', "Show extra, extra data (only works with verbose
4284         or line output, not short form):" ],
4285         ['2', '-A', '', "Chip vendor:product ID for each audio device." ],
4286         ['2', '-B', '', "Serial number, voltage now/minimum (if available)." ],
4287         ['2', '-C', '', "Minimum CPU speed, if available." ],
4288         ['2', '-D', '', "Disk transfer speed; NVMe lanes; Disk serial number." ],
4289         ['2', '-G', '', "Chip vendor:product ID for each video card; OpenGL
4290         compatibility version, if free drivers and available; compositor (experimental);
4291         alternate Xorg drivers (if available). Alternate means driver is on automatic
4292         driver check list of Xorg for the card vendor, but is not installed on system." ],
4293         ['2', '-I', '', "Other detected installed gcc versions (if present). System
4294         default runlevel. Adds parent program (or tty) for shell info if not in
4295         IRC. Adds Init version number, RC (if found)." ],
4296         ['2', '-m', '', "Manufacturer, part number; single/double bank (if found)." ],
4297         ['2', '-M', '', "Chassis info, BIOS ROM size (dmidecode only), if available." ],
4298         ['2', '-N', '', "Chip vendor:product ID." ],
4299         ['2', '-R', '', "md-raid: Superblock (if present), algorithm. If resync,
4300         shows progress bar. Hardware RAID Chip vendor:product ID." ],
4301         ['2', '-s', '', "DIMM/SOC voltages (ipmi only)." ],
4302         ['2', '-S', '', "Display manager (dm) in desktop output (e.g. kdm,
4303         gdm3, lightdm); active window manager if detected; desktop toolkit,
4304         if available (Xfce/KDE/Trinity only)." ],
4305         ['2', '--slots', '', "Slot length." ],
4306         ['2', '--usb', '', "Vendor:chip ID." ],
4307         );
4308         push @data, @rows;
4309         if ( $b_weather ){
4310                 @rows = (['2', '-w -W', '', "Wind chill, dew point, heat index, if available." ]);
4311                 push @data, @rows;
4312         }
4313         @rows = (
4314         ['1', '-xxx', '--extra 3', "Show extra, extra, extra data (only works
4315         with verbose or line output, not short form):" ],
4316         ['2', '-A', '', "Specific vendor/product information (if relevant)." ],
4317         ['2', '-B', '', "Chemistry, cycles, location (if available)." ],
4318         ['2', '-C', '', "CPU boost (turbo) enabled/disabled, if present." ],
4319         ['2', '-D', '', "Firmware rev. if available; partition scheme, in some cases; disk
4320         rotation speed (if detected)." ],
4321         ['2', '-G', '', "Specific vendor/product information (if relevant)." ],
4322         ['2', '-I', '', "For 'Shell:' adds ([su|sudo|login]) to shell name if present;
4323         for 'running in:' adds (SSH) if SSH session." ],
4324         ['2', '-m', '', "Width of memory bus, data and total (if present and greater
4325         than data); Detail for Type, if present; module voltage, if available; serial
4326         number." ],
4327         ['2', '-R', '', "zfs-raid: portion allocated (used) by RAID devices/arrays.
4328         md-raid: system md-raid support types (kernel support, read ahead, RAID events).
4329         Hardware RAID rev, ports, specific vendor/product information." ],
4330         ['2', '-S', '', "Panel/shell info in desktop output, if in X (like lxpanel,
4331         xfce4-panel, mate-panel); (if available) dm version number, window manager
4332         version number." ]
4333         );
4334         push @data, @rows;
4335         if ( $b_weather ){
4336                 @rows = (['2', '-w -W', '', "Location (uses -z/irc filter), weather observation
4337                 time, altitude (shows extra lines for data where relevant)." ] );
4338                 push @data, @rows;
4339         }
4340         @rows = (
4341         ['1', '', '--admin', "Adds advanced sys admin data (only works with
4342         verbose or line output, not short form):" ],
4343         ['2', '-C', '', "If available: CPU errata (bugs); family, model-id, stepping - format:
4344         hex (decimal) if greater than 9, otherwise hex; microcode - format: hex." ],
4345         ['1', '-y', '--width', "Output line width max (integer >= 80). Overrides IRC/Terminal
4346         settings or actual widths. Example:^inxi^-y^130" ],
4347         ['1', '-z', '--filter', "Adds security filters for IP/MAC addresses, serial numbers,
4348         location (-w), user home directory name. Default on for IRC clients." ],
4349         ['1', '-Z', '--filter-override', "Absolute override for output filters. Useful for
4350         debugging networking issues in IRC, for example." ],
4351         [0, '', '', "$line" ],
4352         [0, '', '', "Additional Options:" ],
4353         ['1', '-h', '--help', "This help menu." ],
4354         ['1', '', '--recommends', "Checks $self_name application dependencies + recommends,
4355         and directories, then shows what package(s) you need to install to add support
4356         for that feature." ]
4357         );
4358         push @data, @rows;
4359         if ( $b_update ){
4360                 @rows = (
4361                 ['1', '-U', '--update', "Auto-update $self_name. Will also install/update man
4362                 page. Note: if you installed as root, you must be root to update, otherwise
4363                 user is fine. Man page installs require root. No arguments downloads from
4364                 main $self_name git repo." ],
4365                 ['1', '', '', "Use alternate sources for updating $self_name" ],
4366                 ['2', '1', '', "Get the git branch one version." ],
4367                 ['2', '2', '', "Get the git branch two version." ],
4368                 ['3', '3', '', "Get the dev server (smxi.org) version." ],
4369                 ['2', '<http>', '', "Get a version of $self_name from your own server.
4370                 Use the full download path, e.g.^$self_name^-U^https://myserver.com/inxi" ]
4371                 );
4372                 push @data, @rows;
4373         }
4374         @rows = (
4375         ['1', '-V', '--version', "Prints $self_name version info then exits." ],
4376         ['0', '', '', "$line" ],
4377         ['0', '', '', "Advanced Options:" ],
4378         ['1', '', '--alt', "Trigger for various advanced options:" ],
4379         ['2', '40', '', "Bypass Perl as a downloader option." ],
4380         ['2', '41', '', "Bypass Curl as a downloader option." ],
4381         ['2', '42', '', "Bypass Fetch as a downloader option." ],
4382         ['2', '43', '', "Bypass Wget as a downloader option." ],
4383         ['2', '44', '', "Bypass Curl, Fetch, and Wget as downloader options. Forces
4384         Perl if HTTP::Tiny present." ],
4385         ['1', '', '--display', "[:[0-9]] Try to get display data out of X (default: display 0)." ],
4386         ['1', '', '--dmidecode', "Force use of dmidecode data instead of /sys where relevant
4387         (e.g. -M, -B)." ],
4388         ['1', '', '--downloader', "Force $self_name to use [curl|fetch|perl|wget] for downloads." ],
4389         ['1', '', '--host', "Turn on hostname for -S." ],
4390         ['1', '', '--indent-min', "Set point where $self_name autowraps line starters." ],
4391         ['1', '', '--limit', "[-1; 1-x] Set max output limit of IP addresses for -i
4392         (default 10; -1 removes limit)." ],
4393         );
4394         push @data, @rows;
4395         if ( $b_update ){
4396                 @rows = (
4397                 ['1', '', '--man', "Install correct man version for dev branch (-U 3) or pinxi using -U." ],
4398                 );
4399                 push @data, @rows;
4400         }
4401         @rows = (
4402         ['1', '', '--no-host', "Turn off hostname for -S. Useful if showing output from servers etc." ],
4403         );
4404         push @data, @rows;
4405         if ( $b_update ){
4406                 @rows = (
4407                 ['1', '', '--no-man', "Disable man install for all -U update actions." ],
4408                 );
4409                 push @data, @rows;
4410         }
4411         @rows = (
4412         ['1', '', '--no-ssl', "Skip SSL certificate checks for all downloader actions
4413         (Wget/Fetch/Curl only)." ],
4414         ['1', '', '--output', "[json|screen|xml] Change data output type. Requires --output-file
4415         if not screen." ],
4416         ['1', '', '--output-file', "[Full filepath|print] Output file to be used for --output." ],
4417         ['1', '', '--proc', "Force debugger parsing of /proc as sudo/root." ],
4418         ['1', '', '--sleep', "[0-x.x] Change CPU sleep time, in seconds, for -C
4419         (default:^$cpu_sleep). Allows system to catch up and show a more accurate CPU
4420         use. Example:^$self_name^-Cxxx^--sleep^0.15" ],
4421         ['1', '', '--wm', "Force wm: to use wmctrl as data source. Default uses ps." ],
4422         ['0', '', '', $line ],
4423         ['0', '', '', "Debugging Options:" ],
4424         ['1', '', '--debug', "Triggers debugging modes." ],
4425         ['2', '1-3', '', "On screen debugger output." ],
4426         ['2', '10', '', "Basic logging." ],
4427         ['2', '11', '', "Full file/system info logging." ],
4428         ['1', '', ,'', "The following create a tar.gz file of system data, plus $self_name
4429         output. To automatically upload debugger data tar.gz file
4430         to ftp.techpatterns.com: $self_name^--debug^21" ],
4431         ['2', '20', '', "Full system data collection: /sys; xorg conf and log data, xrandr,
4432         xprop, xdpyinfo, glxinfo etc.; data from dev, disks,
4433         ${partition_string}s, etc." ],
4434         ['2', '21', '', "Upload debugger dataset to $self_name debugger server
4435         automatically, removes debugger data directory, leaves tar.gz debugger file." ],
4436         ['2', '22', '', "Upload debugger dataset to $self_name debugger server
4437         automatically, removes debugger data directory and debugger tar.gz file." ],
4438         ['1', '', '--ftp', "Use with --debugger 21 to trigger an alternate FTP server for upload.
4439         Format:^[ftp.xx.xx/yy]. Must include a remote directory to upload to.
4440         Example:^$self_name^--debug^21^--ftp^ftp.myserver.com/incoming" ],
4441         ['0', '', '', "$line" ],
4442         );
4443         push @data, @rows;
4444         print_basic(@data);
4445         exit 1;
4446 }
4447
4448 sub show_version {
4449         require Cwd;
4450         import Cwd;
4451         # if not in PATH could be either . or directory name, no slash starting
4452         my $working_path=$self_path;
4453         my (@data, @row, @rows, $link, $self_string);
4454         if ( $working_path eq '.' ){
4455                 $working_path = getcwd();
4456         }
4457         elsif ( $working_path !~ /^\// ){
4458                 $working_path = getcwd() . "/$working_path";
4459         }
4460         # handle if it's a symbolic link, rare, but can happen with directories
4461         # in irc clients which would only matter if user starts inxi with -! 30 override
4462         # in irc client
4463         if ( -l "$working_path/$self_name" ){
4464                 $link="$working_path/$self_name";
4465                 $working_path = readlink "$working_path/$self_name";
4466                 $working_path =~ s/[^\/]+$//;
4467         }
4468         # strange output /./ ending, but just trim it off, I don't know how it happens
4469         $working_path =~ s%/\./%/%;
4470         @row = ([ 0, '', '', "$self_name $self_version-$self_patch ($self_date)"],);
4471         push @data, @row;
4472         if ( ! $b_irc ){
4473                 @row = ([ 0, '', '', ""],);
4474                 push @data, @row;
4475                 my $year = (split/-/, $self_date)[0];
4476                 @row = [ 0, '', '', "Program Location: $working_path" ];
4477                 push @data, @row;
4478                 if ( $link ){
4479                         @row = [ 0, '', '', "Started via symbolic link: $link" ];
4480                         push @data, @row;
4481                 }
4482                 @rows = (
4483                 [ 0, '', '', "Website:^https://github.com/smxi/inxi^or^https://smxi.org/" ],
4484                 [ 0, '', '', "IRC:^irc.oftc.net channel:^#smxi" ],
4485                 [ 0, '', '', "Forums:^https://techpatterns.com/forums/forum-33.html" ],
4486                 [ 0, '', '', " " ],
4487                 [ 0, '', '', "$self_name - the universal, portable, system information tool
4488                 for console and irc." ],
4489                 [ 0, '', '', "Using Perl version: $]"],
4490                 [ 0, '', '', " " ],
4491                 [ 0, '', '', "This program started life as a fork of Infobash 3.02:
4492                 Copyright^(C)^2005-2007^Michiel^de^Boer^aka^locsmif." ],
4493                 [ 0, '', '', "Subsequent changes and modifications (after Infobash 3.02):
4494                 Copyright^(C)^2008-$year^Harald^Hope^aka^h2.
4495                 CPU/Konversation^fixes:^Scott^Rogers^aka^trash80.
4496                 USB^audio^fixes:^Steven^Barrett^aka^damentz." ],
4497                 [ 0, '', '', '' ],
4498                 [ 0, '', '', "This program is free software; you can redistribute it and/or modify
4499                 it under the terms of the GNU General Public License as published by the Free Software
4500                 Foundation; either version 3 of the License, or (at your option) any later version.
4501                 (https://www.gnu.org/licenses/gpl.html)" ]
4502                 );
4503                 push @data, @rows;
4504         }
4505         print_basic(@data);
4506         exit 1;
4507 }
4508
4509 ########################################################################
4510 #### STARTUP DATA
4511 ########################################################################
4512
4513 # StartClient
4514 {
4515 package StartClient;
4516
4517 # use warnings;
4518 # use strict;
4519
4520 my $ppid = '';
4521 my $pppid = '';
4522
4523 # NOTE: there's no reason to crete an object, we can just access
4524 # the features statically.
4525 # args: none
4526 # sub new {
4527 #       my $class = shift;
4528 #       my $self = {};
4529 #       # print "$f\n";
4530 #       # print "$type\n";
4531 #       return bless $self, $class;
4532 # }
4533
4534 sub get_client_data {
4535         eval $start if $b_log;
4536         $ppid = getppid();
4537         main::set_ps_aux() if ! @ps_aux;
4538         if (!$b_irc){
4539                 main::get_shell_data($ppid);
4540         }
4541         else {
4542                 $show{'filter'} = 1;
4543                 get_client_name();
4544                 if ($client{'konvi'} == 1 || $client{'konvi'} == 3){
4545                         set_konvi_data();
4546                 }
4547         }
4548         eval $end if $b_log;
4549 }
4550
4551 sub get_client_name {
4552         eval $start if $b_log;
4553         my $client_name = '';
4554
4555         # print "$ppid\n";
4556         if ($ppid && -e "/proc/$ppid/exe" ){
4557                 $client_name = lc(readlink "/proc/$ppid/exe");
4558                 $client_name =~ s/^.*\///;
4559                 if ($client_name =~ /^bash|dash|sh|python.*|perl.*$/){
4560                         $pppid = (main::grabber("ps -p $ppid -o ppid"))[1];
4561                         #my @temp = (main::grabber("ps -p $ppid -o ppid 2>/dev/null"))[1];
4562                         $pppid =~ s/^\s+|\s+$//g;
4563                         $client_name =~ s/[0-9\.]+$//; # clean things like python2.7
4564                         if ($pppid && -f "/proc/$pppid/exe" ){
4565                                 $client_name = lc(readlink "/proc/$pppid/exe");
4566                                 $client_name =~ s/^.*\///;
4567                                 $client{'native'} = 0;
4568                         }
4569                 }
4570                 $client{'name'} = $client_name;
4571                 get_client_version();
4572                 # print "c:$client_name p:$pppid\n";
4573         }
4574         else {
4575                 if (! check_modern_konvi() ){
4576                         $ppid = getppid();
4577                         $client_name = (main::grabber("ps -p $ppid"))[1];
4578                         if ($client_name){
4579                                 my @data = split /\s+/, $client_name if $client_name;
4580                                 if ($bsd_type){
4581                                         $client_name = lc($data[5]);
4582                                 }
4583                                 # gnu/linux uses last value
4584                                 else {
4585                                         $client_name = lc($data[-1]);
4586                                 }
4587                                 $client_name =~ s/.*\|-(|)//;
4588                                 $client_name =~ s/[0-9\.]+$//; # clean things like python2.7
4589                                 $client{'name'} = $client_name;
4590                                 $client{'native'} = 1;
4591                                 get_client_version();
4592                         }
4593                         else {
4594                                 $client{'name'} = "PPID='$ppid' - Empty?";
4595                         }
4596                 }
4597         }
4598         if ($b_log){
4599                 my $string = "Client: $client{'name'} :: version: $client{'version'} :: konvi: $client{'konvi'} :: PPID: $ppid";
4600                 main::log_data('data', $string);
4601         }
4602         eval $end if $b_log;
4603 }
4604 sub get_client_version {
4605         eval $start if $b_log;
4606         @app = main::program_values($client{'name'});
4607         my (@data,@working,$string);
4608         if (@app){
4609                 $string = ($client{'name'} =~ /^gribble|limnoria|supybot$/) ? 'supybot' : $client{'name'};
4610                 $client{'version'} = main::program_version($string,$app[0],$app[1],$app[2],$app[4],$app[5],$app[6]);
4611                 $client{'name-print'} = $app[3];
4612                 $client{'console-irc'} = $app[4];
4613         }
4614         if ($client{'name'} =~ /^bash|dash|sh$/ ){
4615                 $client{'name-print'} = 'shell wrapper';
4616                 $client{'console-irc'} = 1;
4617         }
4618         elsif ($client{'name'} eq 'bitchx') {
4619                 @data = main::grabber("$client{'name'} -v");
4620                 $string = awk(\@data,'Version');
4621                 if ($string){
4622                         $string =~ s/[()]|bitchx-//g;
4623                         @data = split /\s+/, $string;
4624                         $_=lc for @data;
4625                         $client{'version'} = ($data[1] eq 'version') ? $data[2] : $data[1];
4626                 }
4627         }
4628         # 'hexchat' => ['',0,'','HexChat',0,0], # special
4629         # the hexchat author decided to make --version/-v return a gtk dialogue box, lol...
4630         # so we need to read the actual config file for hexchat. Note that older hexchats
4631         # used xchat config file, so test first for default, then legacy. Because it's possible
4632         # for this file to be user edited, doing some extra checks here.
4633         elsif ($client{'name'} eq 'hexchat') {
4634                 if ( -f '~/.config/hexchat/hexchat.conf' ){
4635                         @data = main::reader('~/.config/hexchat/hexchat.conf','strip');
4636                 }
4637                 elsif ( -f '~/.config/hexchat/xchat.conf' ){
4638                         @data = main::reader('~/.config/hexchat/xchat.conf','strip');
4639                 }
4640                 $client{'version'} = main::awk(\@data,'version',2,'\s*=\s*');
4641                 $client{'name-print'} = 'HexChat';
4642         }
4643         # note: see legacy inxi konvi logic if we need to restore any of the legacy code.
4644         elsif ($client{'name'} eq 'konversation') {
4645                 $client{'konvi'} = ( ! $client{'native'} ) ? 2 : 1;
4646         }
4647         elsif ($client{'name'} =~ /quassel/) {
4648                 @data = main::grabber("$client{'name'} -v 2>/dev/null");
4649                 foreach (@data){
4650                         if ($_ =~ /^Quassel IRC:/){
4651                                 $client{'version'} = (split /\s+/, $_ )[2];
4652                                 last;
4653                         }
4654                         elsif ($_ =~ /quassel\s[v]?[0-9]/){
4655                                 $client{'version'} = (split /\s+/, $_ )[1];
4656                                 last;
4657                         }
4658                 }
4659                 $client{'version'} ||= '(pre v0.4.1)?';
4660         }
4661         # then do some perl type searches, do this last since it's a wildcard search
4662         elsif ($client{'name'} =~ /^perl.*|ksirc|dsirc$/ ) {
4663                 my @cmdline = main::get_cmdline();
4664                 # Dynamic runpath detection is too complex with KSirc, because KSirc is started from
4665                 # kdeinit. /proc/<pid of the grandparent of this process>/exe is a link to /usr/bin/kdeinit
4666                 # with one parameter which contains parameters separated by spaces(??), first param being KSirc.
4667                 # Then, KSirc runs dsirc as the perl irc script and wraps around it. When /exec is executed,
4668                 # dsirc is the program that runs inxi, therefore that is the parent process that we see.
4669                 # You can imagine how hosed I am if I try to make inxi find out dynamically with which path
4670                 # KSirc was run by browsing up the process tree in /proc. That alone is straightjacket material.
4671                 # (KSirc sucks anyway ;)
4672                 foreach (@cmdline){
4673                         if ( $_ =~ /dsirc/ ){
4674                                 $client{'version'} = main::program_version('ksirc','KSirc:',2,'-v',0,0);
4675                                 $client{'name'} = 'ksirc';
4676                                 $client{'name-print'} = 'KSirc';
4677                         }
4678                 }
4679                 $client{'console-irc'} = 1;
4680                 perl_python_client();
4681         }
4682         elsif ($client{'name'} =~ /python/) {
4683                 perl_python_client();
4684         }
4685         if (!$client{'name-print'}) {
4686                 $client{'name-print'} = 'Unknown Client: ' . $client{'name'};
4687         }
4688         eval $end if $b_log;
4689 }
4690 sub get_cmdline {
4691         eval $start if $b_log;
4692         my @cmdline;
4693         my $i = 0;
4694         $ppid = getppid();
4695         if (! -e "/proc/$ppid/cmdline" ){
4696                 return 1;
4697         }
4698         local $\ = '';
4699         open( my $fh, '<', "/proc/$ppid/cmdline" ) or
4700           print_line("Open /proc/$ppid/cmdline failed: $!");
4701         my @rows = <$fh>;
4702         close $fh;
4703
4704         foreach (@rows){
4705                 push @cmdline, $_;
4706                 $i++;
4707                 last if $i > 31;
4708         }
4709         if ( $i == 0 ){
4710                 $cmdline[0] = $rows[0];
4711                 $i = ($cmdline[0]) ? 1 : 0;
4712         }
4713         main::log_data('string',"cmdline: @cmdline count: $i") if $b_log;
4714         eval $end if $b_log;
4715         return @cmdline;
4716 }
4717 sub perl_python_client {
4718         eval $start if $b_log;
4719         return 1 if $client{'version'};
4720         # this is a hack to try to show konversation if inxi is running but started via /cmd
4721         # OR via program shortcuts, both cases in fact now
4722         # main::print_line("konvi: " . scalar grep { $_ =~ /konversation/ } @ps_cmd);
4723         if ( $b_display && main::check_program('konversation') && ( grep { $_ =~ /konversation/ } @ps_cmd )){
4724                 @app = main::program_values('konversation');
4725                 $client{'version'} = main::program_version('konversation',$app[0],$app[1],$app[2],$app[5],$app[6]);
4726                 $client{'name'} = 'konversation';
4727                 $client{'name-print'} = $app[3];
4728                 $client{'console-irc'} = $app[4];
4729         }
4730         ## NOTE: supybot only appears in ps aux using 'SHELL' command; the 'CALL' command
4731         ## gives the user system irc priority, and you don't see supybot listed, so use SHELL
4732         elsif ( !$b_display &&
4733          (main::check_program('supybot') || main::check_program('gribble') || main::check_program('limnoria')) &&
4734          ( grep { $_ =~ /supybot/ } @ps_cmd ) ){
4735                 @app = main::program_values('supybot');
4736                 $client{'version'} = main::program_version('supybot',$app[0],$app[1],$app[2],$app[5],$app[6]);
4737                 if ($client{'version'}){
4738                         if ( grep { $_ =~ /gribble/ } @ps_cmd ){
4739                                 $client{'name'} = 'gribble';
4740                                 $client{'name-print'} = 'Gribble';
4741                         }
4742                         if ( grep { $_ =~ /limnoria/ } @ps_cmd){
4743                                 $client{'name'} = 'limnoria';
4744                                 $client{'name-print'} = 'Limnoria';
4745                         }
4746                         else {
4747                                 $client{'name'} = 'supybot';
4748                                 $client{'name-print'} = 'Supybot';
4749                         }
4750                 }
4751                 else {
4752                         $client{'name'} = 'supybot';
4753                         $client{'name-print'} = 'Supybot';
4754                 }
4755                 $client{'console-irc'} = 1;
4756         }
4757         else {
4758                 $client{'name-print'} = "Unknown $client{'name'} client";
4759         }
4760         if ($b_log){
4761                 my $string = "namep: $client{'name-print'} name: $client{'name'} version: $client{'version'}";
4762                 main::log_data('data',$string);
4763         }
4764         eval $end if $b_log;
4765 }
4766 ## try to infer the use of Konversation >= 1.2, which shows $PPID improperly
4767 ## no known method of finding Konvi >= 1.2 as parent process, so we look to see if it is running,
4768 ## and all other irc clients are not running. As of 2014-03-25 this isn't used in my cases
4769 sub check_modern_konvi {
4770         eval $start if $b_log;
4771
4772         return 0 if ! $client{'qdbus'};
4773         my $b_modern_konvi = 0;
4774         my $konvi_version = '';
4775         my $konvi = '';
4776         my $pid = '';
4777         my (@temp);
4778         # main::log_data('data',"name: $client{'name'} :: qdb: $client{'qdbus'} :: version: $client{'version'} :: konvi: $client{'konvi'} :: PPID: $ppid") if $b_log;
4779         # sabayon uses /usr/share/apps/konversation as path
4780         if ( -d '/usr/share/kde4/apps/konversation' || -d '/usr/share/apps/konversation' ){
4781                 $pid = main::awk(\@ps_aux,'konversation',2,'\s+');
4782                 main::log_data('data',"pid: $pid") if $b_log;
4783                 $konvi = readlink ("/proc/$pid/exe");
4784                 $konvi =~ s/^.*\///; # basename
4785                 @app = main::program_values('konversation');
4786                 if ($konvi){
4787                         @app = main::program_values('konversation');
4788                         $konvi_version = main::program_version($konvi,$app[0],$app[1],$app[2],$app[5],$app[6]);
4789                         @temp = split /\./, $konvi_version;
4790                         $client{'console-irc'} = $app[4];
4791                         $client{'konvi'} = 3;
4792                         $client{'name'} = 'konversation';
4793                         $client{'name-print'} = $app[3];
4794                         $client{'version'} = $konvi_version;
4795                         # note: we need to change this back to a single dot number, like 1.3, not 1.3.2
4796                         $konvi_version = $temp[0] . "." . $temp[1];
4797                         if ($konvi_version > 1.1){
4798                                 $b_modern_konvi = 1;
4799                         }
4800                 }
4801         }
4802         main::log_data('data',"name: $client{'name'} name print: $client{'name-print'}
4803         qdb: $client{'qdbus'} version: $konvi_version konvi: $konvi PID: $pid") if $b_log;
4804         main::log_data('data',"b_is_qt4: $b_modern_konvi") if $b_log;
4805         ## for testing this module
4806 #       my $ppid = getppid();
4807 #       system('qdbus org.kde.konversation', '/irc', 'say', $client{'dserver'}, $client{'dtarget'},
4808 #       "getpid_dir: $konvi_qt4 verNum: $konvi_version pid: $pid ppid: $ppid" );
4809         eval $end if $b_log;
4810         return $b_modern_konvi;
4811 }
4812
4813 sub set_konvi_data {
4814         eval $start if $b_log;
4815         my $config_tool = '';
4816         # https://userbase.kde.org/Konversation/Scripts/Scripting_guide
4817         if ( $client{'konvi'} == 3 ){
4818                 $client{'dserver'} = shift @ARGV;
4819                 $client{'dtarget'} = shift @ARGV;
4820                 $client{'dobject'} = 'default';
4821         }
4822         elsif ( $client{'konvi'} == 1 ){
4823                 $client{'dport'} = shift @ARGV;
4824                 $client{'dserver'} = shift @ARGV;
4825                 $client{'dtarget'} = shift @ARGV;
4826                 $client{'dobject'} = 'Konversation';
4827         }
4828         # for some reason this logic hiccups on multiple spaces between args
4829         @ARGV = grep { $_ ne '' } @ARGV;
4830         # there's no current kde 5 konvi config tool that we're aware of. Correct if changes.
4831         if ( main::check_program('kde4-config') ){
4832                 $config_tool = 'kde4-config';
4833         }
4834         elsif ( main::check_program('kde5-config') ){
4835                 $config_tool = 'kde5-config';
4836         }
4837         elsif ( main::check_program('kde-config') ){
4838                 $config_tool = 'kde-config';
4839         }
4840         # The section below is on request of Argonel from the Konversation developer team:
4841         # it sources config files like $HOME/.kde/share/apps/konversation/scripts/inxi.conf
4842         if ($config_tool){
4843                 my @data = main::grabber("$config_tool --path data 2>/dev/null",':');
4844                 main::get_configs(@data);
4845         }
4846         eval $end if $b_log;
4847 }
4848 }
4849
4850 ########################################################################
4851 #### OUTPUT
4852 ########################################################################
4853
4854 #### -------------------------------------------------------------------
4855 #### FILTERS AND TOOLS
4856 #### -------------------------------------------------------------------
4857
4858 sub apply_filter {
4859         my ($string) = @_;
4860         if ($string){
4861                 $string = ( $show{'filter'} ) ? $filter_string : $string;
4862         }
4863         else {
4864                 $string = 'N/A';
4865         }
4866         return $string;
4867 }
4868 sub arm_cleaner {
4869         my ($item) = @_;
4870         $item =~ s/(\(?Device Tree\)?)//gi;
4871         $item =~ s/\s\s+/ /g;
4872         $item =~ s/^\s+|\s+$//g;
4873         return $item;
4874 }
4875
4876 sub clean_characters {
4877         my ($data) = @_;
4878         # newline, pipe, brackets, + sign, with space, then clear doubled
4879         # spaces and then strip out trailing/leading spaces.
4880         # etc/issue often has junk stuff like (\l)  \n \l
4881         return if ! $data;
4882         $data =~ s/[:\47]|\\[a-z]|\n|,|\"|\*|\||\+|\[\s\]|n\/a|\s\s+/ /g;
4883         $data =~ s/\(\)//;
4884         $data =~ s/^\s+|\s+$//g;
4885         return $data;
4886 }
4887 sub cleaner {
4888         my ($item) = @_;
4889         return $item if !$item;# handle cases where it was 0 or ''
4890         # note: |nee trips engineering, but I don't know why nee was filtered
4891         $item =~ s/chipset|company|components|computing|computer|corporation|communications|electronics|electrical|electric|gmbh|group|incorporation|industrial|international|\bnee\b|revision|semiconductor|software|technologies|technology|ltd\.|<ltd>|\bltd\b|inc\.|<inc>|\binc\b|intl\.|co\.|<co>|corp\.|<corp>|\(tm\)|\(r\)|®|\(rev ..\)|\'|\"|\sinc\s*$|\?//gi;
4892         $item =~ s/,|\*/ /g;
4893         $item =~ s/\s\s+/ /g;
4894         $item =~ s/^\s+|\s+$//g;
4895         return $item;
4896 }
4897
4898 sub disk_cleaner {
4899         my ($item) = @_;
4900         return $item if !$item;
4901         # <?unknown>?|
4902         $item =~ s/vendor.*|product.*|O\.?E\.?M\.?//gi;
4903         $item =~ s/\s\s+/ /g;
4904         $item =~ s/^\s+|\s+$//g;
4905         return $item;
4906 }
4907
4908 sub dmi_cleaner {
4909         my ($string) = @_;
4910         my $cleaner = '^Base Board .*|^Chassis .*|empty|Undefined.*|.*O\.E\.M\..*|.*OEM.*|^Not .*';
4911         $cleaner .= '|^System .*|.*unknow.*|.*N\/A.*|none|^To be filled.*|^0x[0]+$';
4912         $cleaner .= '|\[Empty\]|<Bad Index>|Default string|^\.\.$|Manufacturer.*';
4913         $cleaner .= '|AssetTagNum|Manufacturer| Or Motherboard|PartNum.*|SerNum';
4914         $string =~ s/$cleaner//i;
4915         $string =~ s/^\s+|\bbios\b|\bacpi\b|\s+$//gi;
4916         $string =~ s/http:\/\/www.abit.com.tw\//Abit/i;
4917         $string =~ s/\s\s+/ /g;
4918         $string =~ s/^\s+|\s+$//g;
4919         $string = remove_duplicates($string) if $string;
4920         return $string;
4921 }
4922
4923 sub remove_duplicates {
4924         my ($string) = @_;
4925         return if ! $string;
4926         my $holder = '';
4927         my (@temp);
4928         my @data = split /\s+/, $string;
4929         foreach (@data){
4930                 if ($holder ne $_){
4931                         push @temp, $_;
4932                 }
4933                 $holder = $_;
4934         }
4935         $string = join ' ', @temp;
4936         return $string;
4937 }
4938
4939 # args: $1 - size in KB, return KB, MB, GB, TB, PB, EB
4940 sub get_size {
4941         my ($size,$b_int) = @_;
4942         my (@data);
4943         return ('','') if ! defined $size;
4944         if ($size !~ /^[0-9\.]+$/){
4945                 $data[0] = $size;
4946                 $data[1] = '';
4947         }
4948         elsif ($size > 1024**5){
4949                 $data[0] = sprintf("%.2f",$size/1024**5);
4950                 $data[1] = 'EiB';
4951         }
4952         elsif ($size > 1024**4){
4953                 $data[0] = sprintf("%.2f",$size/1024**4);
4954                 $data[1] = 'PiB';
4955         }
4956         elsif ($size > 1024**3){
4957                 $data[0] = sprintf("%.2f",$size/1024**3);
4958                 $data[1] = 'TiB';
4959         }
4960         elsif ($size > 1024**2){
4961                 $data[0] = sprintf("%.2f",$size/1024**2);
4962                 $data[1] = 'GiB';
4963         }
4964         elsif ($size > 1024){
4965                 $data[0] = sprintf("%.1f",$size/1024);
4966                 $data[1] = 'MiB';
4967         }
4968         else {
4969                 $data[0] = sprintf("%.0f",$size);
4970                 $data[1] = 'KiB';
4971         }
4972         $data[0] = int($data[0]) if $b_int && $data[0];
4973         return @data;
4974 }
4975
4976 # not used, but keeping logic for now
4977 sub increment_starters {
4978         my ($key,$indexes) = @_;
4979         my $result = $key;
4980         if (defined $$indexes{$key} ){
4981                 $$indexes{$key}++;
4982                 $result = "$key-$$indexes{$key}";
4983         }
4984         return $result;
4985 }
4986
4987 sub memory_data_full {
4988         eval $start if $b_log;
4989         my ($source) = @_;
4990         my $num = 0;
4991         my ($memory,@rows);
4992         my ($gpu_ram,$percent,$total,$used) = (0,'','','');
4993         if (!$show{'info'}){
4994                 $memory = get_memory_data('splits');
4995                 if ($memory){
4996                         my @temp = split /:/, $memory;
4997                         my @temp2 = get_size($temp[0]);
4998                         $gpu_ram = $temp[3] if $temp[3];
4999                         $total = ($temp2[1]) ? $temp2[0] . ' ' . $temp2[1] : $temp2[0];
5000                         @temp2 = get_size($temp[1]);
5001                         $used = ($temp2[1]) ? $temp2[0] . ' ' . $temp2[1] : $temp2[0];
5002                         $used .= " ($temp[2]%)" if $temp[2];
5003                         if ($gpu_ram){
5004                                 @temp2 = get_size($gpu_ram);
5005                                 $gpu_ram = $temp2[0] . ' ' . $temp2[1] if $temp2[1];
5006                         }
5007                 }
5008                 my $key = ($source eq 'process') ? 'System RAM': 'RAM';
5009                 $rows[0]{main::key($num++,$key)} = '';
5010                 $rows[0]{main::key($num++,'total')} = $total;
5011                 $rows[0]{main::key($num++,'used')} = $used;
5012                 $rows[0]{main::key($num++,'gpu')} = $gpu_ram if $gpu_ram;
5013         }
5014         $b_mem = 1;
5015         eval $end if $b_log;
5016         return @rows;
5017 }
5018
5019 sub pci_cleaner {
5020         my ($string,$type) = @_;
5021         #print "st1 $type:$string\n";
5022         my $filter = 'compatible\scontroller|\b(device|controller|connection|multimedia)\b|\([^)]+\)';
5023         # \[[^\]]+\]$| not trimming off ending [...] initial type filters removes end
5024         $filter = '\[[^\]]+\]$|' . $filter if $type eq 'pci';
5025         $string =~ s/$filter//ig;
5026         $string =~ s/\s\s+/ /g;
5027         $string =~ s/^\s+|\s+$//g;
5028         #print "st2 $type:$string\n";
5029         $string = remove_duplicates($string) if $string;
5030         return $string;
5031 }
5032 sub pci_cleaner_subsystem {
5033         my ($string) = @_;
5034         # we only need filters for features that might use vendor, -AGN
5035         my $filter = 'adapter|(hd\s)?audio|definition|desktop|ethernet|gigabit|graphics|';
5036         $filter .= 'hdmi(\/[\S]+)?|high|integrated|motherboard|network|onboard|';
5037         $filter .= 'raid|pci\s?express';
5038         $string =~ s/\b($filter)\b//gi;
5039         $string =~ s/\s\s+/ /g;
5040         $string =~ s/^\s+|\s+$//g;
5041         return $string;
5042 }
5043
5044 sub pci_long_filter {
5045         my ($string) = @_;
5046         if ($string =~ /\[AMD(\/ATI)?\]/){
5047                 $string =~ s/Advanced\sMicro\sDevices\s\[AMD(\/ATI)?\]/AMD/;
5048         }
5049         return $string;
5050 }
5051
5052 sub row_defaults {
5053         my ($type,$id) = @_;
5054         $id ||= '';
5055         my %unfound = (
5056         'arm-cpu-f' => 'Use -f option to see features',
5057         'arm-pci' => "No ARM data found for this feature.",
5058         'battery-data' => "No system battery data found. Is one present?",
5059         'battery-data-sys' => "No /sys data found. Old system?",
5060         'cpu-model-null' => "Model N/A",
5061         'cpu-speeds' => "No speed data found for $id cores.",
5062         'darwin-feature' => "Feature not supported iu Darwin/OSX.",
5063         'disk-data-bsd' => "No disk data found for this BSD system.",
5064         'disk-data' => "No Disk data was found.",
5065         'disk-size-0' => "Total N/A",
5066         'display-console' => 'No advanced graphics data found on this system in console.',
5067         'display-null' => 'No advanced graphics data found on this system.',
5068         'display-root' => 'Advanced graphics data unavailable in console for root.',
5069         'display-root-x' => 'Advanced graphics data unavailable for root. Old System?',
5070         'display-server' => "No display server data found. Headless machine?",
5071         'glxinfo-missing' => "Unable to show advanced data. Required tool glxinfo missing.",
5072         'display-try' => 'Advanced graphics data unavailable in console. Try -G --display',
5073         'dev' => 'Feature under development',
5074         'dmesg-boot-permissions' => 'dmesg.boot permissions',
5075         'dmesg-boot-missing' => 'dmesg.boot not found',
5076         'IP' => "No $id data found. Connected to the web? SSL issues?",
5077         'machine-data' => "No machine data: try newer kernel.",
5078         'machine-data-bsd' => "No machine data: Is dmidecode installed? Try -M --dmidecode.",
5079         'machine-data-dmidecode' => "No machine data: try newer kernel. Is dmidecode installed? Try -M --dmidecode.",
5080         'machine-data-force-dmidecode' => "No machine data: try newer kernel. Is dmidecode installed? Try -M --dmidecode.",
5081         'mips-pci' => "No MIPS data found for this feature.",
5082         'optical-data' => "No Optical or Floppy data was found.",
5083         'optical-data-bsd' => "No floppy or optical data found for this BSD system.",
5084         'output-limit' => "Output throttled. IPs: $id; Limit: $limit; Override: --limit [1-x;-1 all]",
5085         'partition-data' => "No Partition data was found.",
5086         'pci-advanced-data' => 'bus/chip ids unavailable',
5087         'pci-card-data' => "No PCI card data found.",
5088         'pci-slot-data' => "No PCI slot data found. SBC?",
5089         'raid-data' => "No RAID data was found.",
5090         'ram-data' => "No RAM data was found. SBC?",
5091         'root-required' => "<root required>",
5092         'sensors-data-ipmi' => "No ipmi sensors data was found.",
5093         'sensors-data-linux' => "No sensors data was found. Is sensors configured?",
5094         'sensors-ipmi-root' => "Unable to run ipmi sensors. Are you root?",
5095         'unmounted-data' => "No unmounted partitions found.",
5096         'unmounted-data-bsd' => "No unmounted partition data found for this BSD system.",
5097         'unmounted-file' => "No /proc/partitions file found.",
5098         'usb-data' => "No USB data was found. Server?",
5099         'unknown-desktop-version' => "ERR-101",
5100         'unknown-dev' => "ERR-102",
5101         'unknown-shell' => "ERR-100",
5102         'weather-null' => "No $id found. Internet connection working?",
5103         'xdpyinfo-missing' => '<xdpyinfo missing>',
5104         );
5105         return $unfound{$type};
5106 }
5107
5108 # convert string passed to KB, based on GB/MB/TB id
5109 # NOTE: K 1024 KB 1000
5110 sub translate_size {
5111         my ($working) = @_;
5112         my $size = 0;
5113         #print ":$working:\n";
5114         return if ! defined $working;
5115         my $math = ( $working =~ /B$/) ? 1000: 1024;
5116         if ( $working =~ /^([0-9\.]+)M[B]?$/i){
5117                 $size = $1 * $math;
5118         }
5119         elsif ( $working =~ /^([0-9\.]+)G[B]?$/i){
5120                 $size = $1 * $math**2;
5121         }
5122         elsif ( $working =~ /^([0-9\.]+)T[B]?$/i){
5123                 $size = $1 * $math**3;
5124         }
5125         elsif ( $working =~ /^([0-9\.]+)P[B]?$/i){
5126                 $size = $1 * $math**4;
5127         }
5128         elsif ( $working =~ /^([0-9\.]+)E[B]?$/i){
5129                 $size = $1 * $math**5;
5130         }
5131         elsif ( $working =~ /^([0-9\.]+)K[B]?$/i){
5132                 $size = $1;
5133         }
5134         $size = int($size) if $size;
5135         return $size;
5136 }
5137
5138 #### -------------------------------------------------------------------
5139 #### GENERATE OUTPUT
5140 #### -------------------------------------------------------------------
5141
5142 sub check_output_path {
5143         my ($path) = @_;
5144         my ($b_good,$dir,$file);
5145         $dir = $path;
5146         $dir =~ s/([^\/]+)$//;
5147         $file = $1;
5148         # print "file: $file : dir: $dir\n";
5149         $b_good = 1 if (-d $dir && -w $dir && $dir =~ /^\// && $file);
5150         return $b_good;
5151 }
5152
5153 sub output_handler {
5154         my (%data) = @_;
5155         # print Dumper \%data;
5156         if ($output_type eq 'screen'){
5157                 print_data(%data);
5158         }
5159         elsif ($output_type eq 'json'){
5160                 generate_json(%data);
5161         }
5162         elsif ($output_type eq 'xml'){
5163                 generate_xml(%data);
5164         }
5165 }
5166
5167 # NOTE: file has already been set and directory verified
5168 sub generate_json {
5169         eval $start if $b_log;
5170         my (%data) = @_;
5171         my ($json);
5172         my $b_debug = 1;
5173         my ($b_cpanel,$b_valid);
5174         error_handler('not-in-irc', 'help') if $b_irc;
5175         #print Dumper \%data if $b_debug;
5176         if (check_module('Cpanel::JSON::XS')){
5177                 import Cpanel::JSON::XS;
5178                 $json = Cpanel::JSON::XS::encode_json(\%data);
5179         }
5180         elsif (check_module('JSON::XS')){
5181                 import JSON::XS;
5182                 $json = JSON::XS::encode_json(\%data);
5183         }
5184         else {
5185                 error_handler('required-module', 'json', 'Cpanel::JSON::XS OR JSON::XS');
5186         }
5187         if ($json){
5188                 #$json =~ s/"[0-9]+#/"/g;
5189                 if ($output_file eq 'print'){
5190                         #$json =~ s/\}/}\n/g;
5191                         print "$json";
5192                 }
5193                 else {
5194                         print_line("Writing JSON data to: $output_file\n");
5195                         open(my $fh, '>', $output_file) or error_handler('open',$output_file,"$!");
5196                         print $fh "$json";
5197                         close $fh;
5198                         print_line("Data written successfully.\n");
5199                 }
5200         }
5201         eval $end if $b_log;
5202 }
5203
5204 # NOTE: So far xml is substantially more difficult than json, so
5205 # using a crude dumper rather than making a nice xml file, but at
5206 # least xml has some output now.
5207 sub generate_xml {
5208         eval $start if $b_log;
5209         my (%data) = @_;
5210         my ($xml);
5211         my $b_debug = 0;
5212         error_handler('not-in-irc', 'help') if $b_irc;
5213         #print Dumper \%data if $b_debug;
5214         if (check_module('XML::Dumper')){
5215                 import XML::Dumper;
5216                 $xml = XML::Dumper::pl2xml(\%data);
5217                 #$xml =~ s/"[0-9]+#/"/g;
5218                 if ($output_file eq 'print'){
5219                         print "$xml";
5220                 }
5221                 else {
5222                         print_line("Writing XML data to: $output_file\n");
5223                         open(my $fh, '>', $output_file) or error_handler('open',$output_file,"$!");
5224                         print $fh "$xml";
5225                         close $fh;
5226                         print_line("Data written successfully.\n");
5227                 }
5228         }
5229         else {
5230                 error_handler('required-module', 'xml', 'XML::Dumper');
5231         }
5232         eval $end if $b_log;
5233 }
5234
5235 sub key {
5236         return sprintf("%03d#%s", $_[0],$_[1]);
5237 }
5238
5239 sub print_basic {
5240         my (@data) = @_;
5241         my $indent = 18;
5242         my $indent_static = 18;
5243         my $indent1_static = 5;
5244         my $indent2_static = 8;
5245         my $indent1 = 5;
5246         my $indent2 = 8;
5247         my $length =  @data;
5248         my ($start,$aref,$i,$j,$line);
5249
5250         if ( $size{'max'} > 110 ){
5251                 $indent_static = 22;
5252         }
5253         elsif ($size{'max'} < 90 ){
5254                 $indent_static = 15;
5255         }
5256         # print $length . "\n";
5257         for my $i (0 .. $#data){
5258                 $aref = $data[$i];
5259                 #print "0: $data[$i][0]\n";
5260                 if ($data[$i][0] == 0 ){
5261                         $indent = 0;
5262                         $indent1 = 0;
5263                         $indent2 = 0;
5264                 }
5265                 elsif ($data[$i][0] == 1 ){
5266                         $indent = $indent_static;
5267                         $indent1 = $indent1_static;
5268                         $indent2= $indent2_static;
5269                 }
5270                 elsif ($data[$i][0] == 2 ){
5271                         $indent = ( $indent_static + 7 );
5272                         $indent1 = ( $indent_static + 5 );
5273                         $indent2 = 0;
5274                 }
5275                 $data[$i][3] =~ s/\n/ /g;
5276                 $data[$i][3] =~ s/\s+/ /g;
5277                 if ($data[$i][1] && $data[$i][2]){
5278                         $data[$i][1] = $data[$i][1] . ', ';
5279                 }
5280                 $start = sprintf("%${indent1}s%-${indent2}s",$data[$i][1],$data[$i][2]);
5281                 if ($indent > 1 && ( length($start) > ( $indent - 1) ) ){
5282                         $line = sprintf("%-${indent}s\n", "$start");
5283                         print_line($line);
5284                         $start = '';
5285                         #print "1-print.\n";
5286                 }
5287                 if ( ( $indent + length($data[$i][3]) ) < $size{'max'} ){
5288                         $data[$i][3] =~ s/\^/ /g;
5289                         $line = sprintf("%-${indent}s%s\n", "$start", $data[$i][3]);
5290                         print_line($line);
5291                         #print "2-print.\n";
5292                 }
5293                 else {
5294                         my $holder = '';
5295                         my $sep = ' ';
5296                         foreach my $word (split / /, $data[$i][3]){
5297                                 #print "$word\n";
5298                                 if ( ( $indent + length($holder) + length($word) ) < $size{'max'} ) {
5299                                         $word =~ s/\^/ /g;
5300                                         $holder .= $word . $sep;
5301                                         #print "3-hold.\n";
5302                                 }
5303                                 #elsif ( ( $indent + length($holder) + length($word) ) >= $size{'max'}){
5304                                 else {
5305                                         $line = sprintf("%-${indent}s%s\n", "$start", $holder);
5306                                         print_line($line);
5307                                         $start = '';
5308                                         $word =~ s/\^/ /g;
5309                                         $holder = $word . $sep;
5310                                         #print "4-print-hold.\n";
5311                                 }
5312                         }
5313                         if ($holder !~ /^[ ]*$/){
5314                                 $line = sprintf("%-${indent}s%s\n", "$start", $holder);
5315                                 print_line($line);
5316                                 #print "5-print-last.\n";
5317                         }
5318                 }
5319         }
5320 }
5321
5322 # this has to get a hash of hashes, at least for now.
5323 # because perl does not retain insertion order, I use a prefix for each
5324 # hash key to force sorts.
5325 sub print_data {
5326         my (%data) = @_;
5327         my $array = 0;
5328         my $array_holder = 1;
5329         my $counter=0;
5330         my $split_count = 0;
5331         my $hash = 0;
5332         my $holder = '';
5333         my $id_holder = 0;
5334         my $start = '';
5335         my $start2 = '';
5336         my $length = 0;
5337         my $indent = $size{'indent'};
5338         my (@temp,@working,@values,%ids,$holder2,%row);
5339         my ($key,$line,$val2,$val3);
5340         # $size{'max'} = 88;
5341         # NOTE: indent < 11 would break the output badly in some cases
5342         if ($size{'max'} < $size{'indent-min'} || $size{'indent'} < 11 ){
5343                 $indent = 2;
5344         }
5345         #foreach my $key1 (sort { (split/#/, $a)[0] <=> (split/#/, $b)[0] } keys %data) {
5346         foreach my $key1 (sort { substr($a,0,3) <=> substr($b,0,3) } keys %data) {
5347         #foreach my $key1 (sort { $a cmp $b } keys %data) {
5348                 $key = (split/#/, $key1)[1];
5349                 if ($key ne 'SHORT' ) {
5350                         $start = sprintf("$colors{'c1'}%-${indent}s$colors{'cn'}","$key$sep{'s1'}");
5351                         if ($indent < 10){
5352                                 $line = "$start\n";
5353                                 print_line($line);
5354                                 $start = '';
5355                                 $line = '';
5356                         }
5357                 }
5358                 else {
5359                         $indent = 0;
5360                 }
5361                 if (ref($data{$key1}) eq 'ARRAY'){
5362                         # @working = @{$data{$key1}};
5363                         %ids = (
5364                         'Array' => 1,
5365                         'array' => 1,
5366                         'Battery' => 1,
5367                         'Card' => 1,
5368                         'Device' => 1,
5369                         'Floppy' => 1,
5370                         'Hardware' => 1, # hardware raid report
5371                         'ID' => 1,
5372                         'IF-ID' => 1,
5373                         'Optical' => 1,
5374                         'variant' => 1, # arm > 1 cpu type
5375                         );
5376                         $array_holder = 1;
5377                         foreach my $val1 (@{$data{$key1}}){
5378                                 $length = $indent;
5379                                 if (ref($val1) eq 'HASH'){
5380                                         #%row = %$val1;
5381                                         $counter=0;
5382                                         $split_count = 0;
5383                                         $hash = scalar %$val1;
5384                                         #foreach my $key2 (sort { (split/#/, $a)[0] <=> (split/#/, $b)[0] } keys %$val1){
5385                                         foreach my $key2 (sort { substr($a,0,3) <=> substr($b,0,3) } keys %$val1){
5386                                         #foreach my $key2 (sort { $a cmp $b } keys %$val1){
5387                                                 $key = (split/#/, $key2)[1];
5388                                                 # for ram with > 1 system array, we want to reset device count to 1 for each
5389                                                 # new array
5390                                                 if ($key eq 'Array' && $array_holder != $ids{$key} ){
5391                                                         $array_holder = $ids{$key};
5392                                                         $ids{'Device'} = 1 if ($ids{'Device'} > 1);
5393                                                 }
5394                                                 if ($key eq 'Device' && $ids{'array'} > 1 && $id_holder != $ids{$key} ){
5395                                                         $id_holder = $ids{$key};
5396                                                         $ids{'array'} = 1 if ($ids{'array'} > 1);
5397                                                 }
5398                                                 if ($counter == 0 && defined $ids{$key}){
5399                                                         $key .= '-' . $ids{$key}++;
5400                                                 }
5401                                                 $val2 = $$val1{$key2};
5402                                                 # we have to handle cases where $val2 is 0
5403                                                 if ($val2 || $val2 eq '0'){
5404                                                         $val2 .= " ";
5405                                                 }
5406                                                 # see: Use of implicit split to @_ is deprecated. Only get this warning
5407                                                 # in Perl 5.08 oddly enough.
5408                                                 @temp = split/\s+/, $val2;
5409                                                 $split_count = scalar @temp;
5410                                                 if ( ( length( "$key$sep{'s2'} $val2" ) + $length ) < $size{'max'} ) {
5411                                                         $length += length("$key$sep{'s2'} $val2");
5412                                                         $holder .= "$colors{'c1'}$key$sep{'s2'}$colors{'c2'} $val2";
5413                                                         #print "one\n";
5414                                                 }
5415                                                 # handle case where the opening key/value pair is > max, and where
5416                                                 # there are a lot of terms, like cpu flags, raid types supported. Raid
5417                                                 # can have the last row have a lot of devices, or many raid types
5418                                                 elsif ( ( length( "$key$sep{'s2'} $val2" ) + $indent ) > $size{'max'} &&
5419                                                                    !defined $ids{$key} && $split_count > 2 ) {
5420                                                         @values = split/\s+/, $val2;
5421                                                         $val3 = shift @values;
5422                                                         # $length += length("$key$sep{'s2'} $val3 ") + $indent;
5423                                                         $start2 = "$colors{'c1'}$key$sep{'s2'}$colors{'c2'} $val3 ";
5424                                                         $holder2 = '';
5425                                                         $length += length("$key$sep{'s2'} $val3 ");
5426                                                         # print scalar @values,"\n";
5427                                                         foreach (@values){
5428                                                                 # my $l =  (length("$_ ") + $length);
5429                                                                 #print "$l\n";
5430                                                                 if ( (length("$_ ") + $length) < $size{'max'} ){
5431                                                                         #print "a\n";
5432                                                                         if ($start2){
5433                                                                                 $holder2 .= "$start2$_ ";
5434                                                                                 $start2 = '';
5435                                                                                 #$length += $length2;
5436                                                                                 #$length2 = 0;
5437                                                                         }
5438                                                                         else {
5439                                                                                 $holder2 .= "$_ ";
5440                                                                         }
5441                                                                         $length += length("$_ ");
5442                                                                 }
5443                                                                 else {
5444                                                                         #print "three\n";
5445                                                                         if ($start2){
5446                                                                                 $holder2 = "$start2$holder2";
5447                                                                         }
5448                                                                         else {
5449                                                                                 $holder2 = "$colors{'c2'}$holder2";
5450                                                                         }
5451                                                                         #print "xx:$holder";
5452                                                                         $line = sprintf("%-${indent}s%s$colors{'cn'}\n","$start","$holder$holder2");
5453                                                                         print_line($line);
5454                                                                         $holder = '';
5455
5456                                                                         $holder2 = "$_ ";
5457                                                                         #print "h2: $holder2\n";
5458                                                                         $length = length($holder2) + $indent;
5459                                                                         $start2 = '';
5460                                                                         $start = '';
5461                                                                         #$length2 = 0;
5462                                                                 }
5463                                                         }
5464                                                         if ($holder2 !~ /^\s*$/){
5465                                                                 #print "four\n";
5466                                                                 $holder2 = "$colors{'c2'}$holder2";
5467                                                                 $line = sprintf("%-${indent}s%s$colors{'cn'}\n","$start","$holder$holder2");
5468                                                                 print_line($line);
5469                                                                 $holder = '';
5470                                                                 $holder2 = '';
5471                                                                 $length = $indent;
5472                                                                 $start2 = '';
5473                                                                 $start = '';
5474                                                                 #$length2 = 0;
5475                                                         }
5476                                                 }
5477                                                 else {
5478                                                         #print "H: $counter $hash\n";
5479                                                         if ($holder){
5480                                                                 #print "five\n";
5481                                                                 $line = sprintf("%-${indent}s%s$colors{'cn'}\n",$start,"$holder");
5482                                                                 $holder = "$colors{'c1'}$key$sep{'s2'}$colors{'c2'} $val2";
5483                                                                 $length = length("$key$sep{'s2'} $val2") + $indent;
5484                                                                 print_line($line);
5485                                                                 $start = '';
5486                                                         }
5487                                                         else {
5488                                                                 #print "six\n";
5489                                                                 $holder = "$colors{'c1'}$key$sep{'s2'}$colors{'c2'} $val2";
5490                                                                 #$line = sprintf("%-${indent}s%s$colors{'cn'}\n",$start,"$holder");
5491                                                                 $length = $indent;
5492                                                                 #$holder = '';
5493                                                         }
5494                                                 }
5495                                                 $counter++;
5496                                         }
5497                                         if ($holder !~ /^\s*$/){
5498                                                 #print "seven\n";
5499                                                 $line = sprintf("%-${indent}s%s$colors{'cn'}\n",$start,"$start2$holder");
5500                                                 print_line($line);
5501                                                 $holder = '';
5502                                                 $length = 0;
5503                                                 $start = '';
5504                                         }
5505                                 }
5506                                 # only for repos?
5507                                 elsif (ref($val1) eq 'ARRAY'){
5508                                         #print "eight\n";
5509                                         $array=0;
5510                                         foreach my $item (@$val1){
5511                                                 $array++;
5512                                                 $line = "$colors{'c1'}$array$sep{'s2'} $colors{'c2'}$item$colors{'cn'}";
5513                                                 $line = sprintf("%-${indent}s%s\n","","$line");
5514                                                 print_line($line);
5515                                         }
5516                                 }
5517                                 else {
5518
5519                                 }
5520                         }
5521                 }
5522         }
5523 }
5524
5525 sub print_line {
5526         my ($line) = @_;
5527         if ($b_irc && $client{'test-konvi'}){
5528                 $client{'konvi'} = 3;
5529                 $client{'dobject'} = 'Konversation';
5530         }
5531         if ($client{'konvi'} == 1 && $client{'dcop'} ){
5532                 # konvi doesn't seem to like \n characters, it just prints them literally
5533                 $line =~ s/\n//g;
5534                 #qx('dcop "$client{'dport'}" "$client{'dobject'}" say "$client{'dserver'}" "$client{'dtarget'}" "$line 1");
5535                 system('dcop', $client{'dport'}, $client{'dobject'}, 'say', $client{'dserver'}, $client{'dtarget'}, "$line 1");
5536         }
5537         elsif ($client{'konvi'} == 3 && $client{'qdbus'} ){
5538                 # print $line;
5539                 $line =~ s/\n//g;
5540                 #qx(qdbus org.kde.konversation /irc say "$client{'dserver'}" "$client{'dtarget'}" "$line");
5541                 system('qdbus', 'org.kde.konversation', '/irc', 'say', $client{'dserver'}, $client{'dtarget'}, $line);
5542         }
5543         else {
5544                 print $line;
5545         }
5546 }
5547
5548 ########################################################################
5549 #### DATA PROCESSORS
5550 ########################################################################
5551
5552 #### -------------------------------------------------------------------
5553 #### PRIMARY DATA GENERATORS
5554 #### -------------------------------------------------------------------
5555 # 0 type
5556 # 1 type_id
5557 # 2 bus_id
5558 # 3 sub_id
5559 # 4 device
5560 # 5 vendor_id
5561 # 6 chip_id
5562 # 7 rev
5563 # 8 port
5564 # 9 driver
5565 # 10 modules
5566
5567 ## AudioData
5568 {
5569 package AudioData;
5570
5571 sub get {
5572         eval $start if $b_log;
5573         my (@data,@rows);
5574         my $num = 0;
5575         if (($b_arm || $b_mips) && !$b_soc_audio && !$b_pci_tool){
5576                 my $key = ($b_arm) ? 'ARM' : 'MIPS';
5577                 @data = ({
5578                 main::key($num++,$key) => main::row_defaults(lc($key) . '-pci',''),
5579                 },);
5580                 @rows = (@rows,@data);
5581         }
5582         else {
5583                 @data = card_data();
5584                 @rows = (@rows,@data);
5585         }
5586         if ( ( (($b_arm || $b_mips) && !$b_soc_audio && !$b_pci_tool) || !@rows ) &&
5587            (my $file = main::system_files('asound-cards') ) ){
5588                 @data = asound_data($file);
5589                 @rows = (@rows,@data);
5590         }
5591         @data = usb_data();
5592         @rows = (@rows,@data);
5593         if (!@rows){
5594                 my $key = 'Message';
5595                 @data = ({
5596                 main::key($num++,$key) => main::row_defaults('pci-card-data',''),
5597                 },);
5598                 @rows = (@rows,@data);
5599         }
5600         @data = sound_server_data();
5601         @rows = (@rows,@data);
5602         eval $end if $b_log;
5603         return @rows;
5604 }
5605
5606 sub card_data {
5607         eval $start if $b_log;
5608         my (@rows,@data);
5609         my ($j,$num) = (0,1);
5610         foreach (@pci){
5611                 $num = 1;
5612                 my @row = @$_;
5613                 if ($row[0] =~ /^(audio|daudio|hdmi|multimedia)$/){
5614                         $j = scalar @rows;
5615                         my $driver = $row[9];
5616                         $driver ||= 'N/A';
5617                         my $card = $row[4];
5618                         $card = ($card) ? main::pci_cleaner($card,'output') : 'N/A';
5619                         # have seen absurdly verbose card descriptions, with non related data etc
5620                         if (length($card) > 85 || $size{'max'} < 110){
5621                                 $card = main::pci_long_filter($card);
5622                         }
5623                         @data = ({
5624                         main::key($num++,'Card') => $card,
5625                         },);
5626                         @rows = (@rows,@data);
5627                         if ($extra > 2 && $b_pci_tool && $row[11]){
5628                                 my $item = main::get_pci_vendor($row[4],$row[11]);
5629                                 $rows[$j]{main::key($num++,'vendor')} = $item if $item;
5630                         }
5631                         $rows[$j]{main::key($num++,'driver')} = $driver;
5632                         if ($extra > 0 && !$bsd_type){
5633                                 if ($row[9] ){
5634                                         my $version = main::get_module_version($row[9]);
5635                                         $rows[$j]{main::key($num++,'v')} = $version if $version;
5636                                 }
5637                         }
5638                         if ($extra > 0){
5639                                 $rows[$j]{main::key($num++,'bus ID')} = (!$row[2] && !$row[3]) ? 'N/A' : "$row[2].$row[3]";
5640                         }
5641                         if ($extra > 1){
5642                                 $rows[$j]{main::key($num++,'chip ID')} = ($row[5]) ? "$row[5]:$row[6]" : $row[6];
5643                         }
5644                 }
5645                 #print "$row[0]\n";
5646         }
5647         #my $ref = $pci[-1];
5648         #print $$ref[0],"\n";
5649         eval $end if $b_log;
5650         return @rows;
5651 }
5652 # this handles fringe cases where there is no card on pcibus,
5653 # but there is a card present. I don't know the exact architecture
5654 # involved but I know this situation exists on at least one old machine.
5655 sub asound_data {
5656         eval $start if $b_log;
5657         my ($file) = @_;
5658         my (@asound,@rows,@data);
5659         my ($card,$driver,$j,$num) = ('','',0,1);
5660         @asound = main::reader($file);
5661         foreach (@asound){
5662                 # filtering out modems and usb devices like webcams, this might get a
5663                 # usb audio card as well, this will take some trial and error
5664                 if ( !/modem|usb/i && /^\s*[0-9]/ ) {
5665                         $num = 1;
5666                         my @working = split /:\s*/, $_;
5667                         # now let's get 1 2
5668                         $working[1] =~ /(.*)\s+-\s+(.*)/;
5669                         $card = $2;
5670                         $driver = $1;
5671                         if ( $card ){
5672                                 $j = scalar @rows;
5673                                 $driver ||= 'N/A';
5674                                 @data = ({
5675                                 main::key($num++,'Card') => $card,
5676                                 main::key($num++,'driver') => $driver,
5677                                 },);
5678                                 @rows = (@rows,@data);
5679                                 if ($extra > 0){
5680                                         my $version = main::get_module_version($driver);
5681                                         $rows[$j]{main::key($num++,'v')} = $version if $version;
5682                                         $rows[$j]{main::key($num++,'message')} = main::row_defaults('pci-advanced-data','');
5683                                 }
5684                         }
5685                 }
5686         }
5687         # print Data::Dumper:Dumper \s@rows;
5688         eval $end if $b_log;
5689         return @rows;
5690 }
5691 sub usb_data {
5692         eval $start if $b_log;
5693         my (@rows,@data,@ids,$driver,$product,$product2,@temp2,$vendor,$vendor2);
5694         my ($j,$num) = (0,1);
5695         if (-d '/proc/asound') {
5696                 # note: this will double the data, but it's easier this way.
5697                 # inxi tested for -L in the /proc/asound files, and used only those.
5698                 my @files = main::globber('/proc/asound/*/usbid');
5699                 foreach (@files){
5700                         my $id = (main::reader($_))[0];
5701                         push @ids, $id if ($id && ! grep {/$id/} @ids);
5702                 }
5703                 # lsusb is a very expensive operation
5704                 if (@ids){
5705                         if (!$bsd_type && !$b_usb_check){
5706                                 main::set_usb_data();
5707                                 $b_usb_check = 1;
5708                         }
5709                 }
5710                 main::log_data('dump','@ids',\@ids) if $b_log;
5711                 return if !@usb;
5712                 foreach my $id (@ids){
5713                         $j = scalar @rows;
5714                         foreach my $ref (@usb){
5715                                 my @row = @$ref;
5716                                 # a device will always be the second or > device on the bus
5717                                 if ($row[1] > 1 && $row[2] eq $id){
5718                                         $num = 1;
5719                                         # makre sure to reset, or second device trips last flag
5720                                         ($product,$product2,$vendor,$vendor2) = ('','','','');
5721                                         if ($usb_level == 1){
5722                                                 $product = main::cleaner($row[3]);
5723                                         }
5724                                         else {
5725                                                 foreach my $line (@row){
5726                                                         my @working = split /:/, $line;
5727                                                         if ($working[0] eq 'idVendor' && $working[2]){
5728                                                                 $vendor = main::cleaner($working[2]);
5729                                                         }
5730                                                         if ($working[0] eq 'idProduct' && $working[2]){
5731                                                                 $product = main::cleaner($working[2]);
5732                                                         }
5733                                                         if ($working[0] eq 'iManufacturer' && $working[2]){
5734                                                                 $vendor2 = main::cleaner($working[2]);
5735                                                         }
5736                                                         if ($working[0] eq 'iProduct' && $working[2]){
5737                                                                 $product2 = main::cleaner($working[2]);
5738                                                         }
5739                                                         if ($working[0] eq 'Descriptor_Configuration'){
5740                                                                 last;
5741                                                         }
5742                                                 }
5743                                         }
5744                                         if ($vendor && $product){
5745                                                 $product = ($product =~ /$vendor/) ? $product: "$vendor $product" ;
5746                                         }
5747                                         elsif (!$product) {
5748                                                 if ($vendor && $product2){
5749                                                         $product = ($product2 =~ /$vendor/) ? $product2: "$vendor $product2" ;
5750                                                 }
5751                                                 elsif ($vendor2 && $product2){
5752                                                         $product = ($product2 =~ /$vendor2/) ? $product2: "$vendor2 $product2" ;
5753                                                 }
5754                                                 elsif ($vendor){
5755                                                         $product = $vendor;
5756                                                 }
5757                                                 elsif ($vendor2){
5758                                                         $product = $vendor2;
5759                                                 }
5760                                                 else {
5761                                                         $product = 'N/A';
5762                                                 }
5763                                         }
5764                                         @temp2 = main::get_usb_drivers($row[0],$row[2]) if !$bsd_type && -d "/sys/devices";
5765                                         if (@temp2 && $temp2[0]){
5766                                                 $driver = $temp2[0];
5767                                         }
5768                                         $driver ||= 'snd-usb-audio';
5769                                         @data = ({
5770                                         main::key($num++,'Card') => $product,
5771                                         main::key($num++,'type') => 'USB',
5772                                         main::key($num++,'driver') => $driver,
5773                                         },);
5774                                         @rows = (@rows,@data);
5775                                         if ($extra > 0){
5776                                                 $rows[$j]{main::key($num++,'bus ID')} = "$row[0]:$row[1]";
5777                                         }
5778                                         if ($extra > 1){
5779                                                 $rows[$j]{main::key($num++,'chip ID')} = $row[2];
5780                                         }
5781                                 }
5782                         }
5783                 }
5784         }
5785         eval $end if $b_log;
5786         return @rows;
5787 }
5788
5789 sub sound_server_data {
5790         eval $start if $b_log;
5791         my (@data,$server,$version);
5792         my $num = 0;
5793         if (my $file = main::system_files('asound-version') ){
5794                 my $content = (main::reader($file))[0];
5795                 # some alsa strings have the build date in (...)
5796                 # remove trailing . and remove possible second line if compiled by user
5797 #               foreach (@content){
5798 #                       if (!/compile/i){
5799                                 #$_ =~ s/Advanced Linux Sound Architecture/ALSA/;
5800                                 $version = (split /\s+/, $content)[-1];
5801                                 $version =~ s/\.$//; # trim off period
5802                                 $server = 'ALSA';
5803 #                       }
5804 #               }
5805         }
5806         elsif (my $program = main::check_program('oss')){
5807                 $server = 'OSS';
5808                 $version = main::program_version('oss','\S',2);
5809                 $version ||= 'N/A';
5810         }
5811         if ($server){
5812                 @data = ({
5813                 main::key($num++,'Sound Server') => $server,
5814                 main::key($num++,'v') => $version,
5815                 },);
5816         }
5817         eval $end if $b_log;
5818         return @data;
5819 }
5820 }
5821
5822 ## BatteryData
5823 {
5824 package BatteryData;
5825 my (@upower_items,$b_upower,$upower);
5826 sub get {
5827         eval $start if $b_log;
5828         my (@rows,%battery,$key1,$val1);
5829         my $num = 0;
5830         if ($bsd_type || $b_dmidecode_force){
5831                 my $ref = $alerts{'dmidecode'};
5832                 if ( $$ref{'action'} ne 'use'){
5833                         $key1 = $$ref{'action'};
5834                         $val1 = $$ref{$key1};
5835                         $key1 = ucfirst($key1);
5836                         @rows = ({main::key($num++,$key1) => $val1,});
5837                 }
5838                 else {
5839                         %battery = battery_data_dmi();
5840                         if (!%battery){
5841                                 if ($show{'battery-forced'}){
5842                                         $key1 = 'Message';
5843                                         $val1 = main::row_defaults('battery-data','');
5844                                         @rows = ({main::key($num++,$key1) => $val1,});
5845                                 }
5846                         }
5847                         else {
5848                                 @rows = create_output(%battery);
5849                         }
5850                 }
5851         }
5852         elsif (-d '/sys/class/power_supply/'){
5853                 %battery = battery_data_sys();
5854                 if (!%battery){
5855                         if ($show{'battery-forced'}){
5856                                 $key1 = 'Message';
5857                                 $val1 = main::row_defaults('battery-data','');
5858                                 @rows = ({main::key($num++,$key1) => $val1,});
5859                         }
5860                 }
5861                 else {
5862                         @rows = create_output(%battery);
5863                 }
5864         }
5865         else {
5866                 if ($show{'battery-forced'}){
5867                         $key1 = 'Message';
5868                         $val1 = main::row_defaults('battery-data-sys','');
5869                         @rows = ({main::key($num++,$key1) => $val1,});
5870                 }
5871         }
5872         (@upower_items,$b_upower,$upower) = undef;
5873         eval $end if $b_log;
5874         return @rows;
5875 }
5876 # alarm capacity capacity_level charge_full charge_full_design charge_now
5877 #       cycle_count energy_full energy_full_design energy_now location manufacturer model_name
5878 #       power_now present serial_number status technology type voltage_min_design voltage_now
5879 # 0  name - battery id, not used
5880 # 1  status
5881 # 2  present
5882 # 3  technology
5883 # 4  cycle_count
5884 # 5  voltage_min_design
5885 # 6  voltage_now
5886 # 7  power_now
5887 # 8  energy_full_design
5888 # 9  energy_full
5889 # 10 energy_now
5890 # 11 capacity
5891 # 12 capacity_level
5892 # 13 of_orig
5893 # 14 model_name
5894 # 15 manufacturer
5895 # 16 serial_number
5896 # 17 location
5897 sub create_output {
5898         eval $start if $b_log;
5899         my (%battery) = @_;
5900         my ($key,@data,@rows);
5901         my $num = 0;
5902         my $j = 0;
5903         # print Data::Dumper::Dumper \%battery;
5904         foreach $key (sort keys %battery){
5905                 $num = 0;
5906                 my ($charge,$condition,$model,$serial,$status,$volts) = ('','','','','','');
5907                 my ($chemistry,$cycles,$location) = ('','','');
5908                 next if !$battery{$key}{'purpose'} || $battery{$key}{'purpose'} ne 'primary';
5909                 # $battery{$key}{''};
5910                 # we need to handle cases where charge or energy full is 0
5911                 $charge = (defined $battery{$key}{'energy_now'} && $battery{$key}{'energy_now'} ne '') ? "$battery{$key}{'energy_now'} Wh" : 'N/A';
5912                 if ($battery{$key}{'energy_full'} || $battery{$key}{'energy_full_design'}){
5913                         $battery{$key}{'energy_full_design'} ||= 'N/A';
5914                         $battery{$key}{'energy_full'}= (defined $battery{$key}{'energy_full'} && $battery{$key}{'energy_full'} ne '') ? $battery{$key}{'energy_full'} : 'N/A';
5915                         $condition = "$battery{$key}{'energy_full'}/$battery{$key}{'energy_full_design'} Wh";
5916                         if ($battery{$key}{'of_orig'}){
5917                                 $condition .= " ($battery{$key}{'of_orig'}%)";
5918                         }
5919                 }
5920                 $condition ||= 'N/A';
5921                 $j = scalar @rows;
5922                 @data = ({
5923                 main::key($num++,'ID') => $key,
5924                 main::key($num++,'charge') => $charge,
5925                 main::key($num++,'condition') => $condition,
5926                 },);
5927                 @rows = (@rows,@data);
5928                 if ($extra > 0){
5929                         if ($extra > 1){
5930                                 if ($battery{$key}{'voltage_min_design'} || $battery{$key}{'voltage_now'}){
5931                                         $battery{$key}{'voltage_min_design'} ||= 'N/A';
5932                                         $battery{$key}{'voltage_now'} ||= 'N/A';
5933                                         $volts = "$battery{$key}{'voltage_now'}/$battery{$key}{'voltage_min_design'}";
5934                                 }
5935                                 $volts ||= 'N/A';
5936                                 $rows[$j]{main::key($num++,'volts')} = $volts;
5937                         }
5938                         if ($battery{$key}{'manufacturer'} || $battery{$key}{'model_name'}) {
5939                                 if ($battery{$key}{'manufacturer'} && $battery{$key}{'model_name'}){
5940                                         $model = "$battery{$key}{'manufacturer'} $battery{$key}{'model_name'}";
5941                                 }
5942                                 elsif ($battery{$key}{'manufacturer'}){
5943                                         $model = $battery{$key}{'manufacturer'};
5944                                 }
5945                                 elsif ($battery{$key}{'model_name'}){
5946                                         $model = $battery{$key}{'model_name'};
5947                                 }
5948                         }
5949                         else {
5950                                 $model = 'N/A';
5951                         }
5952                         $rows[$j]{main::key($num++,'model')} = $model;
5953                         if ($extra > 2){
5954                                 $chemistry = ( $battery{$key}{'technology'} ) ? $battery{$key}{'technology'}: 'N/A';
5955                                 $rows[$j]{main::key($num++,'type')} = $chemistry;
5956                         }
5957                         if ($extra > 1){
5958                                 $serial = main::apply_filter($battery{$key}{'serial_number'});
5959                                 $rows[$j]{main::key($num++,'serial')} = $serial;
5960                         }
5961                         $status = ($battery{$key}{'status'}) ? $battery{$key}{'status'}: 'N/A';
5962                         $rows[$j]{main::key($num++,'status')} = $status;
5963                         if ($extra > 2){
5964                                 if ($battery{$key}{'cycle_count'}){
5965                                         $rows[$j]{main::key($num++,'cycles')} = $battery{$key}{'cycle_count'};
5966                                 }
5967                                 if ($battery{$key}{'location'}){
5968                                         $rows[$j]{main::key($num++,'location')} = $battery{$key}{'location'};
5969                                 }
5970                         }
5971                 }
5972                 $battery{$key} = undef;
5973         }
5974         # print Data::Dumper::Dumper \%battery;
5975         # now if there are any devices left, print them out, excluding Mains
5976         if ($extra > 0){
5977                 $upower = main::check_program('upower');
5978                 foreach $key (sort keys %battery){
5979                         $num = 0;
5980                         next if !defined $battery{$key} || $battery{$key}{'purpose'} eq 'mains';
5981                         my ($charge,$model,$serial,$percent,$status,$vendor) = ('','','','','','');
5982                         my (%upower_data);
5983                         $j = scalar @rows;
5984                         %upower_data = upower_data($key) if $upower;
5985                         if ($upower_data{'percent'}){
5986                                 $charge = $upower_data{'percent'};
5987                         }
5988                         elsif ($battery{$key}{'capacity_level'} && lc($battery{$key}{'capacity_level'}) ne 'unknown'){
5989                                 $charge = $battery{$key}{'capacity_level'};
5990                         }
5991                         else {
5992                                 $charge = 'N/A';
5993                         }
5994                         $model = $battery{$key}{'model_name'} if $battery{$key}{'model_name'};
5995                         $status = ($battery{$key}{'status'} && lc($battery{$key}{'status'}) ne 'unknown') ? $battery{$key}{'status'}: 'N/A' ;
5996                         $vendor = $battery{$key}{'manufacturer'} if $battery{$key}{'manufacturer'};
5997                         if ($vendor || $model){
5998                                 if ($vendor && $model){
5999                                         $model = "$vendor $model";
6000                                 }
6001                                 elsif ($vendor){
6002                                         $model = $vendor;
6003                                 }
6004                         }
6005                         else {
6006                                 $model = 'N/A';
6007                         }
6008                         @data = ({
6009                         main::key($num++,'Device') => $key,
6010                         main::key($num++,'model') => $model,
6011                         },);
6012                         @rows = (@rows,@data);
6013                         if ($extra > 1){
6014                                 $serial = main::apply_filter($battery{$key}{'serial_number'});
6015                                 $rows[$j]{main::key($num++,'serial')} = $serial;
6016                         }
6017                         $rows[$j]{main::key($num++,'charge')} = $charge;
6018                         if ($extra > 2 && $upower_data{'rechargeable'}){
6019                                 $rows[$j]{main::key($num++,'rechargeable')} = $upower_data{'rechargeable'};
6020                         }
6021                         $rows[$j]{main::key($num++,'status')} = $status;
6022                 }
6023         }
6024         eval $end if $b_log;
6025         return @rows;
6026 }
6027
6028 # charge: mAh energy: Wh
6029 sub battery_data_sys {
6030         eval $start if $b_log;
6031         my ($b_ma,%battery,$file,$id,$item,$path,$value);
6032         my $num = 0;
6033         my @batteries = main::globber("/sys/class/power_supply/*");
6034         # note: there is no 'location' file, but dmidecode has it
6035         # 'type' is generic, like: Battery, Mains
6036         # capacity_level is a string, like: Normal
6037         my @items = qw(alarm capacity capacity_level charge_full charge_full_design charge_now
6038         cycle_count energy_full energy_full_design energy_now location manufacturer model_name
6039         power_now present serial_number status technology type voltage_min_design voltage_now);
6040         foreach $item (@batteries){
6041                 $b_ma = 0;
6042                 $id = $item;
6043                 $id =~ s%/sys/class/power_supply/%%g;
6044                 my $purpose = ($id =~ /^(BAT|CMB).*$/) ? 'primary': 'device';
6045                 # don't create arrays of device data if it's not going to show
6046                 next if $extra == 0 && $purpose ne 'primary';
6047                 $battery{$id} = ({});
6048                 # NOTE: known ids: BAT[0-9] CMB[0-9]
6049                 $battery{$id}{'purpose'} = $purpose;
6050                 foreach $file (@items){
6051                         $path = "$item/$file";
6052                         $value = (-f $path) ? (main::reader($path))[0]: '';
6053                         # mains
6054                         if ($file eq 'type' && $value && lc($value) ne 'battery' ){
6055                                 $battery{$id}{'purpose'} = 'mains';
6056                         }
6057                         if ($value){
6058                                 if ($file eq 'voltage_min_design'){
6059                                         $value = sprintf("%.1f", $value/1000000);
6060                                 }
6061                                 elsif ($file eq 'voltage_now'){
6062                                         $value = sprintf("%.1f", $value/1000000);
6063                                 }
6064                                 elsif ($file eq 'energy_full_design'){
6065                                         $value = $value/1000000;
6066                                 }
6067                                 elsif ($file eq 'energy_full'){
6068                                         $value = $value/1000000;
6069                                 }
6070                                 elsif ($file eq 'energy_now'){
6071                                         $value = sprintf("%.1f", $value/1000000);
6072                                 }
6073                                 # note: the following 3 were off, 100000 instead of 1000000
6074                                 # why this is, I do not know. I did not document any reason for that
6075                                 # so going on assumption it is a mistake. CHARGE is mAh, which are converted
6076                                 # to Wh by: mAh x voltage. Note: voltage fluctuates so will make results vary slightly.
6077                                 elsif ($file eq 'charge_full_design'){
6078                                         $value = $value/1000000;
6079                                         $b_ma = 1;
6080                                 }
6081                                 elsif ($file eq 'charge_full'){
6082                                         $value = $value/1000000;
6083                                         $b_ma = 1;
6084                                 }
6085                                 elsif ($file eq 'charge_now'){
6086                                         $value = $value/1000000;
6087                                         $b_ma = 1;
6088                                 }
6089                                 elsif ($file eq 'manufacturer'){
6090                                         $value = main::dmi_cleaner($value);
6091                                 }
6092                                 elsif ($file eq 'model_name'){
6093                                         $value = main::dmi_cleaner($value);
6094                                 }
6095                         }
6096                         elsif ($b_root && -e $path && ! -r $path ){
6097                                 $value = main::row_defaults('root-required');
6098                         }
6099                         $battery{$id}{$file} = $value;
6100                         # print "$battery{$id}{$file}\n";
6101                 }
6102                 # note:voltage_now fluctuates, which will make capacity numbers change a bit
6103                 # if any of these values failed, the math will be wrong, but no way to fix that
6104                 # tests show more systems give right capacity/charge with voltage_min_design
6105                 # than with voltage_now
6106                 if ($b_ma && $battery{$id}{'voltage_min_design'}){
6107                         if ($battery{$id}{'charge_now'}){
6108                                 $battery{$id}{'energy_now'} = $battery{$id}{'charge_now'} * $battery{$id}{'voltage_min_design'};
6109                         }
6110                         if ($battery{$id}{'charge_full'}){
6111                                 $battery{$id}{'energy_full'} = $battery{$id}{'charge_full'}*$battery{$id}{'voltage_min_design'};
6112                         }
6113                         if ($battery{$id}{'charge_full_design'}){
6114                                 $battery{$id}{'energy_full_design'} = $battery{$id}{'charge_full_design'} * $battery{$id}{'voltage_min_design'};
6115                         }
6116                 }
6117                 if ( $battery{$id}{'energy_now'} && $battery{$id}{'energy_full'} ){
6118                         $battery{$id}{'capacity'} = 100 * $battery{$id}{'energy_now'}/$battery{$id}{'energy_full'};
6119                         $battery{$id}{'capacity'} = sprintf( "%.1f", $battery{$id}{'capacity'} );
6120                 }
6121                 if ( $battery{$id}{'energy_full_design'} && $battery{$id}{'energy_full'} ){
6122                         $battery{$id}{'of_orig'} = 100 * $battery{$id}{'energy_full'}/$battery{$id}{'energy_full_design'};
6123                         $battery{$id}{'of_orig'} = sprintf( "%.0f", $battery{$id}{'of_orig'} );
6124                 }
6125                 if ( $battery{$id}{'energy_now'} ){
6126                         $battery{$id}{'energy_now'} = sprintf( "%.1f", $battery{$id}{'energy_now'} );
6127                 }
6128                 if ( $battery{$id}{'energy_full_design'} ){
6129                         $battery{$id}{'energy_full_design'} = sprintf( "%.1f",$battery{$id}{'energy_full_design'} );
6130                 }
6131                 if ( $battery{$id}{'energy_full'} ){
6132                         $battery{$id}{'energy_full'} = sprintf( "%.1f", $battery{$id}{'energy_full'} );
6133                 }
6134         }
6135         eval $end if $b_log;
6136         return %battery;
6137 }
6138 # note, dmidecode does not have charge_now or charge_full
6139 sub battery_data_dmi {
6140         eval $start if $b_log;
6141         my (%battery,$id);
6142         my $i = 0;
6143         foreach (@dmi){
6144                 my @ref = @$_;
6145                 # Portable Battery
6146                 if ($ref[0] == 22){
6147                         $id = "BAT$i";
6148                         $i++;
6149                         $battery{$id} = ({});
6150                         $battery{$id}{'purpose'} = 'primary';
6151                         # skip first three row, we don't need that data
6152                         splice @ref, 0, 3 if @ref;
6153                         foreach my $item (@ref){
6154                                 my @value = split /:\s+/, $item;
6155                                 next if !$value[0];
6156                                 if ($value[0] eq 'Location') {$battery{$id}{'location'} = $value[1] }
6157                                 elsif ($value[0] eq 'Manufacturer') {$battery{$id}{'manufacturer'} = main::dmi_cleaner($value[1]) }
6158                                 elsif ($value[0] =~ /Chemistry/) {$battery{$id}{'technology'} = $value[1] }
6159                                 elsif ($value[0] =~ /Serial Number/) {$battery{$id}{'serial_number'} = $value[1] }
6160                                 elsif ($value[0] =~ /^Name/) {$battery{$id}{'model_name'} = main::dmi_cleaner($value[1]) }
6161                                 elsif ($value[0] eq 'Design Capacity') {
6162                                         $value[1] =~ s/\s*mwh$//i;
6163                                         $battery{$id}{'energy_full_design'} = sprintf( "%.1f", $value[1]/1000);
6164                                 }
6165                                 elsif ($value[0] eq 'Design Voltage') {
6166                                         $value[1] =~ s/\s*mv$//i;
6167                                         $battery{$id}{'voltage_min_design'} = sprintf( "%.1f", $value[1]/1000);
6168                                 }
6169                         }
6170                         if ($battery{$id}{'energy_now'} && $battery{$id}{'energy_full'} ){
6171                                 $battery{$id}{'capacity'} = 100 * $battery{$id}{'energy_now'} / $battery{$id}{'energy_full'};
6172                                 $battery{$id}{'capacity'} = sprintf( "%.1f%", $battery{$id}{'capacity'} );
6173                         }
6174                         if ($battery{$id}{'energy_full_design'} && $battery{$id}{'energy_full'} ){
6175                                 $battery{$id}{'of_orig'} = 100 * $battery{$id}{'energy_full'} / $battery{$id}{'energy_full_design'};
6176                                 $battery{$id}{'of_orig'} = sprintf( "%.0f%", $battery{$id}{'of_orig'} );
6177                         }
6178                 }
6179                 elsif ($ref[0] > 22){
6180                         last;
6181                 }
6182         }
6183         # print Data::Dumper::Dumper \%battery;
6184         eval $end if $b_log;
6185         return %battery;
6186 }
6187 sub upower_data {
6188         my ($id) = @_;
6189         eval $start if $b_log;
6190         my (%data);
6191         if (!$b_upower && $upower){
6192                 @upower_items = main::grabber("$upower -e",'','strip');
6193                 $b_upower = 1;
6194         }
6195         if ($upower && @upower_items){
6196                 foreach (@upower_items){
6197                         if ($_ =~ /$id/){
6198                                 my @working = main::grabber("$upower -i $_",'','strip');
6199                                 foreach my $row (@working){
6200                                         my @temp = split /\s*:\s*/, $row;
6201                                         if ($temp[0] eq 'percentage'){
6202                                                 $data{'percent'} = $temp[1];
6203                                         }
6204                                         elsif ($temp[0] eq 'rechargeable'){
6205                                                 $data{'rechargeable'} = $temp[1];
6206                                         }
6207                                 }
6208                                 last;
6209                         }
6210                 }
6211         }
6212         eval $end if $b_log;
6213         return %data;
6214 }
6215
6216 }
6217
6218 ## CpuData
6219 {
6220 package CpuData;
6221
6222 sub get {
6223         eval $start if $b_log;
6224         my ($type) = @_;
6225         my (@data,@rows,$single,$key1,$val1);
6226         my $num = 0;
6227         if ($type eq 'short' || $type eq 'basic'){
6228                 @rows = data_short($type);
6229         }
6230         else {
6231                 @rows = create_output_full();
6232         }
6233         eval $end if $b_log;
6234         return @rows;
6235 }
6236 sub create_output_full {
6237         eval $start if $b_log;
6238         my $num = 0;
6239         my ($b_flags,$b_speeds,$core_speeds_value,$flag_key,@flags,%cpu,@data,@rows);
6240         my $sleep = $cpu_sleep * 1000000;
6241         if ($b_hires){
6242                 eval 'Time::HiRes::usleep( $sleep )';
6243         }
6244         else {
6245                 select(undef, undef, undef, $cpu_sleep);
6246         }
6247         if (my $file = main::system_files('cpuinfo')){
6248                 %cpu = data_cpuinfo($file,'full');
6249         }
6250         elsif ($bsd_type ){
6251                 my ($key1,$val1) = ('','');
6252                 if ( $alerts{'sysctl'} ){
6253                         if ( $alerts{'sysctl'}{'action'} eq 'use' ){
6254 #                               $key1 = 'Status';
6255 #                               $val1 = main::row_defaults('dev');
6256                                 %cpu = data_sysctl('full');
6257                         }
6258                         else {
6259                                 $key1 = ucfirst($alerts{'sysctl'}{'action'});
6260                                 $val1 = $alerts{'sysctl'}{$alerts{'sysctl'}{'action'}};
6261                                 @data = ({main::key($num++,$key1) => $val1,});
6262                                 return @data;
6263                         }
6264                 }
6265         }
6266         my %properties = cpu_properties(%cpu);
6267         my $type = ($properties{'cpu-type'}) ? $properties{'cpu-type'}: '';
6268         my $ref = $cpu{'processors'};
6269         my @processors = @$ref;
6270         my @speeds = cpu_speeds(@processors);
6271         my $j = scalar @rows;
6272         $cpu{'model_name'} ||= 'N/A';
6273         @data = ({
6274         main::key($num++,'Topology') => $properties{'cpu-layout'},
6275         main::key($num++,'model') => $cpu{'model_name'},
6276         },);
6277         @rows = (@rows,@data);
6278         if ($cpu{'arm-cpus'}){
6279                 my $ref = $cpu{'arm-cpus'};
6280                 my %arm_cpus = %$ref;
6281                 my $i = 1;
6282                 my $counter = ( %arm_cpus && scalar keys %arm_cpus > 1 ) ? '-' : '';
6283                 foreach my $key (keys %arm_cpus){
6284                         $counter = '-' . $i++ if $counter;
6285                         $rows[$j]{main::key($num++,'variant'.$counter)} = $key;
6286                 }
6287         }
6288         $properties{'bits-sys'} ||= 'N/A';
6289         $rows[$j]{main::key($num++,'bits')} = $properties{'bits-sys'};
6290         if ($type){
6291                 $rows[$j]{main::key($num++,'type')} = $type;
6292         }
6293         if ($extra > 0){
6294                 $cpu{'arch'} ||= 'N/A';
6295                 $rows[$j]{main::key($num++,'arch')} = $cpu{'arch'};
6296                 if ( !$b_admin && $cpu{'arch'} ne 'N/A' && $cpu{'rev'} ){
6297                         $rows[$j]{main::key($num++,'rev')} = $cpu{'rev'};
6298                 }
6299         }
6300         if ($b_admin){
6301                 $rows[$j]{main::key($num++,'family')} = hex_and_decimal($cpu{'family'});
6302                 $rows[$j]{main::key($num++,'model-id')} = hex_and_decimal($cpu{'model_id'});
6303                 $rows[$j]{main::key($num++,'stepping')} = hex_and_decimal($cpu{'rev'});
6304                 $cpu{'microcode'} ||= 'N/A';
6305                 $rows[$j]{main::key($num++,'microcode')} = $cpu{'microcode'};
6306         }
6307         $properties{'l2-cache'} ||= 'N/A';
6308         if (!$b_arm || ($b_arm && $properties{'l2-cache'} ne 'N/A')){
6309                 $rows[$j]{main::key($num++,'L2 cache')} = $properties{'l2-cache'};
6310         }
6311         if ($extra > 0 && !$show{'cpu-flag'}){
6312                 $j = scalar @rows;
6313                 @flags = split /\s+/, $cpu{'flags'} if $cpu{'flags'};
6314                 $flag_key = ($b_arm || $bsd_type) ? 'features': 'flags';
6315                 my $flag = 'N/A';
6316                 if (@flags){
6317                         # failure to read dmesg.boot: dmesg.boot permissions
6318                         @flags = grep {/^(dmesg.boot|lm|nx|pae|permissions|pni|svm|vmx|(sss|ss)e([2-9])?([a-z])?(_[0-9])?)$/} @flags;
6319                         @flags = map {s/pni/sse3/; $_} @flags;
6320                         @flags = sort(@flags);
6321                         $flag = join ' ', @flags if @flags;
6322                 }
6323                 if ($b_arm && $flag eq 'N/A'){
6324                         $flag = main::row_defaults('arm-cpu-f');
6325                 }
6326                 @data = ({
6327                 main::key($num++,$flag_key) => $flag,
6328                 },);
6329                 @rows = (@rows,@data);
6330                 $b_flags = 1;
6331         }
6332         if ($extra > 0 && !$bsd_type){
6333                 my $bogomips = ($cpu{'bogomips'}) ? int($cpu{'bogomips'}) : 'N/A';
6334                 $rows[$j]{main::key($num++,'bogomips')} = $bogomips;
6335         }
6336         $j = scalar @rows;
6337         my $core_key = (scalar @speeds > 1) ? 'Core speeds (MHz)' : 'Core speed (MHz)';
6338         my $speed_key = ($properties{'speed-key'}) ? $properties{'speed-key'}: 'Speed';
6339         my $min_max = ($properties{'min-max'}) ? $properties{'min-max'}: 'N/A';
6340         my $min_max_key = ($properties{'min-max-key'}) ? $properties{'min-max-key'}: 'min/max';
6341         my $speed = (defined $properties{'speed'}) ? $properties{'speed'}: 'N/A';
6342         # aren't able to get per core speeds in bsds yet
6343         if (@speeds){
6344                 if (grep {$_ ne '0'} @speeds){
6345                         $core_speeds_value = '';
6346                         $b_speeds = 1;
6347                 }
6348                 else {
6349                         $core_speeds_value = main::row_defaults('cpu-speeds',scalar @speeds);
6350                 }
6351         }
6352         else {
6353                 $core_speeds_value = 'N/A';
6354         }
6355         $j = scalar @rows;
6356         @data = ({
6357         main::key($num++,$speed_key) => $speed,
6358         main::key($num++,$min_max_key) => $min_max,
6359         });
6360         @rows = (@rows,@data);
6361         if ($extra > 2){
6362                 my $boost = get_boost_status();
6363                 $rows[$j]{main::key($num++,'boost')} = $boost if $boost;
6364         }
6365         $rows[$j]{main::key($num++,$core_key)} = $core_speeds_value;
6366         my $i = 1;
6367         # if say 96 0 speed cores, no need to print all those 0s
6368         if ($b_speeds){
6369                 foreach (@speeds){
6370                         $rows[$j]{main::key($num++,$i++)} = $_;
6371                 }
6372         }
6373         if ($show{'cpu-flag'} && !$b_flags){
6374                 $flag_key = ($b_arm || $bsd_type) ? 'Features': 'Flags';
6375                 @flags = split /\s+/, $cpu{'flags'} if $cpu{'flags'};
6376                 my $flag = 'N/A';
6377                 if (@flags){
6378                         @flags = sort(@flags);
6379                         $flag = join ' ', @flags if @flags;
6380                 }
6381                 @data = ({
6382                 main::key($num++,$flag_key) => $flag,
6383                 },);
6384                 @rows = (@rows,@data);
6385         }
6386         if ($b_admin && $cpu{'bugs'}){
6387                 my @bugs = split /\s+/, $cpu{'bugs'};
6388                 @bugs = sort(@bugs);
6389                 my $bug = join ' ', @bugs;
6390                 @data = ({
6391                 main::key($num++,'Errata') => $bug,
6392                 },);
6393                 @rows = (@rows,@data);
6394         }
6395         eval $end if $b_log;
6396         return @rows;
6397 }
6398 sub create_output_short {
6399         eval $start if $b_log;
6400         my (@cpu) = @_;
6401         my @data;
6402         my $num = 0;
6403         $cpu[1] ||= main::row_defaults('cpu-model-null');
6404         $cpu[2] ||= 'N/A';
6405         @data = ({
6406         main::key($num++,$cpu[0]) => $cpu[1],
6407         main::key($num++,'type') => $cpu[2],
6408         },);
6409         if ($extra > 0){
6410                 $data[0]{main::key($num++,'arch')} = $cpu[7];
6411         }
6412         $data[0]{main::key($num++,$cpu[3])} = $cpu[4];
6413         if ($cpu[6]){
6414                 $data[0]{main::key($num++,$cpu[5])} = $cpu[6];
6415         }
6416         eval $end if $b_log;
6417         return @data;
6418 }
6419 sub data_short {
6420         eval $start if $b_log;
6421         my ($type) = @_;
6422         my $num = 0;
6423         my (%cpu,@data,%speeds);
6424         my $sys = '/sys/devices/system/cpu/cpufreq/policy0';
6425         my $sleep = $cpu_sleep * 1000000;
6426         if ($b_hires){
6427                 eval 'Time::HiRes::usleep( $sleep )';
6428         }
6429         else {
6430                 select(undef, undef, undef, $cpu_sleep);
6431         }
6432         # NOTE: : Permission denied, ie, this is not always readable
6433         # /sys/devices/system/cpu/cpu0/cpufreq/cpuinfo_cur_freq
6434         if (my $file = main::system_files('cpuinfo')){
6435                 %cpu = data_cpuinfo($file,$type);
6436         }
6437         elsif ($bsd_type ){
6438                 my ($key1,$val1) = ('','');
6439                 if ( $alerts{'sysctl'} ){
6440                         if ( $alerts{'sysctl'}{'action'} eq 'use' ){
6441 #                               $key1 = 'Status';
6442 #                               $val1 = main::row_defaults('dev');
6443                                 %cpu = data_sysctl($type);
6444                         }
6445                         else {
6446                                 $key1 = ucfirst($alerts{'sysctl'}{'action'});
6447                                 $val1 = $alerts{'sysctl'}{$alerts{'sysctl'}{'action'}};
6448                                 @data = ({main::key($num++,$key1) => $val1,});
6449                                 return @data;
6450                         }
6451                 }
6452         }
6453         # $cpu{'cur-freq'} = $cpu[0]{'core-id'}[0]{'speed'};
6454         if ($type eq 'short' || $type eq 'basic'){
6455                 @data = prep_short_data(%cpu);
6456         }
6457         if ($type eq 'basic'){
6458                 @data = create_output_short(@data);
6459         }
6460         eval $end if $b_log;
6461         return @data;
6462 }
6463
6464 sub prep_short_data {
6465         eval $start if $b_log;
6466         my (%cpu) = @_;
6467         my %properties = cpu_properties(%cpu);
6468         my ($cpu,$speed_key,$speed,$type) = ('','speed',0,'');
6469         $cpu = $cpu{'model_name'} if $cpu{'model_name'};
6470         $type = $properties{'cpu-type'} if $properties{'cpu-type'};
6471         $speed_key = $properties{'speed-key'} if $properties{'speed-key'};
6472         $speed = $properties{'speed'} if $properties{'speed'};
6473         my @result = (
6474         $properties{'cpu-layout'},
6475         $cpu,
6476         $type,
6477         $speed_key,
6478         $speed,
6479         $properties{'min-max-key'},
6480         $properties{'min-max'},
6481         );
6482         if ($extra > 0){
6483                 $cpu{'arch'} ||= 'N/A';
6484                 $result[7] = $cpu{'arch'};
6485         }
6486         eval $end if $b_log;
6487         return @result;
6488 }
6489
6490 sub data_cpuinfo {
6491         eval $start if $b_log;
6492         my ($file,$type)=  @_;
6493         my ($arch,@ids,@line,$b_first,$b_proc_int,$starter);
6494         # use --arm flag when testing arm cpus
6495         # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/arm/arm-4-core-pinebook-1.txt";
6496         # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/arm/armv6-single-core-1.txt";
6497         # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/arm/armv7-dual-core-1.txt";
6498         # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/arm/armv7-new-format-model-name-single-core.txt";
6499         # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/arm/arm-2-die-96-core-rk01.txt";
6500         # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/amd/16-core-32-mt-ryzen.txt";
6501         # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/amd/2-16-core-epyc-abucodonosor.txt";
6502         # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/amd/2-core-probook-antix.txt";
6503         # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/amd/4-core-jean-antix.txt";
6504         # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/amd/4-core-althlon-mjro.txt";
6505         # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/amd/4-core-apu-vc-box.txt";
6506         # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/amd/4-core-a10-5800k-1.txt";
6507         # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/intel/2-core-ht-atom-bruh.txt";
6508         # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/intel/core-2-i3.txt";
6509         # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/intel/8-core-i7-damentz64.txt";
6510         # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/intel/2-10-core-xeon-ht.txt";
6511         # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/intel/4-core-xeon-fake-dual-die-zyanya.txt";
6512         # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/intel/2-core-i5-fake-dual-die-hek.txt";
6513         # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/intel/2-1-core-xeon-vm-vs2017.txt";
6514         # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/intel/4-1-core-xeon-vps-frodo1.txt";
6515         # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/intel/4-6-core-xeon-no-mt-lathander.txt";
6516         #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/mips/mips-mainusg-cpuinfo.txt";
6517         my %speeds = set_cpu_speeds_sys();
6518         my @cpuinfo = main::reader($file);
6519         my @phys_cpus = (0);# start with 1 always
6520         my ($cache,$core_count,$die_holder,$die_id,$phys_id,$proc_count,$speed) = (0,0,0,0,0,0,0);
6521         my ($phys_holder) = (undef);
6522         # need to prime for arm cpus, which do not have physical/core ids usually
6523         # level 0 is phys id, level 1 is die id, level 2 is core id
6524         #$ids[0] = ([(0)]);
6525         $ids[0] = ([]);
6526         $ids[0][0] = ([]);
6527         my %cpu =  set_cpu_data();
6528         # note, there con be a lot of processors, 32 core HT would have 64, for example.
6529         foreach (@cpuinfo){
6530                 next if /^\s*$/;
6531                 @line = split /\s*:\s*/, $_;
6532                 next if !$line[0];
6533                 $starter = $line[0]; # preserve case for one specific ARM issue
6534                 $line[0] = lc($line[0]);
6535                 if ($b_arm && !$b_first && $starter eq 'Processor' && $line[1] !~ /^\d+$/){
6536                         #print "l1:$line[1]\n";
6537                         $cpu{'model_name'} = main::cleaner($line[1]);
6538                         $cpu{'model_name'} = cpu_cleaner($cpu{'model_name'});
6539                         $cpu{'type'} = 'arm';
6540                         # Processor   : AArch64 Processor rev 4 (aarch64)
6541                         # Processor : Feroceon 88FR131 rev 1 (v5l)
6542                         if ($cpu{'model_name'} && $cpu{'model_name'} =~ /(.*)\srev\s([\S]+)\s(\(([\S]+)\))?/){
6543                                 $cpu{'model_name'} = $1;
6544                                 $cpu{'rev'} = $2;
6545                                 if ($4){
6546                                         $cpu{'arch'} = $4;
6547                                         $cpu{'model_name'} .= ' ' . $cpu{'arch'} if $cpu{'model_name'} !~ /$cpu{'arch'}/i;
6548                                 }
6549                                 $cpu{'processors'}[$proc_count] = 0;
6550                                 $b_proc_int = 0;
6551                                 $b_first = 1;
6552                                 #print "p0:\n";
6553                         }
6554                 }
6555                 elsif ($line[0] eq 'processor'){
6556                         # this protects against double processor lines, one int, one string
6557                         if ($line[1] =~ /^\d+$/){
6558                                 $b_proc_int = 1;
6559                                 $b_first = 1;
6560                                 $cpu{'processors'}[$proc_count] = 0;
6561                                 $proc_count++;
6562                                 #print "p1: $proc_count\n";
6563                         }
6564                         else {
6565                                 if (!$b_proc_int){
6566                                         $cpu{'processors'}[$proc_count] = 0;
6567                                         $proc_count++;
6568                                         #print "p2a: $proc_count\n";
6569                                 }
6570                                 if (!$b_first ){
6571                                         # note: alternate:
6572                                         # Processor     : AArch64 Processor rev 4 (aarch64)
6573                                         # but no model name type
6574                                         if ( $b_arm || $line[1] =~ /ARM|AArch/i){
6575                                                 $b_arm = 1;
6576                                                 $cpu{'type'} = 'arm';
6577                                         }
6578                                         $cpu{'model_name'} = main::cleaner($line[1]);
6579                                         $cpu{'model_name'} = cpu_cleaner($cpu{'model'});
6580                                         #print "p2b:\n";
6581                                 }
6582                                 $b_first = 1;
6583                         }
6584                 }
6585                 elsif (!$cpu{'family'} &&
6586                        ($line[0] eq 'architecture' || $line[0] eq 'cpu family' || $line[0] eq 'cpu architecture' )){
6587                         if ($line[1] =~ /^\d+$/){
6588                                 # translate integers to hex
6589                                 $cpu{'family'} = uc(sprintf("%x", $line[1]));
6590                         }
6591                         elsif ($b_arm) {
6592                                 $cpu{'arch'} = $line[1];
6593                         }
6594                 }
6595                 elsif (!$cpu{'rev'} && ($line[0] eq 'stepping' || $line[0] eq 'cpu revision' )){
6596                         $cpu{'rev'} = uc(sprintf("%x", $line[1]));
6597                 }
6598                 # this is hex so uc for cpu arch id
6599                 elsif (!$cpu{'model_id'} && $line[0] eq 'model' ){
6600                         $cpu{'model_id'} = uc(sprintf("%x", $line[1]));
6601                 }
6602                 elsif (!$cpu{'model_id'} && $line[0] eq 'cpu variant' ){
6603                         $cpu{'model_id'} = uc($line[1]);
6604                         $cpu{'model_id'} =~ s/^0X//;
6605                 }
6606                 # cpu can show in arm
6607                 elsif (!$cpu{'model_name'} && ( $line[0] eq 'model name' || $line[0] eq 'cpu' || $line[0] eq 'cpu model' )){
6608                         $cpu{'model_name'} = main::cleaner($line[1]);
6609                         $cpu{'model_name'} = cpu_cleaner($cpu{'model_name'});
6610                         if ( $b_arm || $line[1] =~ /ARM|AArch/i){
6611                                 $b_arm = 1;
6612                                 $cpu{'type'} = 'arm';
6613                                 if ($cpu{'model_name'} && $cpu{'model_name'} =~ /(.*)\srev\s([\S]+)\s(\(([\S]+)\))?/){
6614                                         $cpu{'model_name'} = $1;
6615                                         $cpu{'rev'} = $2;
6616                                         if ($4){
6617                                                 $cpu{'arch'} = $4;
6618                                                 $cpu{'model_name'} .= ' ' . $cpu{'arch'} if $cpu{'model_name'} !~ /$cpu{'arch'}/i;
6619                                         }
6620                                         #$cpu{'processors'}[$proc_count] = 0;
6621                                 }
6622                         }
6623                         elsif ($b_mips || $line[1] =~ /mips/i){
6624                                 $b_mips = 1;
6625                                 $cpu{'type'} = 'mips';
6626                         }
6627                 }
6628                 elsif ( $line[0] eq 'cpu mhz' ){
6629                         $speed = speed_cleaner($line[1]);
6630                         $cpu{'processors'}[$proc_count-1] = $speed;
6631                         #$ids[$phys_id][$die_id] = ([($speed)]);
6632                 }
6633                 elsif (!$cpu{'siblings'} && $line[0] eq 'siblings' ){
6634                         $cpu{'siblings'} = $line[1];
6635                 }
6636                 elsif (!$cpu{'cores'} && $line[0] eq 'cpu cores' ){
6637                         $cpu{'cores'} = $line[1];
6638                 }
6639                 # increment by 1 for every new physical id we see. These are in almost all cases
6640                 # separate cpus, not separate dies within a single cpu body.
6641                 elsif ( $line[0] eq 'physical id' ){
6642                         if ( !defined $phys_holder || $phys_holder != $line[1] ){
6643                                 # only increment if not in array counter
6644                                 push @phys_cpus, $line[1] if ! grep {/$line[1]/} @phys_cpus;
6645                                 $phys_holder = $line[1];
6646                                 $ids[$phys_holder] = ([]) if ! exists $ids[$phys_holder];
6647                                 $ids[$phys_holder][$die_id] = ([]) if ! exists $ids[$phys_holder][$die_id];
6648                                 #print "pid: $line[1] ph: $phys_holder did: $die_id\n";
6649                                 $die_id = 0;
6650                                 #$die_holder = 0;
6651                         }
6652                 }
6653                 elsif ( $line[0] eq 'core id' ){
6654                         #print "ph: $phys_holder did: $die_id l1: $line[1] s: $speed\n";
6655                         # https://www.pcworld.com/article/3214635/components-processors/ryzen-threadripper-review-we-test-amds-monster-cpu.html
6656                         if ($line[1] > 0 ){
6657                                 $die_holder = $line[1];
6658                                 $core_count++;
6659                         }
6660                         # NOTE: this logic won't work for die detections, unforutnately.
6661                         # ARM uses a different /sys based method, and ryzen relies on math on the cores
6662                         # in process_data
6663                         elsif ($line[1] == 0 && $die_holder > 0 ){
6664                                 $die_holder = $line[1];
6665                                 $core_count = 0;
6666                                 $die_id++ if ($cpu{'type'} ne 'intel' && $cpu{'type'} ne 'amd' );
6667                         }
6668                         $phys_holder = 0 if ! defined $phys_holder;
6669                         $ids[$phys_holder][$die_id][$line[1]] = $speed;
6670                         #print "ph: $phys_holder did: $die_id l1: $line[1] s: $speed\n";
6671                 }
6672                 if (!$cpu{'type'} && $line[0] eq 'vendor_id' ){
6673                         $cpu{'type'} = cpu_vendor($line[1]);
6674                 }
6675                 ## this is only for -C full cpu output
6676                 if ( $type eq 'full' ){
6677                         if (!$cpu{'l2-cache'} && $line[0] eq 'cache size'){
6678                                 if ($line[1] =~ /(\d+)\sKB$/){
6679                                         $cpu{'l2-cache'} = $1;
6680                                 }
6681                                 elsif ($line[1] =~ /(\d+)\sMB$/){
6682                                         $cpu{'l2-cache'} = ($1*1024);
6683                                 }
6684                         }
6685                         if (!$cpu{'flags'} && ($line[0] eq 'flags' || $line[0] eq 'features' )){
6686                                 $cpu{'flags'} = $line[1];
6687                         }
6688                 }
6689                 if ( $extra > 0 && $type eq 'full' ){
6690                         if ($line[0] eq 'bogomips'){
6691                                 # new arm shows bad bogomip value, so don't use it
6692                                 $cpu{'bogomips'} += $line[1] if $line[1] > 50;
6693                         }
6694                 }
6695                 if ($b_admin ){
6696                         if ( !$cpu{'bugs'} && $line[0] eq 'bugs'){
6697                                 $cpu{'bugs'} = $line[1];
6698                         }
6699                         # unlike family and model id, microcode appears to be hex already
6700                         if ( !$cpu{'microcode'} && $line[0] eq 'microcode'){
6701                                 if ($line[1] =~ /0x/){
6702                                         $cpu{'microcode'} = uc($line[1]);
6703                                         $cpu{'microcode'} =~ s/^0X//;
6704                                 }
6705                                 else {
6706                                         $cpu{'microcode'} = uc(sprintf("%x", $line[1]));
6707                                 }
6708                         }
6709                 }
6710         }
6711         $cpu{'phys'} = scalar @phys_cpus;
6712         $cpu{'dies'} = $die_id++; # count starts at 0, all cpus have 1 die at least
6713         if ($b_arm){
6714                 if ($cpu{'dies'} <= 1){
6715                         my $arm_dies = cpu_dies_sys();
6716                         # case were 4 core arm returned 4 sibling lists, obviously wrong
6717                         $cpu{'dies'} = $arm_dies if $arm_dies && $proc_count != $arm_dies;
6718                 }
6719                 $cpu{'type'} = 'arm' if !$cpu{'type'};
6720                 if (!$bsd_type){
6721                         my %arm_cpus = arm_cpu_name();
6722                         $cpu{'arm-cpus'} = \%arm_cpus if %arm_cpus;
6723                 }
6724         }
6725         $cpu{'ids'} = (\@ids);
6726         if ( $extra > 0 && !$cpu{'arch'} && $type ne 'short' ){
6727                 $cpu{'arch'} = cpu_arch($cpu{'type'},$cpu{'family'},$cpu{'model_id'});
6728                 $cpu{'arch'} = $cpu_arch if (!$cpu{'arch'} && $cpu_arch && ($b_mips || $b_arm))
6729                 #print "$cpu{'type'},$cpu{'family'},$cpu{'model_id'},$cpu{'arch'}\n";
6730         }
6731         if (!$speeds{'cur-freq'}){
6732                 $cpu{'cur-freq'} = $cpu{'processors'}[0];
6733                 $speeds{'min-freq'} = 0;
6734                 $speeds{'max-freq'} = 0;
6735         }
6736         else {
6737                 $cpu{'cur-freq'} = $speeds{'cur-freq'};
6738                 $cpu{'min-freq'} = $speeds{'min-freq'};
6739                 $cpu{'max-freq'} = $speeds{'max-freq'};
6740         }
6741         main::log_data('dump','%cpu',\%cpu) if $b_log;
6742         print Data::Dumper::Dumper \%cpu if $test[8];
6743         eval $end if $b_log;
6744         return %cpu;
6745 }
6746
6747 sub data_sysctl {
6748         eval $start if $b_log;
6749         my ($type) = @_;
6750         my %cpu = set_cpu_data();
6751         my (@ids,@line,%speeds,@working);
6752         my ($sep) = ('');
6753         my ($cache,$die_holder,$die_id,$phys_holder,$phys_id,$proc_count,$speed) = (0,0,0,0,0,0,0);
6754         foreach (@sysctl){
6755                 @line = split /\s*:\s*/, $_;
6756                 next if ! $line[0];
6757                 # darwin shows machine, like MacBook7,1, not cpu
6758                 # machdep.cpu.brand_string: Intel(R) Core(TM)2 Duo CPU     P8600  @ 2.40GHz
6759                 if ( ($bsd_type ne 'darwin' && $line[0] eq 'hw.model' ) || $line[0] eq 'machdep.cpu.brand_string' ){
6760                         # cut L2 cache/cpu max speed out of model string, if available
6761                         # openbsd 5.6: AMD Sempron(tm) Processor 3400+ ("AuthenticAMD" 686-class, 256KB L2 cache)
6762                         # freebsd 10: hw.model: AMD Athlon(tm) II X2 245 Processor
6763                         $line[1] = main::cleaner($line[1]);
6764                         $line[1] = cpu_cleaner($line[1]);
6765                         if ( $line[1] =~ /([0-9]+)[\-[:space:]]*([KM]B)\s+L2 cache/) {
6766                                 my $multiplier = ($2 eq 'MB') ? 1024: 1;
6767                                 $cpu{'l2-cache'} = $1 * $multiplier;
6768                         }
6769                         if ( $line[1] =~ /([^0-9\.][0-9\.]+)[\-[:space:]]*[MG]Hz/) {
6770                                 $cpu{'max-freq'} = $1;
6771                                 if ($cpu{'max-freq'} =~ /MHz/i) {
6772                                         $cpu{'max-freq'} =~ s/[\-[:space:]]*MHz//;
6773                                         $cpu{'max-freq'} = speed_cleaner($cpu{'max-freq'},'mhz');
6774                                 }
6775                                 elsif ($cpu{'max-freq'} =~ /GHz/) {
6776                                         $cpu{'max-freq'} =~ s/[\-[:space:]]*GHz//i;
6777                                         $cpu{'max-freq'} = $cpu{'max-freq'} / 1000;
6778                                         $cpu{'max-freq'} = speed_cleaner($cpu{'max-freq'},'mhz');
6779                                 }
6780                         }
6781                         if ( $line[1] =~ /\)$/ ){
6782                                 $line[1] =~ s/\s*\(.*\)$//;
6783                         }
6784                         $cpu{'model_name'} = $line[1];
6785                         $cpu{'type'} = cpu_vendor($line[1]);
6786                 }
6787                 # NOTE: hw.l1icachesize: hw.l1dcachesize:
6788                 elsif ($line[0] eq 'hw.l1icachesize') {
6789                         $cpu{'l1-cache'} = $line[1]/1024;
6790                 }
6791                 elsif ($line[0] eq 'hw.l2cachesize') {
6792                         $cpu{'l2-cache'} = $line[1]/1024;
6793                 }
6794                 # this is in mghz in samples
6795                 elsif ($line[0] eq 'hw.clockrate' || $line[0] eq 'hw.cpuspeed') {
6796                         $cpu{'cur-freq'} = $line[1];
6797                 }
6798                 # these are in hz: 2400000000
6799                 elsif ($line[0] eq 'hw.cpufrequency') {
6800                         $cpu{'cur-freq'} = $line[1]/1000000;
6801                 }
6802                 elsif ($line[0] eq 'hw.busfrequency_min') {
6803                         $cpu{'min-freq'} = $line[1]/1000000;
6804                 }
6805                 elsif ($line[0] eq 'hw.busfrequency_max') {
6806                         $cpu{'max-freq'} = $line[1]/1000000;
6807                 }
6808                 elsif ($line[0] eq 'machdep.cpu.vendor') {
6809                         $cpu{'type'} = cpu_vendor($line[1]);
6810                 }
6811                 # darwin only?
6812                 elsif ($line[0] eq 'machdep.cpu.features') {
6813                         $cpu{'flags'} = lc($line[1]);
6814                 }
6815                 elsif ($line[0] eq 'hw.ncpu' ) {
6816                         $cpu{'cores'} = $line[1];
6817                 }
6818                 # Freebsd does some voltage hacking to actually run at lowest listed frequencies.
6819                 # The cpu does not actually support all the speeds output here but works in freebsd.
6820                 elsif ($line[0] eq 'dev.cpu.0.freq_levels') {
6821                         $line[1] =~ s/^\s+|\/[0-9]+|\s+$//g;
6822                         if ( $line[1] =~ /[0-9]+\s+[0-9]+/ ) {
6823                                 my @temp = split /\s+/, $line[1];
6824                                 $cpu{'max-freq'} = $temp[0];
6825                                 $cpu{'min-freq'} = $temp[-1];
6826                                 $cpu{'scalings'} = \@temp;
6827                         }
6828                 }
6829                 elsif (!$cpu{'cur-freq'} && $line[0] eq 'dev.cpu.0.freq' ) {
6830                         $cpu{'cur-freq'} = $line[1];
6831                 }
6832                 # the following have only been seen in DragonflyBSD data but thumbs up!
6833                 elsif ($line[0] eq 'hw.cpu_topology.members' ) {
6834                         my @temp = split /\s+/, $line[1];
6835                         my $count = scalar @temp;
6836                         $count-- if $count > 0;
6837                         $cpu{'processors'}[$count] = 0;
6838                         # no way to get per processor speeds yet, so assign 0 to each
6839                         foreach (0 .. $count){
6840                                 $cpu{'processors'}[$_] = 0;
6841                         }
6842                 }
6843                 elsif ($line[0] eq 'hw.cpu_topology.cpu1.physical_siblings' ) {
6844                         # string, like: cpu0 cpu1
6845                         my @temp = split /\s+/, $line[1];
6846                         $cpu{'siblings'} = scalar @temp;
6847                 }
6848                 # increment by 1 for every new physical id we see. These are in almost all cases
6849                 # separate cpus, not separate dies within a single cpu body.
6850                 elsif ( $line[0] eq 'hw.cpu_topology.cpu0.physical_id' ){
6851                         if ($phys_holder != $line[1] ){
6852                                 $phys_id++;
6853                                 $phys_holder = $line[1];
6854                                 $ids[$phys_id] = ([(0)]);
6855                                 $ids[$phys_id][$die_id] = ([(0)]);
6856                         }
6857                 }
6858                 elsif ( $line[0] eq 'hw.cpu_topology.cpu0.core_id' ){
6859                         if ($line[1] > 0 ){
6860                                 $die_holder = $line[1];
6861                         }
6862                         # this handles multi die cpus like 16 core ryzen
6863                         elsif ($line[1] == 0 && $die_holder > 0 ){
6864                                 $die_id++ ;
6865                                 $die_holder = $line[1];
6866                         }
6867                         $ids[$phys_id][$die_id][$line[1]] = $speed;
6868                         $cpu{'dies'} = $die_id;
6869                 }
6870         }
6871         if (!$cpu{'flags'}){
6872                 $cpu{'flags'} = cpu_flags_bsd();
6873         }
6874         main::log_data('dump','%cpu',\%cpu) if $b_log;
6875         print Data::Dumper::Dumper \%cpu if $test[8];
6876         eval $end if $b_log;
6877         return %cpu;
6878 }
6879
6880 sub cpu_properties {
6881         my (%cpu) = @_;
6882         my ($b_amd_zen,$b_epyc,$b_ht,$b_intel,$b_ryzen,$b_xeon);
6883         if ($cpu{'type'} ){
6884                 if ($cpu{'type'} eq 'intel'){
6885                         $b_intel = 1;
6886                         $b_xeon = 1 if $cpu{'model_name'} =~ /Xeon/i;
6887                 }
6888                 elsif ($cpu{'type'} eq 'amd' ){
6889                         if ( $cpu{'family'} && $cpu{'family'} eq '17' ) {
6890                                 $b_amd_zen = 1;
6891                                 if ($cpu{'model_name'} ){
6892                                         if ($cpu{'model_name'} =~ /Ryzen/i ){
6893                                                 $b_ryzen = 1;
6894                                         }
6895                                         elsif ($cpu{'model_name'} =~ /EPYC/i){
6896                                                 $b_epyc = 1;
6897                                         }
6898                                 }
6899                         }
6900                 }
6901         }
6902         #my @dies = $phys[0][0];
6903         my $ref = $cpu{'ids'};
6904         my @phys = @$ref;
6905         my $phyical_count = 0;
6906         #my $phyical_count = scalar @phys;
6907         my @processors;
6908         my ($speed,$speed_key);
6909         # handle case where cpu reports say, phys id 0, 2, 4, 6 [yes, seen it]
6910         foreach (@phys) {
6911                 $phyical_count++ if $_;
6912         }
6913         $phyical_count ||= 1; # assume 1 if no id found, as with ARM
6914         # count unique processors ##
6915         # note, this fails for intel cpus at times
6916         $ref = $cpu{'processors'};
6917         @processors = @$ref;
6918         #print ref $cpu{'processors'}, "\n";
6919         my $processors_count = scalar @processors;
6920         #print "p count:$processors_count\n";
6921         #print Data::Dumper::Dumper \@processors;
6922         # $cpu_cores is per physical cpu
6923         my ($cpu_layout,$cpu_type,$min_max,$min_max_key) = ('','','','');
6924         my ($cache,$core_count,$cpu_cores,$die_count) = (0,0,0,0);
6925         foreach my $die_ref ( @phys ){
6926                 next if ! $die_ref;
6927                 my @dies = @$die_ref;
6928                 $core_count = 0;
6929                 $die_count = scalar @dies;
6930                 #$cpu{'dies'} = $die_count;
6931                 foreach my $core_ref (@dies){
6932                         next if ref $core_ref ne 'ARRAY';
6933                         my @cores = @$core_ref;
6934                         $core_count = 0;# reset for each die!!
6935                         # NOTE: the counters can be undefined because the index comes from
6936                         # core id: which can be 0 skip 1 then 2, which leaves index 1 undefined
6937                         # arm cpus do not actually show core id so ignore that counter
6938                         foreach my $id (@cores){
6939                                 $core_count++ if defined $id && !$b_arm;
6940                         }
6941                         #print 'cores: ' . $core_count, "\n";
6942                 }
6943         }
6944         # this covers potentially cases where ARM cpus have > 1 die
6945         $cpu{'dies'} = ($b_arm && $die_count <= 1 && $cpu{'dies'} > 1) ? $cpu{'dies'}: $die_count;
6946         # this is an attempt to fix the amd family 15 bug with reported cores vs actual cores
6947         # NOTE: amd A6-4400M APU 2 core reports: cores: 1 siblings: 2
6948         # NOTE: AMD A10-5800K APU 4 core reports: cores: 2 siblings: 4
6949         if ($cpu{'cores'} && ! $core_count || $cpu{'cores'} >= $core_count){
6950                 $cpu_cores = $cpu{'cores'};
6951         }
6952         elsif ($core_count > $cpu{'cores'}){
6953                 $cpu_cores = $core_count;
6954         }
6955         #print "cpu-c:$cpu_cores\n";
6956         #$cpu_cores = $cpu{'cores'};
6957         # like, intel core duo
6958         # NOTE: sadly, not all core intel are HT/MT, oh well...
6959         # xeon may show wrong core / physical id count, if it does, fix it. A xeon
6960         # may show a repeated core id : 0 which gives a fake num_of_cores=1
6961         if ($b_intel){
6962                 if ($cpu{'siblings'} && $cpu{'siblings'} > 1 && $cpu{'cores'} && $cpu{'cores'} > 1 ){
6963                         if ( $cpu{'siblings'}/$cpu{'cores'} == 1 ){
6964                                 $b_intel = 0;
6965                                 $b_ht = 0;
6966                         }
6967                         else {
6968                                 $cpu_cores = ($cpu{'siblings'}/2);
6969                                 $b_ht = 1;
6970                         }
6971                 }
6972         }
6973         # ryzen is made out of blocks of 8 core dies
6974         elsif ($b_ryzen){
6975                 $cpu_cores = $cpu{'cores'};
6976                  # note: posix ceil isn't present in Perl for some reason, deprecated?
6977                 my $working = $cpu_cores / 8;
6978                 my @temp = split /\./, $working;
6979                 $cpu{'dies'} = ($temp[1] && $temp[1] > 0) ? $temp[0]++ : $temp[0];
6980         }
6981         # these always have 4 dies
6982         elsif ($b_epyc) {
6983                 $cpu_cores = $cpu{'cores'};
6984                 $cpu{'dies'} = 4;
6985         }
6986         # final check, override the num of cores value if it clearly is wrong
6987         # and use the raw core count and synthesize the total instead of real count
6988         if ( $cpu_cores == 0 && ($cpu{'cores'} * $phyical_count > 1)){
6989                 $cpu_cores = ($cpu{'cores'} * $phyical_count);
6990         }
6991         # last check, seeing some intel cpus and vms with intel cpus that do not show any
6992         # core id data at all, or siblings.
6993         if ($cpu_cores == 0 && $processors_count > 0){
6994                 $cpu_cores = $processors_count;
6995         }
6996         # this happens with BSDs which have very little cpu data available
6997         if ( $processors_count == 0 && $cpu_cores > 0 ){
6998                 $processors_count = $cpu_cores;
6999                 if ($bsd_type && ($b_ht || $b_amd_zen) && $cpu_cores > 2 ){
7000                         $cpu_cores = $cpu_cores/2;;
7001                 }
7002                 my $count = $processors_count;
7003                 $count-- if $count > 0;
7004                 $cpu{'processors'}[$count] = 0;
7005                 # no way to get per processor speeds yet, so assign 0 to each
7006                 # must be a numeric value. Could use raw speed from core 0, but
7007                 # that would just be a hack.
7008                 foreach (0 .. $count){
7009                         $cpu{'processors'}[$_] = 0;
7010                 }
7011         }
7012         # last test to catch some corner cases
7013         # seen a case where a xeon vm in a dual xeon system actually had 2 cores, no MT
7014         # so it reported 4 siblings, 2 cores, but actually only had 1 core per virtual cpu
7015         #print "prc: $processors_count phc: $phyical_count coc: $core_count cpc: $cpu_cores\n";
7016         if (!$b_arm && $processors_count == $phyical_count*$core_count && $cpu_cores > $core_count){
7017                 $b_ht = 0;
7018                 #$b_xeon = 0;
7019                 $b_intel = 0;
7020                 $cpu_cores = 1;
7021                 $core_count = 1;
7022                 $cpu{'siblings'} = 1;
7023         }
7024         #print "pc: $processors_count s: $cpu{'siblings'} cpuc: $cpu_cores corec: $core_count\n";
7025         # Algorithm:
7026         # if > 1 processor && processor id (physical id) == core id then Multi threaded (MT)
7027         # if siblings > 1 && siblings ==  2 * num_of_cores ($cpu{'cores'}) then Multi threaded (MT)
7028         # if > 1 processor && processor id (physical id) != core id then Multi-Core Processors (MCP)
7029         # if > 1 processor && processor ids (physical id) > 1 then Symmetric Multi Processing (SMP)
7030         # if = 1 processor then single core/processor Uni-Processor (UP)
7031         if ( $processors_count > 1 || ( $b_intel && $cpu{'siblings'} > 0 ) ) {
7032                 # non-multicore MT
7033                 if ($processors_count == ($phyical_count * $cpu_cores * 2)){
7034                         #print "mt:1\n";
7035                         $cpu_type .= 'MT';
7036                 }
7037 #               elsif ($b_xeon && $cpu{'siblings'} > 1){
7038 #                       #print "mt:2\n";
7039 #                       $cpu_type .= 'MT';
7040 #               }
7041                 elsif ($cpu{'siblings'} > 1 && ($cpu{'siblings'} == 2 * $cpu_cores )){
7042                         #print "mt:3\n";
7043                         $cpu_type .= 'MT';
7044                 }
7045                 # non-MT multi-core or MT multi-core
7046                 if ( ($processors_count == $cpu_cores ) || ($phyical_count < $cpu_cores)){
7047                         my $sep = ($cpu_type) ? ' ' : '' ;
7048                         $cpu_type .= $sep . 'MCP';
7049                 }
7050                 # only solidly known > 1 die cpus will use this, ryzen and arm for now
7051                 if ( $cpu{'dies'} > 1 ){
7052                         my $sep = ($cpu_type) ? ' ' : '' ;
7053                         $cpu_type .= $sep . 'MCM';
7054                 }
7055                 # >1 cpu sockets active: Symetric Multi Processing
7056                 if ($phyical_count > 1){
7057                         my $sep = ($cpu_type) ? ' ' : '' ;
7058                         $cpu_type .= $sep . 'SMP';
7059                 }
7060         }
7061         else {
7062                 $cpu_type = 'UP';
7063         }
7064         if ($phyical_count > 1){
7065                 $cpu_layout = $phyical_count . 'x ';
7066         }
7067         $cpu_layout .= count_alpha($cpu_cores) . 'Core';
7068         $cpu_layout .= ' (' . $cpu{'dies'}. '-Die)' if !$bsd_type && $cpu{'dies'} > 1;
7069         # the only possible change for bsds is if we can get phys counts in the future
7070         if ($bsd_type){
7071                 $cache = $cpu{'l2-cache'} * $phyical_count;
7072         }
7073         # AMD SOS chips appear to report full L2 cache per core
7074         elsif ($cpu{'type'} eq 'amd' && ($cpu{'family'} eq '14' || $cpu{'family'} eq '15' || $cpu{'family'} eq '16')){
7075                 $cache = $cpu{'l2-cache'} * $phyical_count;
7076         }
7077         elsif ($cpu{'type'} ne 'intel'){
7078                 $cache = $cpu{'l2-cache'} * $cpu_cores * $phyical_count;
7079         }
7080         ## note: this handles how intel reports L2, total instead of per core like AMD does
7081         # note that we need to multiply by number of actual cpus here to get true cache size
7082         else {
7083                 $cache = $cpu{'l2-cache'} * $phyical_count;
7084         }
7085         if ($cache > 10000){
7086                 $cache = sprintf("%.01f MiB",$cache/1024); # trim to no decimals?
7087         }
7088         elsif ($cache > 0){
7089                 $cache = "$cache KiB";
7090         }
7091         if ($cpu{'cur-freq'} && $cpu{'min-freq'} && $cpu{'max-freq'} ){
7092                 $min_max = "$cpu{'min-freq'}/$cpu{'max-freq'} MHz";
7093                 $min_max_key = "min/max";
7094                 $speed_key = ($show{'short'} || $show{'cpu-basic'}) ? 'speed' : 'Speed';
7095                 $speed = "$cpu{'cur-freq'} MHz";
7096         }
7097         elsif ($cpu{'cur-freq'} && $cpu{'max-freq'}){
7098                 $min_max = "$cpu{'max-freq'} MHz";
7099                 $min_max_key = "max";
7100                 $speed_key = ($show{'short'} || $show{'cpu-basic'}) ? 'speed' : 'Speed';
7101                 $speed = "$cpu{'cur-freq'} MHz";
7102         }
7103 #       elsif ($cpu{'cur-freq'} && $cpu{'max-freq'} && $cpu{'cur-freq'} == $cpu{'max-freq'}){
7104 #               $speed_key = ($show{'short'} || $show{'cpu-basic'}) ? 'speed' : 'Speed';
7105 #               $speed = "$cpu{'cur-freq'} MHz (max)";
7106 #       }
7107         elsif ($cpu{'cur-freq'} && $cpu{'min-freq'}){
7108                 $min_max = "$cpu{'min-freq'} MHz";
7109                 $min_max_key = "min";
7110                 $speed_key = ($show{'short'} || $show{'cpu-basic'}) ? 'speed' : 'Speed';
7111                 $speed = "$cpu{'cur-freq'} MHz";
7112         }
7113         elsif ($cpu{'cur-freq'} && !$cpu{'max-freq'}){
7114                 $speed_key = ($show{'short'} || $show{'cpu-basic'}) ? 'speed' : 'Speed';
7115                 $speed = "$cpu{'cur-freq'} MHz";
7116         }
7117
7118         if ( !$bits_sys && !$b_arm && $cpu{'flags'} ){
7119                 $bits_sys = ($cpu{'flags'} =~ /\blm\b/) ? 64 : 32;
7120         }
7121         my %cpu_properties = (
7122         'bits-sys' => $bits_sys,
7123         'cpu-layout' => $cpu_layout,
7124         'cpu-type' => $cpu_type,
7125         'min-max-key' => $min_max_key,
7126         'min-max' => $min_max,
7127         'speed-key' => $speed_key,
7128         'speed' => $speed,
7129         'l2-cache' => $cache,
7130         );
7131         main::log_data('dump','%cpu_properties',\%cpu_properties) if $b_log;
7132         #print Data::Dumper::Dumper \%cpu;
7133         #print Data::Dumper::Dumper \%cpu_properties;
7134         #my $dc = scalar @dies;
7135         #print 'phys: ' . $pc . ' dies: ' . $dc, "\n";
7136         eval $end if $b_log;
7137         return %cpu_properties;
7138 }
7139 sub cpu_speeds {
7140         eval $start if $b_log;
7141         my (@processors) = @_;
7142         my (@speeds);
7143         my @files = main::globber('/sys/devices/system/cpu/cpu*/cpufreq/scaling_cur_freq');
7144         foreach (@files){
7145                 my $speed = (main::reader($_))[0];
7146                 if ($speed || $speed eq '0'){
7147                         $speed = sprintf "%.0f", $speed/1000;
7148                         push @speeds, $speed;
7149                 }
7150         }
7151         if (!@speeds){
7152                 foreach (@processors){
7153                         if ($_ || $_ eq '0'){
7154                                 $_ = sprintf "%.0f", $_;
7155                                 push @speeds, $_;
7156                         }
7157                 }
7158         }
7159         #print join '; ', @speeds, "\n";
7160         eval $end if $b_log;
7161         return @speeds;
7162 }
7163 sub set_cpu_speeds_sys {
7164         eval $start if $b_log;
7165         my (@arm,%speeds);
7166         my $sys = '/sys/devices/system/cpu/cpufreq/policy0';
7167         my $sys2 = '/sys/devices/system/cpu/cpu0/cpufreq/';
7168         my ($cur,$min,$max) = ('scaling_cur_freq','scaling_min_freq','scaling_max_freq');
7169         if (!-d $sys && -d $sys2){
7170                 $sys = $sys2;
7171                 ($cur,$min,$max) = ('scaling_cur_freq','cpuinfo_min_freq','cpuinfo_max_freq');
7172         }
7173         if (-d $sys){
7174                 $speeds{'cur-freq'} = (main::reader("$sys/$cur"))[0];
7175                 $speeds{'cur-freq'} = speed_cleaner($speeds{'cur-freq'},'khz');
7176                 $speeds{'min-freq'} = (main::reader("$sys/$min"))[0];
7177                 $speeds{'min-freq'} = speed_cleaner($speeds{'min-freq'},'khz');
7178                 $speeds{'max-freq'} = (main::reader("$sys/$max"))[0];
7179                 $speeds{'max-freq'} = speed_cleaner($speeds{'max-freq'},'khz');
7180                 if ($b_arm){
7181                         @arm = main::globber('/sys/devices/system/cpu/cpufreq/policy*/');
7182                         # there are arm chips with two dies, that run at different min max speeds!!
7183                         # see: https://github.com/smxi/inxi/issues/128
7184                         # it would be slick to show both die min/max/cur speeds, but this is
7185                         # ok for now.
7186                         if (scalar @arm > 1){
7187                                 my ($current,$max,$min) = (0,0,0);
7188                                 foreach (@arm){
7189                                         $_ =~ s/\/$//; # strip off last slash in case globs have them
7190                                         my $max_temp = main::reader("$_/cpuinfo_max_freq");
7191                                         $max_temp = speed_cleaner($max_temp,'khz');
7192                                         if ($max_temp > $max){
7193                                                 $max = $max_temp;
7194                                         }
7195                                         my $min_temp = main::reader("$_/cpuinfo_min_freq");
7196                                         $min_temp = speed_cleaner($min_temp,'khz');
7197                                         if ($min_temp < $min || $min == 0){
7198                                                 $max = $min_temp;
7199                                         }
7200                                         my $cur_temp = main::reader("$_/cpuinfo_max_freq");
7201                                         $cur_temp = speed_cleaner($cur_temp,'khz');
7202                                         if ($cur_temp > $current){
7203                                                 $current = $cur_temp;
7204                                         }
7205                                 }
7206                                 $speeds{'cur-freq'} = $current if $current;
7207                                 $speeds{'max-freq'} = $max if $max;
7208                                 $speeds{'min-freq'} = $min if $min;
7209                         }
7210                 }
7211                 # policy4/cpuinfo_max_freq:["2000000"]
7212                 # policy4/cpuinfo_min_freq:["200000"]
7213                 if ($speeds{'min-freq'} > $speeds{'max-freq'} || $speeds{'min-freq'} == $speeds{'max-freq'}){
7214                         $speeds{'min-freq'} = 0;
7215                 }
7216         }
7217         main::log_data('dump','%speeds',\%speeds) if $b_log;
7218         eval $end if $b_log;
7219         return %speeds;
7220 }
7221
7222 # right now only using this for ARM cpus, this is not the same in intel/amd
7223 sub cpu_dies_sys {
7224         eval $start if $b_log;
7225         my @data = main::globber('/sys/devices/system/cpu/cpu*/topology/core_siblings_list');
7226         my (@dies);
7227         foreach (@data){
7228                 my $siblings = (main::reader($_))[0];
7229                 if (! grep {/$siblings/} @dies){
7230                         push @dies, $siblings;
7231                 }
7232         }
7233         my $die_count = scalar @dies;
7234         eval $end if $b_log;
7235         return $die_count;
7236 }
7237 sub cpu_flags_bsd {
7238         eval $start if $b_log;
7239         my ($flags,$sep) = ('','');
7240         # this will be null if it was not readable
7241         my $file = main::system_files('dmesg-boot');
7242         if ( @dmesg_boot){
7243                 foreach (@dmesg_boot){
7244                         if ( /Features/ || ( $bsd_type eq "openbsd" && /^cpu0:\s*[a-z0-9]{2,3}(\s|,)[a-z0-9]{2,3}(\s|,)/i ) ) {
7245                                 my @line = split /:\s*/, lc($_);
7246                                 # free bsd has to have weird syntax: <....<b23>,<b34>>
7247                                 # Features2=0x1e98220b<SSE3,PCLMULQDQ,MON,SSSE3,CX16,SSE4.1,SSE4.2,POPCNT,AESNI,XSAVE,OSXSAVE,AVX>
7248                                 $line[1] =~ s/^[^<]*<|>[^>]*$//g;
7249                                 # then get rid of <b23> stuff
7250                                 $line[1] =~ s/<[^>]+>//g;
7251                                 # and replace commas with spaces
7252                                 $line[1] =~ s/,/ /g;
7253                                 $flags .= $sep . $line[1];
7254                                 $sep = ' ';
7255                         }
7256                         elsif (/real mem/){
7257                                 last;
7258                         }
7259                 }
7260                 if ($flags){
7261                         $flags =~ s/\s+/ /g;
7262                         $flags =~ s/^\s+|\s+$//g;
7263                 }
7264         }
7265         else {
7266                 if ( $file && ! -r $file ){
7267                         $flags = main::row_defaults('dmesg-boot-permissions');
7268                 }
7269         }
7270         eval $end if $b_log;
7271         return $flags;
7272 }
7273
7274 sub cpu_vendor {
7275         eval $start if $b_log;
7276         my ($string) = @_;
7277         my ($vendor) = ('');
7278         $string = lc($string);
7279         if ($string =~ /intel/) {
7280                 $vendor = "intel"
7281         }
7282         elsif ($string =~ /amd/){
7283                 $vendor = "amd"
7284         }
7285         # via
7286         elsif ($string =~ /centaur/){
7287                 $vendor = "centaur"
7288         }
7289         eval $end if $b_log;
7290         return $vendor;
7291 }
7292 sub get_boost_status {
7293         eval $start if $b_log;
7294         my ($boost);
7295         my $path = '/sys/devices/system/cpu/cpufreq/boost';
7296         if (-f $path){
7297                 $boost = (main::reader($path))[0];
7298                 if (defined $boost && $boost =~/^[01]$/){
7299                         $boost = ($boost) ? 'enabled' : 'disabled';
7300                 }
7301         }
7302         eval $end if $b_log;
7303         return $boost;
7304 }
7305 sub arm_cpu_name {
7306         eval $start if $b_log;
7307         my (%cpus,$compat);
7308         if ( -e '/sys/firmware/devicetree/base/cpus/cpu@1/compatible' ){
7309                 my @working = main::globber('/sys/firmware/devicetree/base/cpus/cpu@*/compatible');
7310                 foreach my $file (@working){
7311                         $compat = (main::reader($file))[0];
7312                         # these can have non printing ascii... why? As long as we only have the
7313                         # splits for: null 00/start header 01/start text 02/end text 03
7314                         $compat = (split /\x01|\x02|\x03|\x00/, $compat)[0] if $compat;
7315                         $compat = (split /,\s*/, $compat)[-1] if $compat;
7316                         $cpus{$compat} = ($cpus{$compat}) ? ++$cpus{$compat}: 1;
7317                 }
7318         }
7319         main::log_data('dump','%cpus',\%cpus) if $b_log;
7320         eval $end if $b_log;
7321         return %cpus;
7322 }
7323
7324 sub cpu_arch {
7325         eval $start if $b_log;
7326         my ($type,$family,$model) = @_;
7327         my $arch = '';
7328         # https://en.wikipedia.org/wiki/List_of_AMD_CPU_microarchitectures
7329         # print "$type;$family;$model\n";
7330         if ( $type eq 'amd'){
7331                 if ($family eq '4'){
7332                         if ( $model =~ /^(3|7|8|9|A)$/ ) {$arch = 'Am486'}
7333                         elsif ( $model =~ /^(E|F)$/ ) {$arch = 'Am5x86'}
7334                 }
7335                 elsif ($family eq '5'){
7336                         if ( $model =~ /^(0|1|2|3)$/ ) {$arch = 'K5'}
7337                         elsif ( $model =~ /^(6|7)$/ ) {$arch = 'K6'}
7338                         elsif ( $model =~ /^(8)$/ ) {$arch = 'K6-2'}
7339                         elsif ( $model =~ /^(9|D)$/ ) {$arch = 'K6-3'}
7340                         elsif ( $model =~ /^(A)$/ ) {$arch = 'Geode'}
7341                         }
7342                 elsif ($family eq '6'){
7343                         if ( $model =~ /^(1|2)$/ ) {$arch = 'K7'}
7344                         elsif ( $model =~ /^(3|4)$/ ) {$arch = 'K7 Thunderbird'}
7345                         elsif ( $model =~ /^(6|7|8|A)$/ ) {$arch = 'K7 Palomino+'}
7346                         else {$arch = 'K7'}
7347                 }
7348                 elsif ($family eq 'F'){
7349                         if ( $model =~ /^(4|5|7|8|B|C|E|F|14|15|17|18|1B|1C|1F)$/ ) {$arch = 'K8'}
7350                         elsif ( $model =~ /^(21|23|24|25|27|28|2C|2F)$/ ) {$arch = 'K8 rev.E'}
7351                         elsif ( $model =~ /^(41|43|48|4B|4C|4F|5D|5F|68|6B|6C|6F|7C|7F|C1)$/ ) {$arch = 'K8 rev.F+'}
7352                         else {$arch = 'K8'}
7353                 }
7354                 elsif ($family eq '10'){
7355                         if ( $model =~ /^(2|4|5|6|8|9|A)$/ ) {$arch = 'K10'}
7356                         else {$arch = 'K10'}
7357                 }
7358                 elsif ($family eq '11'){
7359                         if ( $model =~ /^(3)$/ ) {$arch = 'Turion X2 Ultra'}
7360                 }
7361                 # might also need cache handling like 14/16
7362                 elsif ($family eq '12'){
7363                         if ( $model =~ /^(1)$/ ) {$arch = 'Fusion'}
7364                         else {$arch = 'Fusion'}
7365                 }
7366                 # SOC, apu
7367                 elsif ($family eq '14'){
7368                         if ( $model =~ /^(1|2)$/ ) {$arch = 'Bobcat'}
7369                         else {$arch = 'Bobcat'}
7370                 }
7371                 elsif ($family eq '15'){
7372                         if ( $model =~ /^(0|1|2|3|4|5|6|7|8|9|A|B|C|D|E|F)$/ ) {$arch = 'Bulldozer'}
7373                         elsif ( $model =~ /^(10|11|12|13|14|15|16|17|18|19|1A|1B|1C|1D|1E|1F)$/ ) {$arch = 'Piledriver'}
7374                         elsif ( $model =~ /^(30|31|32|33|34|35|36|37|38|39|3A|3B|3C|3D|3E|3F)$/ ) {$arch = 'Steamroller'}
7375                         elsif ( $model =~ /^(60|61|62|63|64|65|66|67|68|69|6A|6B|6C|6D|6E|6F|70|71|72|73|74|75|76|77|78|79|7A|7B|7C|7D|7E|7F)$/ ) {$arch = 'Excavator'}
7376                         else {$arch = 'Bulldozer'}
7377                 }
7378                 # SOC, apu
7379                 elsif ($family eq '16'){
7380                         if ( $model =~ /^(0|1|2|3|4|5|6|7|8|9|A|B|C|D|E|F)$/ ) {$arch = 'Jaguar'}
7381                         elsif ( $model =~ /^(30|31|32|33|34|35|36|37|38|39|3A|3B|3C|3D|3E|3F)$/ ) {$arch = 'Puma'}
7382                         else {$arch = 'Jaguar'}
7383                 }
7384                 elsif ($family eq '17'){
7385                         if ( $model =~ /^(1)$/ ) {$arch = 'Zen'}
7386                         else {$arch = 'Zen'}
7387                 }
7388         }
7389         elsif ( $type eq 'arm'){
7390                 if ($family ne ''){$arch="ARMv$family";}
7391                 else {$arch='ARM';}
7392         }
7393         # aka VIA
7394         elsif ( $type eq 'centaur'){
7395                 if ($family eq '5'){
7396                         if ( $model =~ /^(4)$/ ) {$arch = 'WinChip C6'}
7397                         elsif ( $model =~ /^(8)$/ ) {$arch = 'WinChip 2'}
7398                         elsif ( $model =~ /^(9)$/ ) {$arch = 'WinChip 3'}
7399                 }
7400                 elsif ($family eq '6'){
7401                         if ( $model =~ /^(6)$/ ) {$arch = 'WinChip-based'}
7402                         elsif ( $model =~ /^(7|8)$/ ) {$arch = 'C3'}
7403                         elsif ( $model =~ /^(9)$/ ) {$arch = 'C3-2'}
7404                         elsif ( $model =~ /^(A|D)$/ ) {$arch = 'C7'}
7405                         elsif ( $model =~ /^(F)$/ ) {$arch = 'Isaiah'}
7406                 }
7407         }
7408         # https://software.intel.com/en-us/articles/intel-architecture-and-processor-identification-with-cpuid-model-and-family-numbers
7409         elsif ( $type eq 'intel'){
7410                 if ($family eq '4'){
7411                         if ( $model =~ /^(0|1|2|3|4|5|6|7|8|9)$/ ) {$arch = '486'}
7412                 }
7413                 elsif ($family eq '5'){
7414                         if ( $model =~ /^(1|2|3|7)$/ ) {$arch = 'P5'}
7415                         elsif ( $model =~ /^(4|8)$/ ) {$arch = 'P5'} # MMX
7416                         elsif ( $model =~ /^(9)$/ ) {$arch = 'Quark'}
7417                 }
7418                 elsif ($family eq '6'){
7419                         if ( $model =~ /^(1)$/ ) {$arch = 'P6 Pro'}
7420                         elsif ( $model =~ /^(15)$/ ) {$arch = 'Dothan Tolapai'} # pentium M system on chip
7421                         elsif ( $model =~ /^(3)$/ ) {$arch = 'P6 II Klamath'}
7422                         elsif ( $model =~ /^(5)$/ ) {$arch = 'P6 II Deschutes'}
7423                         elsif ( $model =~ /^(6)$/ ) {$arch = 'P6 II Mendocino'}
7424                         elsif ( $model =~ /^(7)$/ ) {$arch = 'P6 III Katmai'}
7425                         elsif ( $model =~ /^(8)$/ ) {$arch = 'P6 III Coppermine'}
7426                         elsif ( $model =~ /^(9)$/ ) {$arch = 'Banias'} # pentium M
7427                         elsif ( $model =~ /^(A)$/ ) {$arch = 'P6 III Xeon'}
7428                         elsif ( $model =~ /^(B)$/ ) {$arch = 'P6 III Tualitin'}
7429                         elsif ( $model =~ /^(D)$/ ) {$arch = 'Dothan'} # Pentium M
7430                         elsif ( $model =~ /^(E)$/ ) {$arch = 'Yonah'}
7431                         elsif ( $model =~ /^(F|16)$/ ) {$arch = 'Merom'}
7432                         elsif ( $model =~ /^(17|1D)$/ ) {$arch = 'Penryn'}
7433                         elsif ( $model =~ /^(1A|1E|1F|2E|25|2C|2F)$/ ) {$arch = 'Nehalem'}
7434                         elsif ( $model =~ /^(1C)$/ ) {$arch = 'Bonnell'} # atom Bonnell? 27?
7435                         elsif ( $model =~ /^(27|35)$/ ) {$arch = 'Saltwell'}
7436                         elsif ( $model =~ /^(25|2C|2F)$/ ) {$arch = 'Westmere'}
7437                         elsif ( $model =~ /^(26)$/ ) {$arch = 'Atom Lincroft'}
7438                         elsif ( $model =~ /^(2A|2D)$/ ) {$arch = 'Sandy Bridge'}
7439                         elsif ( $model =~ /^(36)$/ ) {$arch = 'Atom Cedarview'}
7440                         elsif ( $model =~ /^(37|4A|4D|5A)$/ ) {$arch = 'Silvermont'}
7441                         elsif ( $model =~ /^(3A|3E)$/ ) {$arch = 'Ivy Bridge'}
7442                         elsif ( $model =~ /^(3C|3F|45|46)$/ ) {$arch = 'Haswell'}
7443                         elsif ( $model =~ /^(3D|47|4F|56)$/ ) {$arch = 'Broadwell'}
7444                         elsif ( $model =~ /^(4E|55|9E)$/ ) {$arch = 'Skylake'}
7445                         elsif ( $model =~ /^(5E)$/ ) {$arch = 'Skylake-S'}
7446                         elsif ( $model =~ /^(4C|5D)$/ ) {$arch = 'Airmont'}
7447                         elsif ( $model =~ /^(8E|9E)$/ ) {$arch = 'Kaby Lake'}
7448                         elsif ( $model =~ /^(57)$/ ) {$arch = 'Knights Landing'}
7449                         elsif ( $model =~ /^(85)$/ ) {$arch = 'Knights Mill'}
7450                         # product codes: https://en.wikipedia.org/wiki/List_of_Intel_microprocessors
7451                         # coming: coffee lake; cannonlake; icelake; tigerlake
7452                 }
7453                 # itanium 1 family 7 all recalled
7454                 elsif ($family eq 'B'){
7455                         if ( $model =~ /^(1)$/ ) {$arch = 'Knights Corne'}
7456                 }
7457                 elsif ($family eq 'F'){
7458                         if ( $model =~ /^(0|1)$/ ) {$arch = 'Netburst Willamette'}
7459                         elsif ( $model =~ /^(2)$/ ) {$arch = 'Netburst Northwood'}
7460                         elsif ( $model =~ /^(3)$/ ) {$arch = 'Prescott'} # 6? Nocona
7461                         elsif ( $model =~ /^(4)$/ ) {$arch = 'Smithfield'} # 6? Nocona
7462                         elsif ( $model =~ /^(6)$/ ) {$arch = 'Presler'}
7463                         else {$arch = 'Netburst'}
7464                 }
7465         }
7466         eval $end if $b_log;
7467         return $arch;
7468 }
7469
7470 sub count_alpha {
7471         my ($count) = @_;
7472         #print "$count\n";
7473         my @alpha = qw(Single Dual Triple Quad);
7474         if ($count > 4){
7475                 $count .= '-';
7476         }
7477         else {
7478                 $count = $alpha[$count-1] . ' ' if $count > 0;
7479         }
7480         return $count;
7481 }
7482 sub set_cpu_data {
7483         my %cpu =  (
7484         'arch' => '',
7485         'bogomips' => 0,
7486         'cores' => 0,
7487         'cur-freq' => 0,
7488         'dies' => 0,
7489         'family' => '',
7490         'flags' => '',
7491         'ids' => [],
7492         'l1-cache' => 0, # store in KB
7493         'l2-cache' => 0, # store in KB
7494         'l3-cache' => 0, # store in KB
7495         'max-freq' => 0,
7496         'min-freq' => 0,
7497         'model_id' => '',
7498         'model_name' => '',
7499         'processors' => [],
7500         'rev' => '',
7501         'scalings' => [],
7502         'siblings' => 0,
7503         'type' => '',
7504         );
7505         return %cpu;
7506 }
7507 # MHZ - cell cpus
7508 sub speed_cleaner {
7509         my ($speed,$opt) = @_;
7510         return if ! $speed || $speed eq '0';
7511         $speed =~ s/[GMK]HZ$//gi;
7512         $speed = ($speed/1000) if $opt && $opt eq 'khz';
7513         $speed = sprintf "%.0f", $speed;
7514         return $speed;
7515 }
7516 sub cpu_cleaner {
7517         my ($cpu) = @_;
7518         return if ! $cpu;
7519         my $filters = '@|cpu |cpu deca|([0-9]+|single|dual|two|triple|three|tri|quad|four|';
7520         $filters .= 'penta|five|hepta|six|hexa|seven|octa|eight|multi)[ -]core|';
7521         $filters .= 'ennea|genuine|multi|processor|single|triple|[0-9\.]+ *[MmGg][Hh][Zz]';
7522         $cpu =~ s/$filters//ig;
7523         $cpu =~ s/\s\s+/ /g;
7524         $cpu =~ s/^\s+|\s+$//g;
7525         return $cpu;
7526 }
7527 sub hex_and_decimal {
7528         my ($data) = @_;
7529         if ($data){
7530                 $data .=  ' (' . hex($data) . ')' if hex($data) ne $data;
7531         }
7532         else {
7533                 $data = 'N/A';
7534         }
7535         return $data;
7536 }
7537 }
7538
7539 ## DiskData
7540 {
7541 package DiskData;
7542 my ($b_hddtemp,$b_nvme);
7543 my ($hddtemp,$nvme) = ('','');
7544 my (@by_id,@by_path);
7545
7546 sub get {
7547         eval $start if $b_log;
7548         my (@data,@rows,$key1,$val1);
7549         my ($type) = @_;
7550         $type ||= 'standard';
7551         my $num = 0;
7552         @data = disk_data($type);
7553         # NOTE:
7554         if (@data){
7555                 if ($type eq 'standard'){
7556                         @data = create_output(@data);
7557                         @rows = (@rows,@data);
7558                         if ( $bsd_type && !@dm_boot_disk && $type eq 'standard' && $show{'disk'} ){
7559                                 $key1 = 'Drive Report';
7560                                 my $file = main::system_files('dmesg-boot');
7561                                 if ( $file && ! -r $file){
7562                                         $val1 = main::row_defaults('dmesg-boot-permissions');
7563                                 }
7564                                 elsif (!$file){
7565                                         $val1 = main::row_defaults('dmesg-boot-missing');
7566                                 }
7567                                 else {
7568                                         $val1 = main::row_defaults('disk-data-bsd');
7569                                 }
7570                                 @data = ({main::key($num++,$key1) => $val1,});
7571                                 @rows = (@rows,@data);
7572                         }
7573                 }
7574                 else {
7575                         @rows = @data;
7576                         # print Data::Dumper::Dumper \@rows;
7577                 }
7578         }
7579         else {
7580                 $key1 = 'Message';
7581                 $val1 = main::row_defaults('disk-data');
7582                 @rows = ({main::key($num++,$key1) => $val1,});
7583         }
7584         if (!@rows){
7585                 $key1 = 'Message';
7586                 $val1 = main::row_defaults('disk-data');
7587                 @data = ({main::key($num++,$key1) => $val1,});
7588         }
7589         #@rows = (@rows,@data);
7590         @data = ();
7591         if ($show{'optical'} || $show{'optical-basic'}){
7592                 @data = OpticalData::get();
7593                 @rows = (@rows,@data);
7594         }
7595         ($b_hddtemp,$b_nvme,$hddtemp,$nvme) = (undef,undef,undef,undef);
7596         (@by_id,@by_path) = (undef,undef);
7597         eval $end if $b_log;
7598         return @rows;
7599 }
7600 sub create_output {
7601         eval $start if $b_log;
7602         my (@disks) = @_;
7603         #print Data::Dumper::Dumper \@disks;
7604         my (@data,@rows);
7605         my ($num,$j) = (0,0);
7606         my ($id,$model,$size,$used,$percent,$size_holder,$used_holder) = ('','','','','','','');
7607         my @sizing = main::get_size($disks[0]{'size'}) if $disks[0]{'size'};
7608         #print Data::Dumper::Dumper \@disks;
7609         if (@sizing){
7610                 $size = $sizing[0];
7611                 # note: if a string is returned there will be no Size unit so just use string.
7612                 if (defined $sizing[0] && $sizing[1]){
7613                         $size .= ' ' . $sizing[1];
7614                 }
7615         }
7616         $size ||= 'N/A';
7617         @sizing = main::get_size($disks[0]{'used'}) if $disks[0]{'used'};
7618         if (@sizing){
7619                 $used = $sizing[0];
7620                 if (defined $sizing[0] && $sizing[1]){
7621                         $used .= ' ' . $sizing[1];
7622                         if (( $disks[0]{'size'} && $disks[0]{'size'} =~ /^[0-9]/ ) &&
7623                             ( $disks[0]{'used'} =~ /^[0-9]/ ) ){
7624                                 $used = $used . ' (' . sprintf("%0.1f", $disks[0]{'used'}/$disks[0]{'size'}*100) . '%)';
7625                         }
7626                 }
7627         }
7628         $used ||= 'N/A';
7629         @data = ({
7630         main::key($num++,'Local Storage') => '',
7631         main::key($num++,'total') => $size,
7632         main::key($num++,'used') => $used,
7633         });
7634         @rows = (@rows,@data);
7635         shift @disks;
7636         if ( $show{'disk'} && @disks){
7637                 @disks = sort { $a->{'id'} cmp $b->{'id'} } @disks;
7638                 foreach my $ref (@disks){
7639                         ($id,$model,$size) = ('','','');
7640                         my %row = %$ref;
7641                         $num = 1;
7642                         $model = ($row{'model'}) ? $row{'model'}: 'N/A';
7643                         $id =  ($row{'id'}) ? "/dev/$row{'id'}":'N/A';
7644                         my @sizing = main::get_size($row{'size'});
7645                         #print Data::Dumper::Dumper \@disks;
7646                         if (@sizing){
7647                                 $size = $sizing[0];
7648                                 # note: if a string is returned there will be no Size unit so just use string.
7649                                 if (defined $sizing[0] && $sizing[1]){
7650                                         $size .= ' ' . $sizing[1];
7651                                         $size_holder = $sizing[0];
7652                                 }
7653                                 $size ||= 'N/A';
7654                         }
7655                         else {
7656                                 $size = 'N/A';
7657                         }
7658                         $j = scalar @rows;
7659                         @data = ({
7660                         main::key($num++,'ID') => $id,
7661                         });
7662                         @rows = (@rows,@data);
7663                         if ($row{'type'}){
7664                                 $rows[$j]{main::key($num++,'type')} = $row{'type'},
7665                         }
7666                         if ($row{'vendor'}){
7667                                 $rows[$j]{main::key($num++,'vendor')} = $row{'vendor'},
7668                         }
7669                         $rows[$j]{main::key($num++,'model')} = $model;
7670                         $rows[$j]{main::key($num++,'size')} = $size;
7671                         if ($extra > 1 && $row{'speed'}){
7672                                 $rows[$j]{main::key($num++,'speed')} = $row{'speed'};
7673                                 $rows[$j]{main::key($num++,'lanes')} = $row{'lanes'} if $row{'lanes'};
7674                         }
7675                         if ($extra > 2 && $row{'rotation'}){
7676                                 $rows[$j]{main::key($num++,'rotation')} = $row{'rotation'};
7677                         }
7678                         if ($extra > 1){
7679                                 my $serial = main::apply_filter($row{'serial'});
7680                                 $rows[$j]{main::key($num++,'serial')} = $serial;
7681                                 if ($row{'firmware'}){
7682                                         $rows[$j]{main::key($num++,'rev')} = $row{'firmware'};
7683                                 }
7684                         }
7685                         if ($extra > 0 && $row{'temp'}){
7686                                 $rows[$j]{main::key($num++,'temp')} = $row{'temp'} . ' C';
7687                         }
7688                         # extra level tests already done
7689                         if (defined $row{'partition-table'}){
7690                                 $rows[$j]{main::key($num++,'scheme')} = $row{'partition-table'};
7691                         }
7692                 }
7693         }
7694
7695         eval $end if $b_log;
7696         return @rows;
7697 }
7698 sub disk_data {
7699         eval $start if $b_log;
7700         my ($type) = @_;
7701         my (@rows,@data,@devs);
7702         my $num = 0;
7703         my ($used) = (0);
7704         PartitionData::partition_data() if !$b_partitions;
7705         foreach my $ref (@partitions){
7706                 my %row = %$ref;
7707                 # don't count remote used, also, some cases mount
7708                 # panfs is parallel NAS volume manager, need more data
7709                 next if ($row{'fs'} && $row{'fs'} =~ /nfs|panfs|sshfs|smbfs|unionfs/);
7710                 # in some cases, like redhat, mounted cdrom/dvds show up in partition data
7711                 next if ($row{'dev-base'} && $row{'dev-base'} =~ /^sr[0-9]+$/);
7712                 # this is used for specific cases where bind, or incorrect multiple mounts
7713                 # to same partitions, or btrfs sub volume mounts, is present. The value is
7714                 # searched for an earlier appearance of that partition and if it is present,
7715                 # the data is not added into the partition used size.
7716                 if ( $row{'dev-base'} !~ /^\/\/|:\// && ! (grep {/$row{'dev-base'}/} @devs) ){
7717                         $used += $row{'used'} if  $row{'used'};
7718                         push @devs, $row{'dev-base'};
7719                 }
7720         }
7721         if (!$bsd_type && (my $file = main::system_files('partitions'))){
7722                 @data = proc_data($used,$file);
7723         }
7724         elsif ($bsd_type) {
7725                 @data = dmesg_boot_data($used);
7726         }
7727         #print Data::Dumper::Dumper \@data;
7728         main::log_data('data',"used: $used") if $b_log;
7729         eval $end if $b_log;
7730         return @data;
7731 }
7732 sub proc_data {
7733         eval $start if $b_log;
7734         my ($used,$file) = @_;
7735         my (@data,@drives);
7736         my ($b_hdx,$size,$drive_size) = (0,0,0);
7737         my @proc_partitions = main::reader($file,'strip');
7738         shift @proc_partitions;
7739         foreach (@proc_partitions){
7740                 next if (/^\s*$/);
7741                 my @row = split /\s+/, $_;
7742                 if ( $row[-1] =~ /^([hsv]d[a-z]+|(ada|mmcblk|n[b]?d|nvme[0-9]+n)[0-9]+)$/) {
7743                         $drive_size = $row[2];
7744                         $b_hdx = 1 if $row[-1] =~ /^hd[a-z]/;
7745                         @data = ({
7746                         'firmware' => '',
7747                         'id' => $row[-1],
7748                         'model' => '',
7749                         'serial' => '',
7750                         'size' => $drive_size,
7751                         'spec' => '',
7752                         'speed' => '',
7753                         'temp' => '',
7754                         'type' => '',
7755                         'vendor' => '',
7756                         });
7757                         @drives = (@drives,@data);
7758                 }
7759                 # See http://lanana.org/docs/device-list/devices-2.6+.txt for major numbers used below
7760                 # See https://www.mjmwired.net/kernel/Documentation/devices.txt for kernel 4.x device numbers
7761                 # if ( $row[0] =~ /^(3|22|33|8)$/ && $row[1] % 16 == 0 )  {
7762                 #        $size += $row[2];
7763                 # }
7764                 # special case from this data: 8     0  156290904 sda
7765                 # 43        0   48828124 nbd0
7766                 # note: known starters: vm: 252/253/254; grsec: 202; nvme: 259 mmcblk: 179
7767                 if ( $row[0] =~ /^(3|8|22|33|43|179|202|252|253|254|259)$/ &&
7768                      $row[-1] =~ /(mmcblk[0-9]+|n[b]?d[0-9]+|nvme[0-9]+n[0-9]+|[hsv]d[a-z]+)$/ &&
7769                      ( $row[1] % 16 == 0 || $row[1] % 16 == 8 ) ) {
7770                         $size += $row[2];
7771                 }
7772         }
7773         # print Data::Dumper::Dumper \@drives;
7774         main::log_data('data',"size: $size") if $b_log;
7775         @data = ({
7776         'size' => $size,
7777         'used' => $used,
7778         });
7779         #print Data::Dumper::Dumper \@data;
7780         if ( $show{'disk'} ){
7781                 @drives = (@data,@drives);
7782                 # print 'drives:', Data::Dumper::Dumper \@drives;
7783                 @data = proc_data_advanced($b_hdx,@drives);
7784         }
7785         main::log_data('dump','@data',\@data) if $b_log;
7786         # print Data::Dumper::Dumper \@data;
7787         eval $end if $b_log;
7788         return @data;
7789 }
7790 sub proc_data_advanced {
7791         eval $start if $b_log;
7792         my ($b_hdx,@drives) = @_;
7793         my ($i) = (0);
7794         my (@data,@disk_data,@rows,@scsi,@temp,@working);
7795         my ($pt_cmd) = ('unset');
7796         my ($block_type,$file,$firmware,$model,$path,$partition_scheme,
7797         $serial,$vendor,$working_path);
7798         @by_id = main::globber('/dev/disk/by-id/*');
7799         # these do not contain any useful data, no serial or model name
7800         # wwn-0x50014ee25fb50fc1 and nvme-eui.0025385b71b07e2e
7801         # scsi-SATA_ST980815A_ simply repeats ata-ST980815A_; same with scsi-0ATA_WDC_WD5000L31X
7802         # we also don't need the partition items
7803         my $pattern = '^\/dev\/disk\/by-id\/(md-|lvm-|dm-|wwn-|nvme-eui|raid-|scsi-([0-9]ATA|SATA))|-part[0-9]+$';
7804         @by_id = grep {!/$pattern/} @by_id if @by_id;
7805         # print join "\n", @by_id, "\n";
7806         @by_path = main::globber('/dev/disk/by-path/*');
7807         ## check for all ide type drives, non libata, only do it if hdx is in array
7808         ## this is now being updated for new /sys type paths, this may handle that ok too
7809         ## skip the first rows in the loops since that's the basic size/used data
7810         if ($b_hdx){
7811                 for ($i = 1; $i < scalar @drives; $i++){
7812                         $file = "/proc/ide/$drives[$i]{'id'}/model";
7813                         if ( $drives[$i]{'id'} =~ /^hd[a-z]/ && -e $file){
7814                                 $model = (main::reader($file,'strip'))[0];
7815                                 $drives[$i]{'model'} = $model;
7816                         }
7817                 }
7818         }
7819         # scsi stuff
7820         if ($file = main::system_files('scsi')){
7821                 @scsi = scsi_data($file);
7822         }
7823         # print 'drives:', Data::Dumper::Dumper \@drives;
7824         for ($i = 1; $i < scalar @drives; $i++){
7825                 #next if $drives[$i]{'id'} =~ /^hd[a-z]/;
7826                 ($block_type,$firmware,$model,$partition_scheme,
7827                 $serial,$vendor,$working_path) = ('','','','','','','');
7828                 if ($extra > 2){
7829                         @data = advanced_disk_data($pt_cmd,$drives[$i]{'id'});
7830                         $pt_cmd = $data[0];
7831                         $drives[$i]{'partition-table'} = uc($data[1]) if $data[1];
7832                         $drives[$i]{'rotation'} = "$data[2] rpm" if $data[2];
7833                 }
7834                 #print "$drives[$i]{'id'}\n";
7835                 @disk_data = disk_data_by_id("/dev/$drives[$i]{'id'}");
7836                 main::log_data('dump','@disk_data', \@disk_data) if $b_log;
7837                 if ($drives[$i]{'id'} =~ /[sv]d[a-z]/){
7838                         $block_type = 'sdx';
7839                         $working_path = "/sys/block/$drives[$i]{'id'}/device/";
7840                 }
7841                 elsif ($drives[$i]{'id'} =~ /mmcblk/){
7842                         $block_type = 'mmc';
7843                         $working_path = "/sys/block/$drives[$i]{'id'}/device/";
7844                 }
7845                 elsif ($drives[$i]{'id'} =~ /nvme/){
7846                         $block_type = 'nvme';
7847                         # this results in:
7848                         # /sys/devices/pci0000:00/0000:00:03.2/0000:06:00.0/nvme/nvme0/nvme0n1
7849                         # but we want to go one level down so slice off trailing nvme0n1
7850                         $working_path = Cwd::abs_path("/sys/block/$drives[$i]{'id'}");
7851                         $working_path =~ s/nvme[^\/]*$//;
7852                 }
7853                 main::log_data('data',"working path: $working_path") if $b_log;
7854                 if ($block_type && @scsi && @by_id && ! -e "${working_path}model" && ! -e "${working_path}name"){
7855                         ## ok, ok, it's incomprehensible, search /dev/disk/by-id for a line that contains the
7856                         # discovered disk name AND ends with the correct identifier, sdx
7857                         # get rid of whitespace for some drive names and ids, and extra data after - in name
7858                         SCSI:
7859                         foreach my $ref (@scsi){
7860                                 my %row = %$ref;
7861                                 if ($row{'model'}){
7862                                         $row{'model'} = (split /\s*-\s*/,$row{'model'})[0];
7863                                         foreach my $id (@by_id){
7864                                                 if ($id =~ /$row{'model'}/ && "/dev/$drives[$i]{'id'}" eq Cwd::abs_path($id)){
7865                                                         $drives[$i]{'firmware'} = $row{'firmware'};
7866                                                         $drives[$i]{'model'} = $row{'model'};
7867                                                         $drives[$i]{'vendor'} = $row{'vendor'};
7868                                                         last SCSI;
7869                                                 }
7870                                         }
7871                                 }
7872                         }
7873                 }
7874                 # note: an entire class of model names gets truncated by /sys so that should be the last
7875                 # in priority re tests.
7876                 elsif ( (!@disk_data || !$disk_data[0] ) && $block_type){
7877                         # NOTE: while path ${working_path}vendor exists, it contains junk value, like: ATA
7878                         $path = "${working_path}model";
7879                         if ( -e $path){
7880                                 $model = (main::reader($path,'strip'))[0];
7881                                 if ($model){
7882                                         $drives[$i]{'model'} = $model;
7883                                 }
7884                         }
7885                         elsif ($block_type eq 'mmc' && -e "${working_path}name"){
7886                                 $path = "${working_path}name";
7887                                 $model = (main::reader($path,'strip'))[0];
7888                                 if ($model){
7889                                         $drives[$i]{'model'} = $model;
7890                                 }
7891                         }
7892                 }
7893                 if (!$drives[$i]{'model'} && @disk_data){
7894                         $drives[$i]{'model'} = $disk_data[0] if $disk_data[0];
7895                         $drives[$i]{'vendor'} = $disk_data[1] if $disk_data[1];
7896                 }
7897                 # maybe rework logic if find good scsi data example, but for now use this
7898                 elsif ($drives[$i]{'model'} && !$drives[$i]{'vendor'}) {
7899                         $drives[$i]{'model'} = main::disk_cleaner($drives[$i]{'model'});
7900                         my @device_data = device_vendor($drives[$i]{'model'},'');
7901                         $drives[$i]{'model'} = $device_data[1] if $device_data[1];
7902                         $drives[$i]{'vendor'} = $device_data[0] if $device_data[0];
7903                 }
7904                 if ($working_path){
7905                         $path = "${working_path}removable";
7906                         $drives[$i]{'type'} = 'Removable' if -e $path && (main::reader($path,'strip'))[0]; # 0/1 value
7907                 }
7908                 my $peripheral = peripheral_data($drives[$i]{'id'});
7909                 # note: we only want to update type if we found a peripheral, otherwise preserve value
7910                 $drives[$i]{'type'} = $peripheral if $peripheral;
7911                 # print "type:$drives[$i]{'type'}\n";
7912                 if ($extra > 0){
7913                         $drives[$i]{'temp'} = hdd_temp("/dev/$drives[$i]{'id'}");
7914                         if ($extra > 1){
7915                                 my @speed_data = device_speed($drives[$i]{'id'});
7916                                 $drives[$i]{'speed'} = $speed_data[0] if $speed_data[0];
7917                                 $drives[$i]{'lanes'} = $speed_data[1] if $speed_data[1];
7918                                 if (@disk_data && $disk_data[2]){
7919                                         $drives[$i]{'serial'} = $disk_data[2];
7920                                 }
7921                                 else {
7922                                         $path = "${working_path}serial";
7923                                         if ( -e $path){
7924                                                 $serial = (main::reader($path,'strip'))[0];
7925                                                 $drives[$i]{'serial'} = $serial if $serial;
7926                                         }
7927                                 }
7928                                 if ($extra > 2 && !$drives[$i]{'firmware'} ){
7929                                         my @fm = ('rev','fmrev','firmware_rev'); # 0 ~ default; 1 ~ mmc; 2 ~ nvme
7930                                         foreach my $firmware (@fm){
7931                                                 $path = "${working_path}$firmware";
7932                                                 if ( -e $path){
7933                                                         $drives[$i]{'firmware'} = (main::reader($path,'strip'))[0];
7934                                                         last;
7935                                                 }
7936                                         }
7937                                 }
7938                         }
7939                 }
7940         }
7941         # print Data::Dumper::Dumper \@drives;
7942         eval $end if $b_log;
7943         return @drives;
7944 }
7945 # camcontrol identify <device> |grep ^serial (this might be (S)ATA specific)
7946 # smartcl -i <device> |grep ^Serial
7947 # see smartctl; camcontrol devlist; gptid status;
7948 sub dmesg_boot_data {
7949         eval $start if $b_log;
7950         my ($used) = @_;
7951         my (@data,@drives,@temp);
7952         my ($id_holder,$i,$size,$working) = ('',0,0,0);
7953         my $file = main::system_files('dmesg-boot');
7954         if (@dm_boot_disk){
7955                 foreach (@dm_boot_disk){
7956                         my @row = split /:\s*/, $_;
7957                         next if ! defined $row[1];
7958                         if ($id_holder ne $row[0]){
7959                                 $i++ if $id_holder;
7960                                 # print "$i $id_holder $row[0]\n";
7961                                 $id_holder = $row[0];
7962                         }
7963                         # no dots, note: ada2: 2861588MB BUT: ada2: 600.000MB/s
7964                         if (! exists $drives[$i]){
7965                                 $drives[$i] = ({});
7966                                 $drives[$i]{'id'} = $row[0];
7967                                 $drives[$i]{'firmware'} = '';
7968                                 $drives[$i]{'temp'} = '';
7969                                 $drives[$i]{'type'} = '';
7970                                 $drives[$i]{'vendor'} = '';
7971                         }
7972                         #print "$i\n";
7973                         if ($bsd_type eq 'openbsd'){
7974                                 if ($row[1] =~ /,\s*([0-9\.]+[MGTPE][B]?),.*\ssectors$|^</){
7975                                         $working = main::translate_size($1);
7976                                         $size += $working if $working;
7977                                         $drives[$i]{'size'} = $working;
7978                                 }
7979                                 if ($row[2] && $row[2] =~ /<([^>]+)>/){
7980                                         $drives[$i]{'model'} = $1 if $1;
7981                                         $drives[$i]{'type'} = 'removable' if $_ =~ /removable$/;
7982                                         # <Generic-, Compact Flash, 1.00>
7983                                         my $count = ($drives[$i]{'model'} =~ tr/,//);
7984                                         if ($count && $count > 1){
7985                                                 @temp = split /,\s*/, $drives[$i]{'model'};
7986                                                 $drives[$i]{'model'} = $temp[1];
7987                                         }
7988                                 }
7989                                 # print "openbsd\n";
7990                         }
7991                         else {
7992                                 if ($row[1] =~ /^([0-9]+[KMGTPE][B]?)\s/){
7993                                         $working = main::translate_size($1);
7994                                         $size += $working if $working;
7995                                         $drives[$i]{'size'} = $working;
7996                                 }
7997                                 if ($row[1] =~ /device$|^</){
7998                                         $row[1] =~ s/\sdevice$//g;
7999                                         $row[1] =~ /<([^>]*)>\s(.*)/;
8000                                         $drives[$i]{'model'} = $1 if $1;
8001                                         $drives[$i]{'spec'} = $2 if $2;
8002                                 }
8003                                 if ($row[1] =~ /^Serial\sNumber\s(.*)/){
8004                                         $drives[$i]{'serial'} = $1;
8005                                 }
8006                                 if ($row[1] =~ /^([0-9\.]+[MG][B]?\/s)/){
8007                                         $drives[$i]{'speed'} = $1;
8008                                         $drives[$i]{'speed'} =~ s/\.[0-9]+// if $drives[$i]{'speed'};
8009                                 }
8010                         }
8011                         $drives[$i]{'model'} = main::disk_cleaner($drives[$i]{'model'});
8012                         my @device_data = device_vendor($drives[$i]{'model'},'');
8013                         $drives[$i]{'vendor'} = $device_data[0] if $device_data[0];
8014                         $drives[$i]{'model'} = $device_data[1] if $device_data[1];
8015                 }
8016                 if (!$size){
8017                         $size = main::row_defaults('data-bsd');
8018                 }
8019         }
8020         elsif ( $file && ! -r $file ){
8021                 $size = main::row_defaults('dmesg-boot-permissions');
8022         }
8023         elsif (!$file ){
8024                 $size = main::row_defaults('dmesg-boot-missing');
8025         }
8026         @data = ({
8027         'size' => $size,
8028         'used' => $used,
8029         });
8030         #main::log_data('dump','@data',\@data) if $b_log;
8031         if ( $show{'disk'} ){
8032                 @data = (@data,@drives);
8033                 # print 'drives:', Data::Dumper::Dumper \@drives;
8034         }
8035         # print Data::Dumper::Dumper \@data;
8036         eval $end if $b_log;
8037         return @data;
8038 }
8039
8040 # check for usb/firewire/[and thunderwire when data found]
8041 sub peripheral_data {
8042         eval $start if $b_log;
8043         my ($id) = @_;
8044         my ($type) = ('');
8045         # print "$id here\n";
8046         if (@by_id){
8047                 foreach (@by_id) {
8048                         if ("/dev/$id" eq Cwd::abs_path($_)){
8049                                 #print "$id here\n";
8050                                 if (/usb-/i){
8051                                         $type = 'USB';
8052                                 }
8053                                 elsif (/ieee1394--/i){
8054                                         $type = 'FireWire';
8055                                 }
8056                                 last;
8057                         }
8058                 }
8059         }
8060         # note: sometimes with wwn- numbering usb does not appear in by-id but it does in by-path
8061         if (!$type && @by_path){
8062                 foreach (@by_path) {
8063                         if ("/dev/$id" eq Cwd::abs_path($_)){
8064                                 if (/usb-/i){
8065                                         $type = 'USB';
8066                                 }
8067                                 elsif (/ieee1394--/i){
8068                                         $type = 'FireWire';
8069                                 }
8070                                 last;
8071                         }
8072                 }
8073         }
8074         eval $end if $b_log;
8075         return $type;
8076 }
8077 sub advanced_disk_data {
8078         eval $start if $b_log;
8079         my ($set_cmd,$id) = @_;
8080         my ($cmd,$pt,$program,@data,@return);
8081         if ($set_cmd ne 'unset'){
8082                 $return[0] = $set_cmd;
8083         }
8084         else {
8085                 # runs as user, but is SLOW: udisksctl info -b /dev/sda
8086                 # line: org.freedesktop.UDisks2.PartitionTable:
8087                 # Type:               dos
8088                 if ($program = main::check_program('udevadm')){
8089                         $return[0] = "$program info -q property -n ";
8090                 }
8091                 elsif ($b_root && -e "/lib/udev/udisks-part-id") {
8092                         $return[0] = "/lib/udev/udisks-part-id /dev/";
8093                 }
8094                 elsif ($b_root && ($program = main::check_program('fdisk'))) {
8095                         $return[0] = "$program -l /dev/";
8096                 }
8097                 if (!$return[0]) {
8098                         $return[0] = 'na'
8099                 }
8100         }
8101         if ($return[0] ne 'na'){
8102                 $cmd = "$return[0]$id 2>&1";
8103                 main::log_data('cmd',$cmd) if $b_log;
8104                 @data = main::grabber($cmd);
8105                 # for pre ~ 2.30 fdisk did not show gpt, but did show gpt scheme error, so
8106                 # if no gpt match, it's dos = mbr
8107                 if ($cmd =~ /fdisk/){
8108                         foreach (@data){
8109                                 if (/^WARNING:\s+GPT/){
8110                                         $return[1] = 'gpt';
8111                                         last;
8112                                 }
8113                                 elsif (/^Disklabel\stype:\s*(.+)/i){
8114                                         $return[1] = $1;
8115                                         last;
8116                                 }
8117                         }
8118                         $return[1] = 'dos' if !$return[1];
8119                 }
8120                 else {
8121                         foreach (@data){
8122                                 if ( /^(UDISKS_PARTITION_TABLE_SCHEME|ID_PART_TABLE_TYPE)/ ){
8123                                         my @working = split /=/, $_;
8124                                         $return[1] = $working[1];
8125                                 }
8126                                 elsif (/^ID_ATA_ROTATION_RATE_RPM/){
8127                                         my @working = split /=/, $_;
8128                                         $return[2] = $working[1];
8129                                 }
8130                                 last if $return[1] && $return[2];
8131                         }
8132                 }
8133                 $return[1] = 'mbr' if $return[1] && lc($return[1]) eq 'dos';
8134         }
8135         eval $end if $b_log;
8136         return @return;
8137 }
8138 sub scsi_data {
8139         eval $start if $b_log;
8140         my ($file) = @_;
8141         my @temp = main::reader($file);
8142         my (@scsi);
8143         my ($firmware,$model,$vendor) = ('','','');
8144         foreach (@temp){
8145                 if (/Vendor:\s*(.*)\s+Model:\s*(.*)\s+Rev:\s*(.*)/i){
8146                         $vendor = $1;
8147                         $model = $2;
8148                         $firmware = $3;
8149                 }
8150                 if (/Type:/i){
8151                         if (/Type:\s*Direct-Access/i){
8152                                 my @working = ({
8153                                 'vendor' => $vendor,
8154                                 'model' => $model,
8155                                 'firmware' => $firmware,
8156                                 });
8157                                 @scsi = (@scsi,@working);
8158                         }
8159                         else {
8160                                 ($firmware,$model,$vendor) = ('','','');
8161                         }
8162                 }
8163         }
8164         main::log_data('dump','@scsi', \@scsi) if $b_log;
8165         eval $end if $b_log;
8166         return @scsi;
8167 }
8168 # @b_id has already been cleaned of partitions, wwn-, nvme-eui
8169 sub disk_data_by_id {
8170         eval $start if $b_log;
8171         my ($device) = @_;
8172         my ($model,$serial,$vendor) = ('','','');
8173         my (@disk_data);
8174         foreach (@by_id){
8175                 if ($device eq Cwd::abs_path($_)){
8176                         my @data = split /_/, $_;
8177                         my @device_data = ();
8178                         last if scalar @data < 2; # scsi-3600508e000000000876995df43efa500
8179                         $serial = pop @data if @data;
8180                         # usb-PNY_USB_3.0_FD_3715202280-0:0
8181                         $serial =~ s/-[0-9]+:[0-9]+$//;
8182                         $model = join ' ', @data;
8183                         # get rid of the ata-|nvme-|mmc- etc
8184                         $model =~ s/^\/dev\/disk\/by-id\/([^-]+-)?//;
8185                         $model = main::disk_cleaner($model);
8186                         @device_data = device_vendor($model,$serial);
8187                         $vendor = $device_data[0] if $device_data[0];
8188                         $model = $device_data[1] if $device_data[1];
8189                         # print $device, '::', Cwd::abs_path($_),'::', $model, '::', $vendor, '::', $serial, "\n";
8190                         (@disk_data) = ($model,$vendor,$serial);
8191                         last;
8192                 }
8193         }
8194         eval $end if $b_log;
8195         return @disk_data;
8196 }
8197 # receives space separated string that may or may not contain vendor data
8198 sub device_vendor {
8199         eval $start if $b_log;
8200         my ($model,$serial) = @_;
8201         my ($vendor) = ('');
8202         my (@data);
8203         return if !$model;
8204         # 0 - match pattern; 1 - replace pattern; 2 - vendor print; 3 - serial pattern
8205         # Data URLs: inxi-resources.txt Section: DiskData device_vendor()
8206         my @vendors = (
8207         ## These go first because they are the most likely and common ##
8208         ['(Crucial|^CT|-CT|^M4-)','Crucial','Crucial',''],
8209         ['^INTEL','^INTEL','Intel',''],
8210         ['(KINGSTON|DataTraveler|^SMS|^SHS|^SUV)','KINGSTON','Kingston',''], # maybe SHS: SHSS37A SKC SUV
8211         # must come before samsung MU. NOTE: toshiba can have: TOSHIBA_MK6475GSX: mush: MKNSSDCR120GB_
8212         ['(^MKN|Mushkin)','Mushkin','Mushkin',''], # MKNS
8213         # MU = Multiple_Flash_Reader too risky: |M[UZ][^L]
8214         ['(SAMSUNG|^MCG[0-9]+GC)','SAMSUNG','Samsung',''], # maybe ^SM
8215         ['(SanDisk|^SDS[S]?[DQ]|^SL([0-9]+)G|^AFGCE|ULTRA\sFIT|Cruzer)','SanDisk','SanDisk',''],
8216         ['(^ST[^T]|[S]?SEAGATE|^X[AFP]|^BUP|Expansion Desk)','[S]?SEAGATE','Seagate',''], # real, SSEAGATE Backup+; XP1600HE30002
8217         ['^(WD|Western Digital|My (Book|Passport)|00LPCX|Elements)','(^WDC|Western Digital)','Western Digital',''],
8218         ## Then better known ones ##
8219         ['^(A-DATA|ADATA|AXN)','^(A-DATA|ADATA)','A-Data',''],
8220         ['^ADTRON','^(ADTRON)','Adtron',''],
8221         ['^ASUS','^ASUS','ASUS',''],
8222         ['^ATP','^ATP[\s\-]','ATP',''],
8223         ['^Corsair','^Corsair','Corsair',''],
8224         ['^(FUJITSU|MP)','^FUJITSU','Fujitsu',''],
8225         # note: 2012:  wdc bought hgst
8226         ['^(HGST)','^HGST','HGST (Hitachi)',''], # HGST HUA
8227         ['^(Hitachi|HDS|IC|HT|HU)','^Hitachi','Hitachi',''],
8228         ['^Hoodisk','^Hoodisk','Hoodisk',''],
8229         ['^(HP\b)','^HP','HP',''], # vb: VB0250EAVER but clashes with vbox; HP_SSD_S700_120G
8230         ['^(LSD|Lexar)','^Lexar','Lexar',''], # mmc-LEXAR_0xb016546c
8231         # OCZSSD2-2VTXE120G is OCZ-VERTEX2_3.5
8232         ['^(OCZ|APOC|D2|DEN|DEN|DRSAK|EC188|FTNC|GFGC|MANG|MMOC|NIMC|NIMR|PSIR|TALOS2|TMSC|TRSAK)','^OCZ[\s\-]','OCZ',''],
8233         ['^OWC','^OWC[\s\-]','OWC',''],
8234         ['^Philips','^Philips','Philips',''],
8235         ['^PIONEER','^PIONEER','Pioneer',''],
8236         ['^PNY','^PNY\s','PNY','','^PNY'],
8237         # note: get rid of: M[DGK] becasue mushkin starts with MK
8238         # note: seen: KXG50ZNV512G NVMe TOSHIBA 512GB | THNSN51T02DUK NVMe TOSHIBA 1024GB
8239         ['(^[S]?TOS|^THN|TOSHIBA)','[S]?TOSHIBA','Toshiba',''], # scsi-STOSHIBA_STOR.E_EDITION_
8240         ## These go last because they are short and could lead to false ID, or are unlikely ##
8241         ['^Android','^Android','Android',''],
8242         # must come before AP|Apacer
8243         ['^APPLE','^APPLE','Apple',''],
8244         ['^(AP|Apacer)','^Apacer','Apacer',''],
8245         ['^BUFFALO','^BUFFALO','Buffalo',''],
8246         ['^CHN\b','','Zheino',''],
8247         ['^Colorful\b','^Colorful','Colorful',''],
8248         ['^DREVO\b','','Drevo',''],
8249         ['^EXCELSTOR','^EXCELSTOR( TECHNOLOGY)?','Excelstor',''],
8250         ['^FASTDISK','^FASTDISK','FASTDISK',''],
8251         ['^FORESEE','^FORESEE','Foresee',''],
8252         ['^GALAX\b','^GALAX','GALAX',''],
8253         ['^Generic','^Generic','Generic',''],
8254         ['^GOODRAM','^GOODRAM','GOODRAM',''],
8255         # supertalent also has FM: |FM
8256         ['^(G[\.]?SKILL)','^G[\.]?SKILL','G.SKILL',''],
8257         ['^HUAWEI','^HUAWEI','Huawei',''],
8258         ['^(IBM|DT)','^IBM','IBM',''],
8259         ['^Imation','^Imation(\sImation)?','Imation',''], # Imation_ImationFlashDrive
8260         ['^(InnoDisk|Innolite)','^InnoDisk( Corp.)?','InnoDisk',''],
8261         ['^Innostor','^Innostor','Innostor',''],
8262         ['^Intenso','^Intenso','Intenso',''],
8263         ['^KingDian','^KingDian','KingDian',''],
8264         ['^(LITE[\-]?ON[\s\-]?IT)','^LITE[\-]?ON[\s\-]?IT','LITE-ON IT',''], # LITEONIT_LSS-24L6G
8265         ['^(LITE[\-]?ON|PH6)','^LITE[\-]?ON','LITE-ON',''], # PH6-CE240-L
8266         ['^M-Systems','^M-Systems','M-Systems',''],
8267         ['^MAXTOR','^MAXTOR','Maxtor',''],
8268         ['^(MT|M5|Micron)','^Micron','Micron',''],
8269         ['^MARVELL','^MARVELL','Marvell',''],
8270         ['^Medion','^Medion','Medion',''],
8271         ['^Motorola','^Motorola','Motorola',''],
8272         ['^(PS[8F]|Patriot)','^Patriot','Patriot',''],
8273         ['^PIX[\s]?JR','^PIX[\s]?JR','Disney',''],
8274         ['^(PLEXTOR|PX-)','^PLEXTOR','Plextor',''],
8275         ['(^Quantum|Fireball)','^Quantum','Quantum',''],
8276         ['^R3','','AMD Radeon',''], # ssd
8277         ['^RENICE','^RENICE','Renice',''],
8278         ['^RIM[\s]','^RIM','RIM',''],
8279         ['^SigmaTel','^SigmaTel','SigmaTel',''],
8280         ['^SPPC','','Silicon Power',''],
8281         ['^(SK\s?HYNIX|HFS)','^SK\s?HYNIX','SK Hynix',''], # HFS128G39TND-N210A
8282         ['^hynix','hynix','Hynix',''],# nvme middle of string, must be after sk hynix
8283         ['^SH','','Smart Modular Tech.',''],
8284         ['^(SMART( Storage Systems)?|TX)','^(SMART( Storage Systems)?)','Smart Storage Systems',''],
8285         ['^(S[FR]-|Sony)','^Sony','Sony',''],
8286         ['^STE[CK]','^STE[CK]','sTec',''], # wd bought this one
8287         ['^STORFLY','^STORFLY','StorFly',''],
8288         # NOTE: F[MNETU] not reliable, g.skill starts with FM too:
8289         # Seagate ST skips STT.
8290         ['^(STT)','','Super Talent',''],
8291         ['^(SF|Swissbit)','^Swissbit','Swissbit',''],
8292         # ['^(SUPERSPEED)','^SUPERSPEED','SuperSpeed',''], # superspeed is a generic term
8293         ['^TANDBERG','^TANDBERG','Tanberg',''],
8294         ['^TEAC','^TEAC','TEAC',''],
8295         ['^(TS|Transcend|JetFlash)','^Transcend','Transcend',''],
8296         ['^TrekStor','^TrekStor','TrekStor',''],
8297         ['^UDinfo','^UDinfo','UDinfo',''],
8298         ['^(UG|Unigen)','^Unigen','Unigen',''],
8299         ['^VBOX','','VirtualBox',''],
8300         ['^(Verbatim|STORE N GO)','^Verbatim','Verbatim',''],
8301         ['^VISIONTEK','^VISIONTEK','VisionTek',''],
8302         ['^VMware','^VMware','VMware',''],
8303         ['^(Vseky|Vaseky)','^Vaseky','Vaseky',''], # ata-Vseky_V880_350G_
8304         );
8305         foreach my $ref (@vendors){
8306                 my @row = @$ref;
8307                 if ($model =~ /$row[0]/i || ($row[3] && $serial && $serial =~ /$row[3]/)){
8308                         $vendor = $row[2];
8309                         $model =~ s/$row[1]//i if $row[1] && lc($model) ne lc($row[1]);
8310                         $model =~ s/^[\s\-_]+|[\s\-_]+$//g;
8311                         $model =~ s/\s\s/ /g;
8312                         @data = ($vendor,$model);
8313                         last;
8314                 }
8315         }
8316         eval $end if $b_log;
8317         return @data;
8318 }
8319 # Normally hddtemp requires root, but you can set user rights in /etc/sudoers.
8320 # args: $1 - /dev/<disk> to be tested for
8321 sub hdd_temp {
8322         eval $start if $b_log;
8323         my ($device) = @_;
8324         my ($path) = ('');
8325         my (@data,$hdd_temp);
8326         if ($device =~ /nvme/i){
8327                 if (!$b_nvme){
8328                         $b_nvme = 1;
8329                         if ($path = main::check_program('nvme')) {
8330                                 $nvme = $path;
8331                         }
8332                 }
8333                 if ($nvme){
8334                         $device =~ s/n[0-9]//;
8335                         @data = main::grabber("$sudo$nvme smart-log $device 2>/dev/null");
8336                         foreach (@data){
8337                                 my @row = split /\s*:\s*/, $_;
8338                                 # other rows may have: Temperature sensor 1 :
8339                                 if ( $row[0] eq 'temperature') {
8340                                         $row[1] =~ s/\s*C//;
8341                                         $hdd_temp = $row[1];
8342                                         last;
8343                                 }
8344                         }
8345                 }
8346         }
8347         else {
8348                 if (!$b_hddtemp){
8349                         $b_hddtemp = 1;
8350                         if ($path = main::check_program('hddtemp')) {
8351                                 $hddtemp = $path;
8352                         }
8353                 }
8354                 if ($hddtemp){
8355                         $hdd_temp = (main::grabber("$sudo$hddtemp -nq -u C $device 2>/dev/null"))[0];
8356                 }
8357         }
8358         eval $end if $b_log;
8359         return $hdd_temp;
8360 }
8361 sub device_speed {
8362         eval $start if $b_log;
8363         my ($device) = @_;
8364         my ($b_nvme,$lanes,$speed,@data);
8365         my $working = Cwd::abs_path("/sys/class/block/$device");
8366         #print "$working\n";
8367         if ($working){
8368                 my ($id);
8369                 # slice out the ata id:
8370                 # /sys/devices/pci0000:00:11.0/ata1/host0/target0:
8371                 if ($working =~ /^.*\/ata([0-9]+)\/.*/){
8372                         $id = $1;
8373                 }
8374                 # /sys/devices/pci0000:00/0000:00:05.0/virtio1/block/vda
8375                 elsif ($working =~ /^.*\/virtio([0-9]+)\/.*/){
8376                         $id = $1;
8377                 }
8378                 # /sys/devices/pci0000:10/0000:10:01.2/0000:13:00.0/nvme/nvme0/nvme0n1
8379                 elsif ($working =~ /^.*\/(nvme[0-9]+)\/.*/){
8380                         $id = $1;
8381                         $b_nvme = 1;
8382                 }
8383                 # do host last because the strings above might have host as well as their search item
8384                 # 0000:00:1f.2/host3/target3: increment by 1 sine ata starts at 1, but host at 0
8385                 elsif ($working =~ /^.*\/host([0-9]+)\/.*/){
8386                         $id = $1 + 1 if defined $1;
8387                 }
8388                 # print "$working $id\n";
8389                 if (defined $id){
8390                         if ($b_nvme){
8391                                 $working = "/sys/class/nvme/$id/device/max_link_speed";
8392                                 $speed = (main::reader($working))[0] if -f $working;
8393                                 if ($speed =~ /([0-9\.]+)\sGT\/s/){
8394                                         $speed = $1;
8395                                         # pcie1: 2.5 GT/s; pcie2: 5.0 GT/s; pci3: 8 GT/s
8396                                         # NOTE: PCIe 3 stopped using the 8b/10b encoding but a sample pcie3 nvme has
8397                                         # rated speed of GT/s * .8 anyway. GT/s * (128b/130b)
8398                                         $speed = ($speed <= 5 ) ? $speed * .8 : $speed * 128/130;
8399                                         $speed = sprintf("%.1f",$speed) if $speed;
8400                                         $working = "/sys/class/nvme/$id/device/max_link_width";
8401                                         $lanes = (main::reader($working))[0] if -f $working;
8402                                         $lanes = 1 if !$lanes;
8403                                         # https://www.edn.com/electronics-news/4380071/What-does-GT-s-mean-anyway-
8404                                         # https://www.anandtech.com/show/2412/2
8405                                         # http://www.tested.com/tech/457440-theoretical-vs-actual-bandwidth-pci-express-and-thunderbolt/
8406                                         # PCIe 1,2 use “8b/10b” encoding: eight bits are encoded into a 10-bit symbol
8407                                         # PCIe 3,4,5 use "128b/130b" encoding: 128 bits are encoded into a 130 bit symbol
8408                                         $speed = ($speed * $lanes) . " Gb/s";
8409                                 }
8410                         }
8411                         else {
8412                                 $working = "/sys/class/ata_link/link$id/sata_spd";
8413                                 $speed = (main::reader($working))[0] if -f $working;
8414                                 $speed = main::disk_cleaner($speed) if $speed;
8415                                 $speed =~ s/Gbps/Gb\/s/ if $speed;
8416                         }
8417                 }
8418         }
8419         @data = ($speed,$lanes);
8420         #print "$working $speed\n";
8421         eval $end if $b_log;
8422         return @data;
8423 }
8424 # gptid/c5e940f1-5ce2-11e6-9eeb-d05099ac4dc2     N/A  ada0p1
8425 sub match_glabel {
8426         eval $start if $b_log;
8427         my ($gptid) = @_;
8428         return if !@glabel || ! $gptid;
8429         #$gptid =~ s/s[0-9]+$//;
8430         my ($dev_id) = ('');
8431         foreach (@glabel){
8432                 my @temp = split /\s+/, $_;
8433                 my $gptid_trimmed = $gptid;
8434                 # slice off s[0-9] from end in case they use slice syntax
8435                 $gptid_trimmed =~ s/s[0-9]+$//;
8436                 if (defined $temp[0] && ($temp[0] eq $gptid || $temp[0] eq $gptid_trimmed ) ){
8437                         $dev_id = $temp[2];
8438                         last;
8439                 }
8440         }
8441         $dev_id ||= $gptid; # no match? return full string
8442         eval $end if $b_log;
8443         return $dev_id;
8444 }
8445 sub set_glabel {
8446         eval $start if $b_log;
8447         $b_glabel = 1;
8448         if (my $path = main::check_program('glabel')){
8449                 @glabel = main::grabber("$path status 2>/dev/null");
8450         }
8451         main::log_data('dump','@glabel:with Headers',\@glabel) if $b_log;
8452         # get rid of first header line
8453         shift @glabel;
8454         eval $end if $b_log;
8455 }
8456 }
8457
8458 ## GraphicData
8459 {
8460 package GraphicData;
8461 my $driver = ''; # we need this as a fallback in case no xorg.0.log
8462 sub get {
8463         eval $start if $b_log;
8464         my (@data,@rows);
8465         my $num = 0;
8466         if (($b_arm || $b_mips) && !$b_soc_gfx && !$b_pci_tool){
8467                 my $key = ($b_arm) ? 'ARM' : 'MIPS';
8468                 @data = ({
8469                 main::key($num++,$key) => main::row_defaults(lc($key) . '-pci',''),
8470                 },);
8471                 @rows = (@rows,@data);
8472         }
8473         else {
8474                 @data = card_data();
8475                 @rows = (@rows,@data);
8476                 if (!@rows){
8477                         my $key = 'Message';
8478                         @data = ({
8479                         main::key($num++,$key) => main::row_defaults('pci-card-data',''),
8480                         },);
8481                         @rows = (@rows,@data);
8482                 }
8483         }
8484         @data = display_data();
8485         @rows = (@rows,@data);
8486         @data = gl_data();
8487         @rows = (@rows,@data);
8488         eval $end if $b_log;
8489         return @rows;
8490 }
8491 # 0 type
8492 # 1 type_id
8493 # 2 bus_id
8494 # 3 sub_id
8495 # 4 device
8496 # 5 vendor_id
8497 # 6 chip_id
8498 # 7 rev
8499 # 8 port
8500 # 9 driver
8501 # 10 modules
8502 # not using 3D controller yet, needs research: |3D controller |display controller
8503 # note: this is strange, but all of these can be either a separate or the same
8504 # card. However, by comparing bus id, say: 00:02.0 we can determine that the
8505 # cards are  either the same or different. We want only the .0 version as a valid
8506 # card. .1 would be for example: Display Adapter with bus id x:xx.1, not the right one
8507 sub card_data {
8508         eval $start if $b_log;
8509         my (@rows,@data);
8510         my ($j,$num) = (0,1);
8511         foreach (@pci){
8512                 $num = 1;
8513                 my @row = @$_;
8514                 #print "$row[0] $row[3]\n";
8515                 if ($row[3] == 0 && ( $row[0] =~ /^(vga|disp|display|3d|fb|gpu|hdmi)$/ ) ){
8516                         #print "$row[0] $row[3]\n";
8517                         $j = scalar @rows;
8518                         $driver = $row[9];
8519                         $driver ||= 'N/A';
8520                         my $card = main::trimmer($row[4]);
8521                         $card = ($card) ? main::pci_cleaner($card,'output') : 'N/A';
8522                         #$card ||= 'N/A';
8523                         # have seen absurdly verbose card descriptions, with non related data etc
8524                         if (length($card) > 85 || $size{'max'} < 110){
8525                                 $card = main::pci_long_filter($card);
8526                         }
8527                         @data = ({
8528                         main::key($num++,'Card') => $card,
8529                         },);
8530                         @rows = (@rows,@data);
8531                         if ($extra > 2 && $b_pci_tool && $row[11]){
8532                                 my $item = main::get_pci_vendor($row[4],$row[11]);
8533                                 $rows[$j]{main::key($num++,'vendor')} = $item if $item;
8534                         }
8535                         $rows[$j]{main::key($num++,'driver')} = $driver;
8536                         if ($row[9] && !$bsd_type){
8537                                 my $version = main::get_module_version($row[9]);
8538                                 $version ||= 'N/A';
8539                                 $rows[$j]{main::key($num++,'v')} = $version;
8540                         }
8541                         if ($extra > 0){
8542                                 $rows[$j]{main::key($num++,'bus ID')} = (!$row[2] && !$row[3]) ? 'N/A' : "$row[2].$row[3]";
8543                         }
8544                         if ($extra > 1){
8545                                 $rows[$j]{main::key($num++,'chip ID')} = ($row[5]) ? "$row[5]:$row[6]" : $row[6];
8546                         }
8547                 }
8548                 #print "$row[0]\n";
8549         }
8550         #my $ref = $pci[-1];
8551         #print $$ref[0],"\n";
8552         eval $end if $b_log;
8553         return @rows;
8554 }
8555 sub display_data(){
8556         eval $start if $b_log;
8557         my (%graphics,@row);
8558         my @xdpyinfo;
8559         my $num = 0;
8560         my ($protocol,$server) = ('','');
8561         # note: these may not always be set, they won't be out of X, for example
8562         $protocol = $ENV{'XDG_SESSION_TYPE'} if $ENV{'XDG_SESSION_TYPE'};
8563         $protocol = $ENV{'WAYLAND_DISPLAY'} if (!$protocol && $ENV{'WAYLAND_DISPLAY'});
8564         # need to confirm that there's a point to this test, I believe no, fails out of x
8565         # loginctl also results in the session id
8566         if (!$protocol && $b_display && $b_force_display){
8567                 if (my $program = main::check_program('loginctl')){
8568                         my $id = '';
8569                         # $id = $ENV{'XDG_SESSION_ID'}; # returns tty session in console
8570                         my @data = main::grabber("$program --no-pager --no-legend 2>/dev/null",'','strip');
8571                         foreach (@data){
8572                                 next if /tty[v]?[0-6]$/; # freebsd: ttyv3
8573                                 $id = (split /\s+/, $_)[0];
8574                                 last; # multiuser? too bad, we'll go for the first one
8575                         }
8576                         if ($id ){
8577                                 my $temp = (main::grabber("$program show-session $id -p Type --no-pager --no-legend 2>/dev/null"))[0];
8578                                 $temp =~ s/Type=// if $temp;
8579                                 # ssh will not show /dev/ttyx so would have passed the first test
8580                                 $protocol = $temp if $temp && $temp ne 'tty';
8581                         }
8582                 }
8583         }
8584         if ($extra > 1){
8585                 # initial tests, if wayland, it is certainly a compositor
8586                 $protocol = lc($protocol) if $protocol;
8587                 $graphics{'compositor'} = display_compositor($protocol);
8588         }
8589         if ( $b_display){
8590                 # X vendor and version detection.
8591                 # new method added since radeon and X.org and the disappearance of
8592                 # <X server name> version : ...etc. Later on, the normal textual version string
8593                 # returned, e.g. like: X.Org version: 6.8.2
8594                 # A failover mechanism is in place: if $version empty, release number parsed instead
8595                 if (my $program = main::check_program('xdpyinfo')){
8596                         my @xdpyinfo = main::grabber("$program $display_opt 2>/dev/null","\n",'strip');
8597                         #@xdpyinfo = map {s/^\s+//;$_} @xdpyinfo if @xdpyinfo;
8598                         #print join "\n",@xdpyinfo, "\n";
8599                         foreach (@xdpyinfo){
8600                                 my @working = split /:\s+/, $_;
8601                                 next if ( ($graphics{'dimensions'} && $working[0] ne 'dimensions' ) || !$working[0] );
8602                                 #print "$_\n";
8603                                 if ($working[0] eq 'vendor string'){
8604                                         $working[1] =~ s/The\s|\sFoundation//g;
8605                                         # some distros, like fedora, report themselves as the xorg vendor,
8606                                         # so quick check here to make sure the vendor string includes Xorg in string
8607                                         if ($working[1] !~ /x/i){
8608                                                 $working[1] .= ' X.org';
8609                                         }
8610                                         $graphics{'vendor'} = $working[1];
8611                                 }
8612                                 elsif ($working[0] eq 'version number'){
8613                                         $graphics{'version-id'} = $working[1];
8614                                 }
8615                                 elsif ($working[0] eq 'vendor release number'){
8616                                         $graphics{'vendor-release'} = $working[1];
8617                                 }
8618                                 elsif ($working[0] eq 'X.Org version'){
8619                                         $graphics{'xorg-version'} = $working[1];
8620                                 }
8621                                 elsif ($working[0] eq 'dimensions'){
8622                                         $working[1] =~ s/\spixels//;
8623                                         $working[1] =~ s/\smillimeters/ mm/;
8624                                         if ($graphics{'dimensions'}){
8625                                                 $graphics{'dimensions'} = ([@{$graphics{'dimensions'}},$working[1]]);
8626                                         }
8627                                         else {
8628                                                 $graphics{'dimensions'} = ([$working[1]]);
8629                                         }
8630                                 }
8631                         }
8632                         #$graphics{'dimensions'} = (\@dimensions);
8633                         # we get a bit more info from xrandr than xdpyinfo, but xrandr fails to handle
8634                         # multiple screens from different video cards
8635                         my $ref = $graphics{'dimensions'};
8636                         if (defined $ref){
8637                                 my @screens = @$ref;
8638                                 if (scalar @screens == 1){
8639                                         if (my $program = main::check_program('xrandr')){
8640                                                 my @xrandr = main::grabber("$program $display_opt 2>/dev/null",'','strip');
8641                                                 foreach (@xrandr){
8642                                                         my @working = split /\s+/,$_;
8643                                                         # print join "$_\n";
8644                                                         if ($working[1] =~ /\*/){
8645                                                                 $working[1] =~ s/\*|\+//g;
8646                                                                 $working[1] = sprintf("%.0f",$working[1]);
8647                                                                 $working[1] =  ($working[1]) ? "$working[1]Hz" : 'N/A';
8648                                                                 my $screen = "$working[0]~$working[1]";
8649                                                                 if ($graphics{'screens'}){
8650                                                                         $graphics{'screens'} = ([@{$graphics{'screens'}},$screen]);
8651                                                                 }
8652                                                                 else {
8653                                                                         $graphics{'screens'} = ([$screen]);
8654                                                                 }
8655                                                         }
8656                                                 }
8657                                         }
8658                                 }
8659                         }
8660                         else {
8661                                 $graphics{'tty'} = tty_data();
8662                         }
8663                 }
8664                 else {
8665                         $graphics{'screens'} = ([main::row_defaults('xdpyinfo-missing')]);
8666                 }
8667         }
8668         else {
8669                 $graphics{'tty'} = tty_data();
8670         }
8671         # this gives better output than the failure last case, which would only show:
8672         # for example: X.org: 1.9 instead of: X.org: 1.9.0
8673         $graphics{'version'} = $graphics{'xorg-version'} if $graphics{'xorg-version'};;
8674         $graphics{'version'} = x_version() if !$graphics{'version'};
8675         $graphics{'version'} = $graphics{'version-id'} if !$graphics{'version'};
8676
8677         undef @xdpyinfo;
8678         #print Data::Dumper::Dumper \%graphics;
8679         if (%graphics){
8680                 my $resolution = '';
8681                 my $server_string = '';
8682                 if ($graphics{'vendor'}){
8683                         my $version = ($graphics{'version'}) ? " $graphics{'version'}" : '';
8684                         $server_string = "$graphics{'vendor'}$version";
8685                 }
8686                 elsif ($graphics{'version'}) {
8687                         $server_string = "X.org $graphics{'version'}";
8688                 }
8689                 if ($graphics{'screens'}){
8690                         my $ref = $graphics{'screens'};
8691                         my @screens = @$ref;
8692                         my $sep = '';
8693                         foreach (@screens){
8694                                 $resolution .= $sep . $_;
8695                                 $sep = ', ';
8696                         }
8697                 }
8698                 my @drivers = x_drivers();
8699                 if (!$protocol && !$server_string && !$graphics{'vendor'} && !@drivers){
8700                         $server_string = main::row_defaults('display-server');
8701                         @row = ({
8702                         main::key($num++,'Display') => '',
8703                         main::key($num++,'server') => $server_string,
8704                         });
8705                 }
8706                 else {
8707                         $server_string ||= 'N/A';
8708                         # note: if no xorg log, and if wayland, there will be no xorg drivers,
8709                         # obviously, so we use the last driver found on the card section in that case.
8710                         # those come from lscpi kernel drivers so there should be no xorg/wayland issues.
8711                         $driver = ($drivers[0]) ? $drivers[0]: $driver;
8712                         @row = ({
8713                         main::key($num++,'Display') => $protocol,
8714                         main::key($num++,'server') => $server_string,
8715                         main::key($num++,'driver') => $driver,
8716                         });
8717                         if ($drivers[2]){
8718                                 $row[0]{main::key($num++,'FAILED')} = $drivers[2];
8719                         }
8720                         if ($drivers[1]){
8721                                 $row[0]{main::key($num++,'unloaded')} = $drivers[1];
8722                         }
8723                         if ($extra > 1 && $drivers[3]){
8724                                 $row[0]{main::key($num++,'alternate')} = $drivers[3];
8725                         }
8726                         if ($graphics{'compositor'}){
8727                                 $row[0]{main::key($num++,'compositor')} = $graphics{'compositor'};
8728                         }
8729                 }
8730                 if ($resolution){
8731                         $row[0]{main::key($num++,'resolution')} = $resolution;
8732                 }
8733                 else {
8734                         $graphics{'tty'} ||= 'N/A';
8735                         $row[0]{main::key($num++,'tty')} = $graphics{'tty'};
8736                 }
8737         }
8738         eval $end if $b_log;
8739         return @row;
8740 }
8741 sub gl_data(){
8742         eval $start if $b_log;
8743         my $num = 0;
8744         my (@row,$arg);
8745         #print ("$b_display : $b_root\n");
8746         if ( $b_display){
8747                 if (my $program = main::check_program('glxinfo')){
8748                         # NOTE: glxinfo -B is not always available, unforunately
8749                         my @glxinfo = main::grabber("$program $display_opt 2>/dev/null");
8750                         if (!@glxinfo){
8751                                 my $type = 'display-console';
8752                                 if ($b_root){
8753                                         $type = 'display-root-x';
8754                                 }
8755                                 else {
8756                                         $type = 'display-null';
8757                                 }
8758                                 @row = ({
8759                                 main::key($num++,'Message') => main::row_defaults($type),
8760                                 });
8761                                 return @row;
8762                         }
8763                         #print join "\n",@glxinfo,"\n";
8764                         my $compat_version = '';
8765                         my ($b_compat,@core_profile_version,@direct_render,@renderer,@opengl_version,@working);
8766                         foreach (@glxinfo){
8767                                 next if /^\s/;
8768                                 if (/^opengl renderer/i){
8769                                         @working = split /:\s*/, $_;
8770                                         $working[1] = main::cleaner($working[1]);
8771                                         # Allow all mesas
8772                                         #if ($working[1] =~ /mesa/i){
8773                                         #
8774                                         #}
8775                                         push @renderer, $working[1];
8776                                 }
8777                                 # dropping all conditions from this test to just show full mesa information
8778                                 # there is a user case where not f and mesa apply, atom mobo
8779                                 # /opengl version/ && ( f || $2 !~ /mesa/ ) {
8780                                 elsif (/^opengl version/i){
8781                                         # fglrx started appearing with this extra string, does not appear
8782                                         # to communicate anything of value
8783                                         @working = split /:\s*/, $_;
8784                                         $working[1] =~ s/(Compatibility Profile Context|\(Compatibility Profile\))//;
8785                                         $working[1] =~ s/\s\s/ /g;
8786                                         $working[1] =~ s/^\s+|\s+$//;
8787                                         push @opengl_version, $working[1];
8788                                         # note: this is going to be off if ever multi opengl versions appear, never seen one
8789                                         @working = split /\s+/, $working[1];
8790                                         $compat_version = $working[0];
8791                                 }
8792                                 elsif (/^opengl core profile version/i){
8793                                         # fglrx started appearing with this extra string, does not appear
8794                                         # to communicate anything of value
8795                                         @working = split /:\s*/, $_;
8796                                         $working[1] =~ s/(Compatibility Profile Context|\((Compatibility|Core) Profile\))//;
8797                                         $working[1] =~ s/\s\s/ /g;
8798                                         $working[1] =~ s/^\s+|\s+$//;
8799                                         push @core_profile_version, $working[1];
8800                                 }
8801                                 elsif (/direct rendering/){
8802                                         @working = split /:\s*/, $_;
8803                                         push @direct_render, $working[1];
8804                                 }
8805                                 # if -B was always available, we could skip this, but it is not
8806                                 elsif (/GLX Visuals/){
8807                                         last;
8808                                 }
8809                         }
8810                         my ($direct_render,$renderer,$version) = ('N/A','N/A','N/A');
8811                         $direct_render = join ', ',  @direct_render if @direct_render;
8812                         # non free drivers once filtered and cleaned show the same for core and compat
8813                         # but this stopped for some reason at 4.5/4.6 nvidia
8814                         if (@core_profile_version && @opengl_version &&
8815                           join ('', @core_profile_version) ne join( '', @opengl_version) &&
8816                           !(grep {/nvidia/i} @opengl_version ) ){
8817                                 @opengl_version = @core_profile_version;
8818                                 $b_compat = 1;
8819                         }
8820                         $version = join ', ', @opengl_version if @opengl_version;
8821                         $renderer = join ', ', @renderer if @renderer;
8822                         @row = ({
8823                         main::key($num++,'OpenGL') => '',
8824                         main::key($num++,'renderer') => $renderer,
8825                         main::key($num++,'v') => $version,
8826                         });
8827
8828                         if ($b_compat && $extra > 1 && $compat_version){
8829                                 $row[0]{main::key($num++,'compat-v')} = $compat_version;
8830                         }
8831                         if ($extra > 0){
8832                                 $row[0]{main::key($num++,'direct render')} = $direct_render;
8833                         }
8834                 }
8835                 else {
8836                         @row = ({
8837                         main::key($num++,'Message') => main::row_defaults('glxinfo-missing'),
8838                         });
8839                 }
8840         }
8841         else {
8842                 my $type = 'display-console';
8843                 if (!main::check_program('glxinfo')){
8844                         $type = 'glxinfo-missing';
8845                 }
8846                 else {
8847                         if ($b_root){
8848                                 $type = 'display-root';
8849                         }
8850                         else {
8851                                 $type = 'display-try';
8852                         }
8853                 }
8854                 @row = ({
8855                 main::key($num++,'Message') => main::row_defaults($type),
8856                 });
8857         }
8858         eval $end if $b_log;
8859         return @row;
8860 }
8861 sub tty_data(){
8862         eval $start if $b_log;
8863         my ($tty);
8864         if ($size{'term-cols'}){
8865                 $tty = "$size{'term-cols'}x$size{'term-lines'}";
8866         }
8867         elsif ($b_irc && $client{'console-irc'}){
8868                 my $tty_working = main::get_tty_console_irc('tty');
8869                 if (my $program = main::check_program('stty')){
8870                         my $tty_arg = ($bsd_type) ? '-f' : '-F';
8871                         $tty = (main::grabber("$program $tty_arg /dev/pts/$tty_working size 2>/dev/null"))[0];
8872                         if ($tty){
8873                                 my @temp = split /\s+/, $tty;
8874                                 $tty = "$temp[1]x$temp[0]";
8875                         }
8876                 }
8877         }
8878         eval $end if $b_log;
8879         return $tty;
8880 }
8881 sub x_drivers {
8882         eval $start if $b_log;
8883         my ($driver,@driver_data,,%drivers);
8884         my ($alternate,$failed,$loaded,$sep,$unloaded) = ('','','','','');
8885         if (my $log = main::system_files('xorg-log')){
8886                 # $log = "$ENV{HOME}/bin/scripts/inxi/data/xorg-logs/Xorg.0-voyager-serena.log";
8887                 # $log = "$ENV{HOME}/bin/scripts/inxi/data/xorg-logs/loading-unload-failed-all41-mint.txt";
8888                 # $log = "$ENV{HOME}/bin/scripts/inxi/data/xorg-logs/loading-unload-failed-phd21-mint.txt";
8889                 # $log = "$ENV{HOME}/bin/scripts/inxi/data/xorg-logs/Xorg.0-gm10.log";
8890                 my @xorg = main::reader($log);
8891                 # list is from sgfxi plus non-free drivers, plus ARM drivers
8892                 my $list = 'amdgpu|apm|ark|armsoc|ati|chips|cirrus|cyrix|fbdev|fbturbo|fglrx|glint|';
8893                 $list .= 'i128|i740|i810|iftv|imstt|intel|ivtv|mach64|mesa|mga|modesetting|';
8894                 $list .= 'neomagic|newport|nouveau|nsc|nvidia|nv|openchrome|radeonhd|radeon|';
8895                 $list .= 'rendition|s3virge|s3|savage|siliconmotion|sisimedia|sisusb|sis|tdfx|';
8896                 $list .= 'tga|trident|tseng|unichrome|v4l|vboxvideo|vesa|vga|via|vmware|voodoo';
8897                 # it's much cheaper to grab the simple pattern match then do the expensive one
8898                 # in the main loop.
8899                 #@xorg = grep {/Failed|Unload|Loading/} @xorg;
8900                 foreach (@xorg){
8901                         next if !/Failed|Unload|Loading/;
8902                         # print "$_\n";
8903                         # note that in file names, driver is always lower case
8904                         if (/\sLoading.*($list)_drv.so$/i ) {
8905                                 $driver=lc($1);
8906                                 # we get all the actually loaded drivers first, we will use this to compare the
8907                                 # failed/unloaded, which have not always actually been truly loaded
8908                                 $drivers{$driver}='loaded';
8909                         }
8910                         # openbsd uses UnloadModule:
8911                         elsif (/(Unloading\s|UnloadModule).*\"?($list)(_drv.so)?\"?$/i ) {
8912                                 $driver=lc($2);
8913                                 # we get all the actually loaded drivers first, we will use this to compare the
8914                                 # failed/unloaded, which have not always actually been truly loaded
8915                                 if (exists $drivers{$driver} && $drivers{$driver} ne 'alternate'){
8916                                         $drivers{$driver}='unloaded';
8917                                 }
8918                         }
8919                         # verify that the driver actually started the desktop, even with false failed messages
8920                         # which can occur. This is the driver that is actually driving the display.
8921                         # note that xorg will often load several modules, like modesetting,fbdev,nouveau
8922                         # NOTE:
8923                         #(II) UnloadModule: "nouveau"
8924                         #(II) Unloading nouveau
8925                         #(II) Failed to load module "nouveau" (already loaded, 0)
8926                         #(II) LoadModule: "modesetting"
8927                         elsif (/Failed.*($list)\"?.*$/i ) {
8928                                 # Set driver to lower case because sometimes it will show as
8929                                 # RADEON or NVIDIA in the actual x start
8930                                 $driver=lc($1);
8931                                 # we need to make sure that the driver has already been truly loaded,
8932                                 # not just discussed
8933                                 if (exists $drivers{$driver} && $drivers{$driver} ne 'alternate'){
8934                                         if ( $_ !~ /\(already loaded/){
8935                                                 $drivers{$driver}='failed';
8936                                         }
8937                                         # reset the previous line's 'unloaded' to 'loaded' as well
8938                                         else {
8939                                                 $drivers{$driver}='loaded';
8940                                         }
8941                                 }
8942                                 elsif ($_ =~ /module does not exist/){
8943                                         $drivers{$driver}='alternate';
8944                                 }
8945                         }
8946                 }
8947                 my $sep = '';
8948                 foreach (sort keys %drivers){
8949                         if ($drivers{$_} eq 'loaded') {
8950                                 $sep = ($loaded) ? ',' : '';
8951                                 $loaded .= $sep . $_;
8952                         }
8953                         elsif ($drivers{$_} eq 'unloaded') {
8954                                 $sep = ($unloaded) ? ',' : '';
8955                                 $unloaded .= $sep . $_;
8956                         }
8957                         elsif ($drivers{$_} eq 'failed') {
8958                                 $sep = ($failed) ? ',' : '';
8959                                 $failed .= $sep . $_;
8960                         }
8961                         elsif ($drivers{$_} eq 'alternate') {
8962                                 $sep = ($alternate) ? ',' : '';
8963                                 $alternate .= $sep . $_;
8964                         }
8965                 }
8966                 $loaded ||= 'none';
8967                 @driver_data = ($loaded,$unloaded,$failed,$alternate);
8968         }
8969         eval $end if $b_log;
8970         return @driver_data;
8971 }
8972 sub x_version {
8973         eval $start if $b_log;
8974         my ($version,@data,$program);
8975         # IMPORTANT: both commands send version data to stderr!
8976         if ($program = main::check_program('Xorg')){
8977                 @data = main::grabber("$program -version 2>&1");
8978         }
8979         elsif ($program = main::check_program('X')){
8980                 @data = main::grabber("$program -version 2>&1");
8981         }
8982         #print Data::Dumper::Dumper \@data;
8983         if (@data){
8984                 foreach (@data){
8985                         if (/^X.org X server/i){
8986                                 my @working = split /\s+/, $_;
8987                                 $version = $working[3];
8988                                 last;
8989                         }
8990                         elsif (/^X Window System Version/i) {
8991                                 my @working = split /\s+/, $_;
8992                                 $version = $working[4];
8993                                 last;
8994                         }
8995                 }
8996         }
8997         eval $end if $b_log;
8998         return $version;
8999 }
9000 # $1 - protocol: wayland|x11
9001 sub display_compositor {
9002         eval $start if $b_log;
9003         my ($protocol) = @_;
9004         my ($compositor) = ('');
9005         main::set_ps_gui() if ! $b_ps_gui;
9006         if (@ps_gui){
9007                 # 1 check program; 2 search; 3 unused version; 4 print
9008                 my @compositors = (
9009                 ['budgie-wm','budgie-wm','','budgie-wm'],
9010                 ['compton','compton','','compton'],
9011                 ['enlightenment','enlightenment','','enlightenment'],
9012                 ['gnome-shell','gnome-shell','','gnome-shell'],
9013                 ['kwin_wayland','kwin_wayland','','kwin wayland'],
9014                 ['kwin_x11','kwin_x11','','kwin x11'],
9015                 #['kwin','kwin','','kwin'],
9016                 ['marco','marco','','marco'],
9017                 ['muffin','muffin','','muffin'],
9018                 ['mutter','mutter','','mutter'],
9019                 ['weston','weston','','weston'],
9020                 # owned by: compiz-core in debian
9021                 ['compiz','compiz','','compiz'],
9022                 # did not find follwing in debian apt
9023                 ['3dwm','3dwm','','3dwm'],
9024                 ['dwc','dwc','','dwc'],
9025                 ['grefson','grefson','','grefson'],
9026                 ['ireplace','ireplace','','ireplace'],
9027                 ['kmscon','kmscon','','kmscon'],
9028                 ['metisse','metisse','','metisse'],
9029                 ['mir','mir','','mir'],
9030                 ['moblin','moblin','','moblin'],
9031                 ['rustland','rustland','','rustland'],
9032                 ['sway','sway','','sway'],
9033                 ['swc','swc','','swc'],
9034                 ['unagi','unagi','','unagi'],
9035                 ['wayhouse','wayhouse','','wayhouse'],
9036                 ['westford','westford','','westford'],
9037                 ['xcompmgr','xcompmgr','','xcompmgr'],
9038                 );
9039                 foreach my $ref (@compositors){
9040                         my @item = @$ref;
9041                         # no need to use check program with short list of ps_gui
9042                         # if (main::check_program($item[0]) && (grep {/^$item[1]$/} @ps_gui ) ){
9043                         if (grep {/^$item[1]$/} @ps_gui){
9044                                 $compositor = $item[3];
9045                                 last;
9046                         }
9047                 }
9048         }
9049         main::log_data('data',"compositor: $compositor") if $b_log;
9050         eval $end if $b_log;
9051         return $compositor;
9052 }
9053 }
9054
9055 ## MachineData
9056 {
9057 package MachineData;
9058
9059 sub get {
9060         eval $start if $b_log;
9061         my (%soc_machine,@data,@rows,$key1,$val1,$which);
9062         my $num = 0;
9063         if ($bsd_type && @sysctl_machine && !$b_dmidecode_force ){
9064                 @data = machine_data_sysctl();
9065                 if (!@data && !$key1){
9066                         $key1 = 'Message';
9067                         $val1 = main::row_defaults('machine-data-force-dmidecode','');
9068                 }
9069         }
9070         elsif ($bsd_type || $b_dmidecode_force){
9071                 my $ref = $alerts{'dmidecode'};
9072                 if ( $$ref{'action'} ne 'use'){
9073                         $key1 = $$ref{'action'};
9074                         $val1 = $$ref{$key1};
9075                         $key1 = ucfirst($key1);
9076                 }
9077                 else {
9078                         @data = machine_data_dmi();
9079                         if (!@data && !$key1){
9080                                 $key1 = 'Message';
9081                                 $val1 = main::row_defaults('machine-data','');
9082                         }
9083                 }
9084         }
9085         elsif (-d '/sys/class/dmi/id/') {
9086                 @data = machine_data_sys();
9087                 if (!@data){
9088                         $key1 = 'Message';
9089                         $val1 = main::row_defaults('machine-data-dmidecode','');
9090                 }
9091         }
9092         elsif (!$bsd_type) {
9093                 # this uses /proc/cpuinfo so only GNU/Linux
9094                 if ($b_arm || $b_mips){
9095                         %soc_machine = machine_data_soc();
9096                         @data = create_output_soc(%soc_machine) if %soc_machine;
9097                 }
9098                 if (!@data){
9099                         $key1 = 'Message';
9100                         $val1 = main::row_defaults('machine-data-force-dmidecode','');
9101                 }
9102         }
9103         # if error case, null data, whatever
9104         if ($key1) {
9105                 @data = ({main::key($num++,$key1) => $val1,});
9106         }
9107         eval $end if $b_log;
9108         return @data;
9109 }
9110 ## keys for machine data are:
9111 # 0-sys_vendor 1-product_name 2-product_version 3-product_serial 4-product_uuid
9112 # 5-board_vendor 6-board_name 7-board_version 8-board_serial
9113 # 9-bios_vendor 10-bios_version 11-bios_date
9114 ## with extra data:
9115 # 12-chassis_vendor 13-chassis_type 14-chassis_version 15-chassis_serial
9116 ## unused: 16-bios_rev  17-bios_romsize 18 - firmware type
9117 sub create_output {
9118         eval $start if $b_log;
9119         my ($ref) = @_;
9120         my (%data,@row,@rows);
9121         %data = %$ref;
9122         my $firmware = 'BIOS';
9123         my $num = 0;
9124         my $j = 0;
9125         my ($b_chassis,$b_skip_chassis,$b_skip_system);
9126         my ($bios_date,$bios_rev,$bios_romsize,$bios_vendor,$bios_version,$chassis_serial,
9127         $chassis_type,$chassis_vendor,$chassis_version, $mobo_model,$mobo_serial,$mobo_vendor,
9128         $mobo_version,$product_name,$product_serial,$product_version,$system_vendor);
9129 #       foreach my $key (keys %data){
9130 #               print "$key: $data{$key}\n";
9131 #       }
9132         if (!$data{'sys_vendor'} || ($data{'board_vendor'} &&
9133        $data{'sys_vendor'} eq $data{'board_vendor'} && !$data{'product_name'} &&
9134             !$data{'product_version'} && !$data{'product_serial'})){
9135                 $b_skip_system = 1;
9136         }
9137         # found a case of battery existing but having nothing in it on desktop mobo
9138         # not all laptops show the first. /proc/acpi/battery is deprecated.
9139         elsif ( !glob('/proc/acpi/battery/*') && !glob('/sys/class/power_supply/*') ){
9140                 # ibm / ibm can be true; dell / quantum is false, so in other words, only do this
9141                 # in case where the vendor is the same and the version is the same and not null,
9142                 # otherwise the version information is going to be different in all cases I think
9143                 if ( ($data{'sys_vendor'} && $data{'sys_vendor'} eq $data{'board_vendor'} ) &&
9144                         ( ($data{'product_version'} && $data{'product_version'} eq $data{'board_version'} ) ||
9145                         (!$data{'product_version'} && $data{'product_name'} eq $data{'board_name'} ) ) ){
9146                         $b_skip_system = 1;
9147                 }
9148         }
9149         $data{'device'} ||= 'N/A';
9150         $j = scalar @rows;
9151         @row = ({
9152         main::key($num++,'Type') => ucfirst($data{'device'}),
9153         },);
9154         @rows = (@rows,@row);
9155         if (!$b_skip_system){
9156                 # this has already been tested for above so we know it's not null
9157                 $system_vendor = main::cleaner($data{'sys_vendor'});
9158                 $product_name = ($data{'product_name'}) ? $data{'product_name'}:'N/A';
9159                 $product_version = ($data{'product_version'}) ? $data{'product_version'}:'N/A';
9160                 $product_serial = main::apply_filter($data{'product_serial'});
9161                 $rows[$j]{main::key($num++,'System')} = $system_vendor;
9162                 $rows[$j]{main::key($num++,'product')} = $product_name;
9163                 $rows[$j]{main::key($num++,'v')} = $product_version;
9164                 $rows[$j]{main::key($num++,'serial')} = $product_serial;
9165                 # no point in showing chassis if system isn't there, it's very unlikely that
9166                 # would be correct
9167                 if ($extra > 1){
9168                         if ($data{'board_version'} && $data{'chassis_version'} eq $data{'board_version'}){
9169                                 $b_skip_chassis = 1;
9170                         }
9171                         if (!$b_skip_chassis && $data{'chassis_vendor'} ){
9172                                 if ($data{'chassis_vendor'} ne $data{'sys_vendor'} ){
9173                                         $chassis_vendor = $data{'chassis_vendor'};
9174                                 }
9175                                 # dmidecode can have these be the same
9176                                 if ($data{'chassis_type'} && $data{'device'} ne $data{'chassis_type'} ){
9177                                         $chassis_type = $data{'chassis_type'};
9178                                 }
9179                                 if ($data{'chassis_version'}){
9180                                         $chassis_version = $data{'chassis_version'};
9181                                         $chassis_version =~ s/^v([0-9])/$1/i;
9182                                 }
9183                                 $chassis_serial = main::apply_filter($data{'chassis_serial'});
9184                                 $chassis_vendor ||= '';
9185                                 $chassis_type ||= '';
9186                                 $rows[$j]{main::key($num++,'Chassis')} = $chassis_vendor;
9187                                 if ($chassis_type){
9188                                         $rows[$j]{main::key($num++,'type')} = $chassis_type;
9189                                 }
9190                                 if ($chassis_version){
9191                                         $rows[$j]{main::key($num++,'v')} = $chassis_version;
9192                                 }
9193                                 $rows[$j]{main::key($num++,'serial')} = $chassis_serial;
9194                         }
9195                 }
9196                 $j++; # start new row
9197         }
9198         if ($data{'firmware'}){
9199                 $firmware = $data{'firmware'};
9200         }
9201         $mobo_vendor = ($data{'board_vendor'}) ? main::cleaner($data{'board_vendor'}) : 'N/A';
9202         $mobo_model = ($data{'board_name'}) ? $data{'board_name'}: 'N/A';
9203         $mobo_version = ($data{'board_version'})? $data{'board_version'} : '';
9204         $mobo_serial = main::apply_filter($data{'board_serial'});
9205         $bios_vendor = ($data{'bios_vendor'}) ? main::cleaner($data{'bios_vendor'}) : 'N/A';
9206         if ($data{'bios_version'}){
9207                 $bios_version = $data{'bios_version'};
9208                 $bios_version =~ s/^v([0-9])/$1/i;
9209                 if ($data{'bios_rev'}){
9210                         $bios_rev = $data{'bios_rev'};
9211                 }
9212         }
9213         $bios_version ||= 'N/A';
9214         if ($data{'bios_date'}){
9215                 $bios_date = $data{'bios_date'};
9216         }
9217         $bios_date ||= 'N/A';
9218         if ($extra > 1 && $data{'bios_romsize'}){
9219                 $bios_romsize = $data{'bios_romsize'};
9220         }
9221         $rows[$j]{main::key($num++,'Mobo')} = $mobo_vendor;
9222         $rows[$j]{main::key($num++,'model')} = $mobo_model;
9223         if ($mobo_version){
9224                 $rows[$j]{main::key($num++,'v')} = $mobo_version;
9225         }
9226         $rows[$j]{main::key($num++,'serial')} = $mobo_serial;
9227         if ($extra > 2 && $data{'board_uuid'}){
9228                 $rows[$j]{main::key($num++,'uuid')} = $data{'board_uuid'};
9229         }
9230         $rows[$j]{main::key($num++,$firmware)} = $bios_vendor;
9231         $rows[$j]{main::key($num++,'v')} = $bios_version;
9232         if ($bios_rev){
9233                 $rows[$j]{main::key($num++,'rev')} = $bios_rev;
9234         }
9235         $rows[$j]{main::key($num++,'date')} = $bios_date;
9236         if ($bios_romsize){
9237                 $rows[$j]{main::key($num++,'rom size')} = $bios_romsize;
9238         }
9239         eval $end if $b_log;
9240         return @rows;
9241 }
9242 sub create_output_soc {
9243         my (%data,@row,@rows);
9244         my (%soc_machine) = @_;
9245         my $num = 0;
9246         my $j = 0;
9247         #print Data::Dumper::Dumper \%soc_machine;
9248         # this is sketchy, /proc/device-tree/model may be similar to Hardware value from /proc/cpuinfo
9249         # raspi: Hardware       : BCM2835 model: Raspberry Pi Model B Rev 2
9250         if ($soc_machine{'device'} || $soc_machine{'model'}){
9251                 my $key = ($b_arm) ? 'ARM Device': 'MIPS Device';
9252                 $rows[$j]{main::key($num++,'Type')} = $key;
9253                 my $system = 'System';
9254                 if (defined $soc_machine{'model'}){
9255                         $rows[$j]{main::key($num++,'System')} = $soc_machine{'model'};
9256                         $system = 'details';
9257                 }
9258                 my $device = $soc_machine{'device'};
9259                 $device ||= 'N/A';
9260                 $rows[$j]{main::key($num++,$system)} = $device;
9261         }
9262         # we're going to print N/A for 0000 values sine the item was there.
9263         if ($soc_machine{'firmware'}){
9264                 # most samples I've seen are like: 0000
9265                 $soc_machine{'firmware'} =~ s/^[0]+$//;
9266                 $soc_machine{'firmware'} ||= 'N/A';
9267                 $rows[$j]{main::key($num++,'rev')} = $soc_machine{'firmware'};
9268         }
9269         # sometimes has value like: 0000
9270         if (defined $soc_machine{'serial'}){
9271                 # most samples I've seen are like: 0000
9272                 $soc_machine{'serial'} =~ s/^[0]+$//;
9273                 $rows[$j]{main::key($num++,'serial')} = main::apply_filter($soc_machine{'serial'});
9274         }
9275         eval $end if $b_log;
9276         return @rows;
9277 }
9278
9279 sub machine_data_sys {
9280         eval $start if $b_log;
9281         my (%data,$path,$vm);
9282         my $sys_dir = '/sys/class/dmi/id/';
9283         my $sys_dir_alt = '/sys/devices/virtual/dmi/id/';
9284         my @sys_files = qw(bios_vendor bios_version bios_date
9285         board_name board_serial board_vendor board_version chassis_type
9286         product_name product_serial product_uuid product_version sys_vendor
9287         );
9288         if ($extra > 1){
9289                 splice @sys_files, 0, 0, qw( chassis_serial chassis_vendor chassis_version);
9290         }
9291         $data{'firmware'} = 'BIOS';
9292         # print Data::Dumper::Dumper \@sys_files;
9293         if (!-d $sys_dir ){
9294                 if ( -d $sys_dir_alt){
9295                         $sys_dir = $sys_dir_alt;
9296                 }
9297                 else {
9298                         return 0;
9299                 }
9300         }
9301         if ( -d '/sys/firmware/efi'){
9302                 $data{'firmware'} = 'UEFI';
9303         }
9304         elsif ( glob('/sys/firmware/acpi/tables/UEFI*') ){
9305                 $data{'firmware'} = 'UEFI [Legacy]';
9306         }
9307         foreach (@sys_files){
9308                 $path = "$sys_dir$_";
9309                 if (-r $path){
9310                         $data{$_} = (main::reader($path))[0];
9311                         $data{$_} = ($data{$_}) ? main::dmi_cleaner($data{$_}) : '';
9312                 }
9313                 elsif (!$b_root && -e $path && !-r $path ){
9314                         $data{$_} = main::row_defaults('root-required');
9315                 }
9316                 else {
9317                         $data{$_} = '';
9318                 }
9319         }
9320         if ($data{'chassis_type'}){
9321                 if ( $data{'chassis_type'} == 1){
9322                         $data{'device'} = get_device_vm($data{'sys_vendor'},$data{'product_name'});
9323                         $data{'device'} ||= 'other-vm?';
9324                 }
9325                 else {
9326                         $data{'device'} = get_device_sys($data{'chassis_type'});
9327                 }
9328         }
9329 #       print "sys:\n";
9330 #       foreach (keys %data){
9331 #               print "$_: $data{$_}\n";
9332 #       }
9333         main::log_data('dump','%data',\%data) if $b_log;
9334         my @rows = create_output(\%data);
9335         eval $end if $b_log;
9336         return @rows;
9337 }
9338 # this will create an alternate machine data source
9339 # which will be used for alt ARM machine data in cases
9340 # where no dmi data present, or by cpu data to guess at
9341 # certain actions for arm only.
9342 sub machine_data_soc {
9343         eval $end if $b_log;
9344         my (%soc_machine,@temp);
9345         if (my $file = main::system_files('cpuinfo')){
9346                 #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/arm/arm-shevaplug-1.2ghz.txt";
9347                 my @data = main::reader($file);
9348                 foreach (@data){
9349                         if (/^(Hardware|machine)\s*:/i){
9350                                 @temp = split /\s*:\s*/, $_;
9351                                 $temp[1] = main::arm_cleaner($temp[1]);
9352                                 $temp[1] = main::dmi_cleaner($temp[1]);
9353                                 $soc_machine{'device'} = main::cleaner($temp[1]);
9354                         }
9355                         elsif (/^(system type)\s*:/i){
9356                                 @temp = split /\s*:\s*/, $_;
9357                                 $temp[1] = main::dmi_cleaner($temp[1]);
9358                                 $soc_machine{'model'} = main::cleaner($temp[1]);
9359                         }
9360                         elsif (/^Revision/i){
9361                                 @temp = split /\s*:\s*/, $_;
9362                                 $soc_machine{'firmware'} = $temp[1];
9363                         }
9364                         elsif (/^Serial/i){
9365                                 @temp = split /\s*:\s*/, $_;
9366                                 $soc_machine{'serial'} = $temp[1];
9367                         }
9368                 }
9369         }
9370         if (!$soc_machine{'model'} && -f '/proc/device-tree/model'){
9371                 my $model  = (main::reader('/proc/device-tree/model'))[0];
9372                 main::log_data('data',"device-tree-model: $model") if $b_log;
9373                 if ( $model ){
9374                         $model = main::dmi_cleaner($model);
9375                         $model = (split /\x01|\x02|\x03|\x00/, $model)[0] if $model;
9376                         # idea was to use only first part of string, but now try using all
9377                         #my (@result) = ();
9378                         #@result = split(/\s+/, $soc_machine{'device'}) if $soc_machine{'device'};
9379                         if ( !$soc_machine{'device'} || ($model && $model !~ /$soc_machine{'device'}/i) ){
9380                                 $model = main::arm_cleaner($model);
9381                                 $soc_machine{'model'} = $model;
9382                         }
9383                 }
9384         }
9385         if (!$soc_machine{'serial'} && -f '/proc/device-tree/serial-number'){
9386                 my $serial  = (main::reader('/proc/device-tree/serial-number'))[0];
9387                 $serial = (split /\x01|\x02|\x03|\x00/, $serial)[0] if $serial;
9388                 main::log_data('data',"device-tree-serial: $serial") if $b_log;
9389                 $soc_machine{'serial'} = $serial if $serial;
9390         }
9391         #print Data::Dumper::Dumper \%soc_machine;
9392         eval $end if $b_log;
9393         return %soc_machine;
9394 }
9395
9396 # bios_date: 09/07/2010
9397 # bios_romsize: dmi only
9398 # bios_vendor: American Megatrends Inc.
9399 # bios_version: P1.70
9400 # bios_rev: 8.14:  dmi only
9401 # board_name: A770DE+
9402 # board_serial:
9403 # board_vendor: ASRock
9404 # board_version:
9405 # chassis_serial:
9406 # chassis_type: 3
9407 # chassis_vendor:
9408 # chassis_version:
9409 # firmware:
9410 # product_name:
9411 # product_serial:
9412 # product_uuid:
9413 # product_version:
9414 # sys_uuid: dmi/sysctl only
9415 # sys_vendor:
9416 sub machine_data_dmi {
9417         eval $start if $b_log;
9418         my (%data,$vm);
9419         return if ! @dmi;
9420         $data{'firmware'} = 'BIOS';
9421         # dmi types:
9422         # 0 bios; 1 system info; 2 board|base board info; 3 chassis info;
9423         # 4 processor info, use to check for hypervisor
9424         foreach (@dmi){
9425                 my @ref = @$_;
9426                 # bios/firmware
9427                 if ($ref[0] == 0){
9428                         # skip first three row, we don't need that data
9429                         splice @ref, 0, 3 if @ref;
9430                         foreach my $item (@ref){
9431                                 if ($item !~ /^~/){ # skip the indented rows
9432                                         my @value = split /:\s+/, $item;
9433                                         if ($value[0] eq 'Release Date') {$data{'bios_date'} = main::dmi_cleaner($value[1]) }
9434                                         elsif ($value[0] eq 'Vendor') {$data{'bios_vendor'} = main::dmi_cleaner($value[1]) }
9435                                         elsif ($value[0] eq 'Version') {$data{'bios_version'} = main::dmi_cleaner($value[1]) }
9436                                         elsif ($value[0] eq 'ROM Size') {$data{'bios_romsize'} = main::dmi_cleaner($value[1]) }
9437                                         elsif ($value[0] eq 'BIOS Revision') {$data{'bios_rev'} = main::dmi_cleaner($value[1]) }
9438                                         elsif ($value[0] =~ /^UEFI is supported/) {$data{'firmware'} = 'UEFI';}
9439                                 }
9440                         }
9441                         next;
9442                 }
9443                 # system information
9444                 elsif ($ref[0] == 1){
9445                         # skip first three row, we don't need that data
9446                         splice @ref, 0, 3 if @ref;
9447                         foreach my $item (@ref){
9448                                 if ($item !~ /^~/){ # skip the indented rows
9449                                         my @value = split /:\s+/, $item;
9450                                         if ($value[0] eq 'Product Name') {$data{'product_name'} = main::dmi_cleaner($value[1]) }
9451                                         elsif ($value[0] eq 'Version') {$data{'product_version'} = main::dmi_cleaner($value[1]) }
9452                                         elsif ($value[0] eq 'Serial Number') {$data{'product_serial'} = main::dmi_cleaner($value[1]) }
9453                                         elsif ($value[0] eq 'Manufacturer') {$data{'sys_vendor'} = main::dmi_cleaner($value[1]) }
9454                                         elsif ($value[0] eq 'UUID') {$data{'sys_uuid'} = main::dmi_cleaner($value[1]) }
9455                                 }
9456                         }
9457                         next;
9458                 }
9459                 # baseboard information
9460                 elsif ($ref[0] == 2){
9461                         # skip first three row, we don't need that data
9462                         splice @ref, 0, 3 if @ref;
9463                         foreach my $item (@ref){
9464                                 if ($item !~ /^~/){ # skip the indented rows
9465                                         my @value = split /:\s+/, $item;
9466                                         if ($value[0] eq 'Product Name') {$data{'board_name'} = main::dmi_cleaner($value[1]) }
9467                                         elsif ($value[0] eq 'Serial Number') {$data{'board_serial'} = main::dmi_cleaner($value[1]) }
9468                                         elsif ($value[0] eq 'Manufacturer') {$data{'board_vendor'} = main::dmi_cleaner($value[1]) }
9469                                 }
9470                         }
9471                         next;
9472                 }
9473                 # chassis information
9474                 elsif ($ref[0] == 3){
9475                         # skip first three row, we don't need that data
9476                         splice @ref, 0, 3 if @ref;
9477                         foreach my $item (@ref){
9478                                 if ($item !~ /^~/){ # skip the indented rows
9479                                         my @value = split /:\s+/, $item;
9480                                         if ($value[0] eq 'Serial Number') {$data{'chassis_serial'} = main::dmi_cleaner($value[1]) }
9481                                         elsif ($value[0] eq 'Type') {$data{'chassis_type'} = main::dmi_cleaner($value[1]) }
9482                                         elsif ($value[0] eq 'Manufacturer') {$data{'chassis_vendor'} = main::dmi_cleaner($value[1]) }
9483                                         elsif ($value[0] eq 'Version') {$data{'chassis_version'} = main::dmi_cleaner($value[1]) }
9484                                 }
9485                         }
9486                         if ( $data{'chassis_type'} && $data{'chassis_type'} ne 'Other' ){
9487                                 $data{'device'} = $data{'chassis_type'};
9488                         }
9489                         next;
9490                 }
9491                 # this may catch some BSD and fringe Linux cases
9492                 # processor information: check for hypervisor
9493                 elsif ($ref[0] == 4){
9494                         # skip first three row, we don't need that data
9495                         splice @ref, 0, 3 if @ref;
9496                         if (!$data{'device'}){
9497                                 if (grep {/hypervisor/i} @ref){
9498                                         $data{'device'} = 'virtual-machine';
9499                                 }
9500                         }
9501                         last;
9502                 }
9503                 elsif ($ref[0] > 4){
9504                         last;
9505                 }
9506         }
9507         if (!$data{'device'}){
9508                 $data{'device'} = get_device_vm($data{'sys_vendor'},$data{'product_name'});
9509                 $data{'device'} ||= 'other-vm?';
9510         }
9511 #       print "dmi:\n";
9512 #       foreach (keys %data){
9513 #               print "$_: $data{$_}\n";
9514 #       }
9515         main::log_data('dump','%data',\%data) if $b_log;
9516         my @rows = create_output(\%data);
9517         eval $end if $b_log;
9518         return @rows;
9519 }
9520 # As far as I know, only OpenBSD supports this method.
9521 # it uses hw. info from sysctl -a and bios info from dmesg.boot
9522 sub machine_data_sysctl {
9523         eval $start if $b_log;
9524         my (%data,$vm);
9525         # ^hw\.(vendor|product|version|serialno|uuid)
9526         foreach (@sysctl_machine){
9527                 next if ! $_;
9528                 my @item = split /:/, $_;
9529                 next if ! $item[1];
9530                 if ($item[0] eq 'hw.vendor'){
9531                         $data{'board_vendor'} = main::dmi_cleaner($item[1]);
9532                 }
9533                 elsif ($item[0] eq 'hw.product'){
9534                         $data{'board_name'} = main::dmi_cleaner($item[1]);
9535                 }
9536                 elsif ($item[0] eq 'hw.version'){
9537                         $data{'board_version'} = $item[1];
9538                 }
9539                 elsif ($item[0] eq 'hw.serialno'){
9540                         $data{'board_serial'} = $item[1];
9541                 }
9542                 elsif ($item[0] eq 'hw.serial'){
9543                         $data{'board_serial'} = $item[1];
9544                 }
9545                 elsif ($item[0] eq 'hw.uuid'){
9546                         $data{'board_uuid'} = $item[1];
9547                 }
9548                 # bios0:at mainbus0: AT/286+ BIOS, date 06/30/06, BIOS32 rev. 0 @ 0xf2030, SMBIOS rev. 2.4 @ 0xf0000 (47 entries)
9549                 # bios0:vendor Phoenix Technologies, LTD version "3.00" date 06/30/2006
9550                 elsif ($item[0] =~ /^bios[0-9]/){
9551                         if ($_ =~ /^^bios[0-9]:at\s.*\srev\.\s([\S]+)\s@.*/){
9552                                 $data{'bios_rev'} = $1;
9553                                 $data{'firmware'} = 'BIOS' if $_ =~ /BIOS/;
9554                         }
9555                         elsif ($item[1] =~ /^vendor\s(.*)\sversion\s"?([\S]+)"?\sdate\s([\S]+)/ ){
9556                                 $data{'bios_vendor'} = $1;
9557                                 $data{'bios_version'} = $2;
9558                                 $data{'bios_date'} = $3;
9559                                 $data{'bios_version'} =~ s/^v//i if $data{'bios_version'} && $data{'bios_version'} !~ /vi/i;
9560                         }
9561                 }
9562         }
9563         my @rows = create_output(\%data);
9564         eval $end if $b_log;
9565         return @rows;
9566 }
9567
9568 sub get_device_sys {
9569         eval $start if $b_log;
9570         my ($chasis_id) = @_;
9571         my ($device) = ('');
9572         my @chassis;
9573         # https://www.dmtf.org/sites/default/files/standards/documents/DSP0134_2.8.0.pdf
9574         $chassis[2] = 'unknown';
9575         # note: 13 is all-in-one which we take as a mac type system
9576         $chassis[3] = 'desktop';
9577         $chassis[4] = 'desktop';
9578         $chassis[6] = 'desktop';
9579         $chassis[7] = 'desktop';
9580         $chassis[13] = 'desktop';
9581         $chassis[15] = 'desktop';
9582         $chassis[24] = 'desktop';
9583         # 5 - pizza box was a 1 U desktop enclosure, but some old laptops also id this way
9584         $chassis[5] = 'pizza-box';
9585         $chassis[9] = 'laptop';
9586         # note: lenovo T420 shows as 10, notebook,  but it's not a notebook
9587         $chassis[10] = 'laptop';
9588         $chassis[16] = 'laptop';
9589         $chassis[14] = 'notebook';
9590         $chassis[8] = 'portable';
9591         $chassis[11] = 'portable';
9592         $chassis[17] = 'server';
9593         $chassis[23] = 'server';
9594         $chassis[25] = 'server';
9595         $chassis[27] = 'blade';
9596         $chassis[25] = 'blade';
9597         $chassis[29] = 'blade';
9598         $chassis[12] = 'docking-station';
9599         $chassis[18] = 'expansion-chassis';
9600         $chassis[19] = 'sub-chassis';
9601         $chassis[20] = 'bus-expansion';
9602         $chassis[21] = 'peripheral';
9603         $chassis[22] = 'RAID';
9604         $chassis[26] = 'compact-PCI';
9605         $device = $chassis[$chasis_id] if $chassis[$chasis_id];
9606         eval $end if $b_log;
9607         return $device;
9608 }
9609
9610 sub get_device_vm {
9611         eval $start if $b_log;
9612         my ($manufacturer,$product_name) = @_;
9613         my $vm;
9614         if ( my $program = main::check_program('systemd-detect-virt') ){
9615                 my $vm_test = (main::grabber("$program 2>/dev/null"))[0];
9616                 if ($vm_test){
9617                         # kvm vbox reports as oracle, usually, unless they change it
9618                         if (lc($vm_test) eq 'oracle'){
9619                                 $vm = 'virtualbox';
9620                         }
9621                         elsif ( $vm_test ne 'none'){
9622                                 $vm = $vm_test;
9623                         }
9624                 }
9625         }
9626         if (!$vm || lc($vm) eq 'bochs') {
9627                 if (-e '/proc/vz'){$vm = 'openvz'}
9628                 elsif (-e '/proc/xen'){$vm = 'xen'}
9629                 elsif (-e '/dev/vzfs'){$vm = 'virtuozzo'}
9630                 elsif (my $program = main::check_program('lsmod')){
9631                         my @vm_data = main::grabber("$program 2>/dev/null");
9632                         if (@vm_data){
9633                                 if (grep {/kqemu/i} @vm_data){$vm = 'kqemu'}
9634                                 elsif (grep {/kvm/i} @vm_data){$vm = 'kvm'}
9635                                 elsif (grep {/qemu/i} @vm_data){$vm = 'qemu'}
9636                         }
9637                 }
9638         }
9639         # this will catch many Linux systems and some BSDs
9640         if (!$vm || lc($vm) eq 'bochs' ) {
9641                 my @vm_data = (@pci,@sysctl,@dmesg_boot);
9642                 if (-e '/dev/disk/by-id'){
9643                         my @dev = glob('/dev/disk/by-id/*');
9644                         @vm_data = (@vm_data,@dev);
9645                 }
9646                 if ( grep {/innotek|vbox|virtualbox/i} @vm_data){
9647                         $vm = 'virtualbox';
9648                 }
9649                 elsif (grep {/vmware/i} @vm_data){
9650                         $vm = 'vmware';
9651                 }
9652                 elsif (grep {/Virtual HD/i} @vm_data){
9653                         $vm = 'hyper-v';
9654                 }
9655                 if (!$vm && (my $file = main::system_files('cpuinfo'))){
9656                         my @info = main::reader($file);
9657                         $vm = 'virtual-machine' if grep {/^flags.*hypervisor/} @info;
9658                 }
9659                 if (!$vm && -e '/dev/vda' || -e '/dev/vdb' || -e '/dev/xvda' || -e '/dev/xvdb' ){
9660                         $vm = 'virtual-machine';
9661                 }
9662         }
9663         if (!$vm  && $product_name){
9664                 if ($product_name eq 'VMware'){
9665                         $vm = 'vmware';
9666                 }
9667                 elsif ($product_name eq 'VirtualBox'){
9668                         $vm = 'virtualbox';
9669                 }
9670                 elsif ($product_name eq 'KVM'){
9671                         $vm = 'kvm';
9672                 }
9673                 elsif ($product_name eq 'Bochs'){
9674                         $vm = 'qemu';
9675                 }
9676         }
9677         if (!$vm && $manufacturer && $manufacturer eq 'Xen'){
9678                 $vm = 'xen';
9679         }
9680         eval $end if $b_log;
9681         return $vm;
9682 }
9683
9684 }
9685
9686 ## NetworkData
9687 {
9688 package NetworkData;
9689 my ($b_ip_run,@ifs_found);
9690 sub get {
9691         eval $start if $b_log;
9692         my (@data,@rows);
9693         my $num = 0;
9694         if (($b_arm || $b_mips) && !$b_soc_net && !$b_pci_tool){
9695                 # do nothing, but keep the test conditions to force
9696                 # the non arm case to always run
9697         }
9698         else {
9699                 @data = card_data();
9700                 @rows = (@rows,@data) if @data;
9701         }
9702         @data = usb_data();
9703         @rows = (@rows,@data) if @data;
9704         # note: rasberry pi uses usb networking only
9705         if (!@rows && ($b_arm || $b_mips)){
9706                 my $key = ($b_arm) ? 'ARM' : 'MIPS';
9707                 @data = ({
9708                 main::key($num++,$key) => main::row_defaults(lc($key) . '-pci',''),
9709                 },);
9710                 @rows = (@rows,@data);
9711         }
9712         if ($show{'network-advanced'}){
9713                 # @ifs_found = ();
9714                 # shift @ifs_found;
9715                 # pop @ifs_found;
9716                 if (!$bsd_type){
9717                         @data = advanced_data_sys('check','',0,'','');
9718                         @rows = (@rows,@data) if @data;
9719                 }
9720                 else {
9721                         @data = advanced_data_bsd('check');
9722                         @rows = (@rows,@data) if @data;
9723                 }
9724         }
9725         if ($show{'ip'}){
9726                 @data = wan_ip();
9727                 @rows = (@rows,@data);
9728         }
9729         eval $end if $b_log;
9730         return @rows;
9731 }
9732 # 1 type_id
9733 # 2 bus_id
9734 # 3 sub_id
9735 # 4 device
9736 # 5 vendor_id
9737 # 6 chip_id
9738 # 7 rev
9739 # 8 port
9740 # 9 driver
9741 # 10 modules
9742 # 11 driver nu (bsds)
9743 sub card_data {
9744         eval $start if $b_log;
9745         my ($b_wifi,@rows,@data,%holder);
9746         my ($j,$num) = (0,1);
9747         foreach (@pci){
9748                 $num = 1;
9749                 my @row = @$_;
9750                 #print "$row[0] $row[3]\n";
9751                 # NOTE: class 06 subclass 80
9752                 # https://www-s.acm.illinois.edu/sigops/2007/roll_your_own/7.c.1.html
9753                 if (($row[0] && $row[0] =~ /^(eth|ethernet|ethernet-phy|network|wifi|wlan)$/ )|| ($row[1] && $row[1] eq '0680' ) ){
9754                         #print "$row[0] $row[3]\n";
9755                         $j = scalar @rows;
9756                         my $driver = $row[9];
9757                         my $chip_id = "$row[5]:$row[6]";
9758                         # working around a virtuo bug same chip id is used on two nics
9759                         if (!defined $holder{$chip_id}){
9760                                 $holder{$chip_id} = 0;
9761                         }
9762                         else {
9763                                 $holder{$chip_id}++;
9764                         }
9765                         # first check if it's a known wifi id'ed card, if so, no print of duplex/speed
9766                         $b_wifi = check_wifi($row[4]);
9767                         my $card = $row[4];
9768                         $card = ($card) ? main::pci_cleaner($card,'output') : 'N/A';
9769                         #$card ||= 'N/A';
9770                         $driver ||= 'N/A';
9771                         @data = ({
9772                         main::key($num++,'Card') => $card,
9773                         },);
9774                         @rows = (@rows,@data);
9775                         #if ($extra > 2 && $b_pci_tool && $row[11]){
9776                         #       my $item = main::get_pci_vendor($row[4],$row[11]);
9777                         #       $rows[$j]{main::key($num++,'model')} = $item if $item;
9778                         #}
9779                         if ($row[1] eq '0680'){
9780                                 $rows[$j]{main::key($num++,'type')} = 'network bridge';
9781                         }
9782                         $rows[$j]{main::key($num++,'driver')} = $driver;
9783                         if ($extra > 0){
9784                                 if ($row[9] && !$bsd_type){
9785                                         my $version = main::get_module_version($row[9]);
9786                                         $version ||= 'N/A';
9787                                         $rows[$j]{main::key($num++,'v')} = $version;
9788                                 }
9789                                 $row[8] ||= 'N/A';
9790                                 # as far as I know, wifi has no port, but in case it does in future, use it
9791                                 $rows[$j]{main::key($num++,'port')} = $row[8] if (!$b_wifi || ( $b_wifi && $row[8] ne 'N/A') );
9792                                 my $bus_id = 'N/A';
9793                                 # note: for arm/mips we want to see the single item bus id, why not?
9794                                 if ($row[2] && $row[3]){$bus_id = "$row[2].$row[3]"}
9795                                 elsif ($row[2]){$bus_id = $row[2]}
9796                                 elsif ($row[3]){$bus_id = $row[3]}
9797                                 $rows[$j]{main::key($num++,'bus ID')} = $bus_id;
9798                         }
9799                         if ($extra > 1){
9800                                 $rows[$j]{main::key($num++,'chip ID')} = $chip_id;
9801                         }
9802                         if ($show{'network-advanced'}){
9803                                 if (!$bsd_type){
9804                                         @data = advanced_data_sys($row[5],$row[6],$holder{$chip_id},$b_wifi,'');
9805                                 }
9806                                 else {
9807                                         @data = advanced_data_bsd("$row[9]$row[11]",$b_wifi);
9808                                 }
9809                                 @rows = (@rows,@data);
9810                         }
9811                 }
9812                 #print "$row[0]\n";
9813         }
9814         # @rows = ();
9815         # we want to handle ARM errors in main get
9816         if (!@rows && !$b_arm){
9817                 my $key = 'Message';
9818                 @data = ({
9819                 main::key($num++,$key) => main::row_defaults('pci-card-data',''),
9820                 },);
9821                 @rows = (@rows,@data);
9822
9823         }
9824         #my $ref = $pci[-1];
9825         #print $$ref[0],"\n";
9826         eval $end if $b_log;
9827         return @rows;
9828 }
9829 sub usb_data {
9830         eval $start if $b_log;
9831         my (@data,@rows,@temp2,$b_wifi,$driver,$path,$product,$product2,$test,$vendor,$vendor2);
9832         my ($j,$num) = (0,1);
9833         return if !@usb;
9834         foreach my $ref (@usb){
9835                 my @row = @$ref;
9836                 # a device will always be the second or > device on the bus
9837                 if ($row[1] > 1){
9838                         $num = 1;
9839                         ($product,$product2,$test,$vendor,$vendor2) = ('','','','','');
9840                         if ($usb_level == 1){
9841                                 $product = main::cleaner($row[3]);
9842                         }
9843                         else {
9844                                 foreach my $line (@row){
9845                                         my @working = split /:/, $line;
9846                                         if ($working[0] eq 'idVendor' && $working[2]){
9847                                                 $vendor = main::cleaner($working[2]);
9848                                         }
9849                                         if ($working[0] eq 'idProduct' && $working[2]){
9850                                                 $product = main::cleaner($working[2]);
9851                                         }
9852                                         if ($working[0] eq 'iVendor' && $working[2]){
9853                                                 $product2 = main::cleaner($working[2]);
9854                                         }
9855                                         if ($working[0] eq 'iProduct' && $working[2]){
9856                                                 $product2 = main::cleaner($working[2]);
9857                                         }
9858                                         if ($working[0] eq 'Descriptor_Configuration'){
9859                                                 last;
9860                                         }
9861                                 }
9862                                 if ($vendor && $product){
9863                                         $product = ($product =~ /$vendor/) ? $product: "$vendor $product";
9864                                 }
9865                                 elsif ($vendor && $product2){
9866                                         $product = ($product2 =~ /$vendor/) ? $product2: "$vendor $product2";
9867                                 }
9868                                 elsif ($vendor2 && $product){
9869                                         $product = ($product =~ /$vendor2/) ? $product: "$vendor2 $product";
9870                                 }
9871                                 elsif ($vendor2 && $product2){
9872                                         $product = ($product2 =~ /$vendor2/) ? $product2: "$vendor2 $product2";
9873                                 }
9874                                 elsif ($vendor){
9875                                         $product = $vendor;
9876                                 }
9877                                 elsif ($vendor2){
9878                                         $product = $vendor2;
9879                                 }
9880                                 $test = "$vendor $product $vendor2 $vendor2";
9881                         }
9882                         if ($product && network_device($test)){
9883                                 @temp2 = main::get_usb_drivers($row[0],$row[2]) if !$bsd_type && -d "/sys/devices";
9884                                 if (@temp2){
9885                                         $driver = $temp2[0] if $temp2[0];
9886                                         $path = $temp2[1] if $temp2[1];
9887                                 }
9888                                 $driver ||= 'usb-network';
9889                                 @data = ({
9890                                 main::key($num++,'Card') => $product,
9891                                 main::key($num++,'type') => 'USB',
9892                                 main::key($num++,'driver') => $driver,
9893                                 },);
9894                                 $b_wifi = check_wifi($product);
9895                                 @rows = (@rows,@data);
9896                                 if ($extra > 0){
9897                                         $rows[$j]{main::key($num++,'bus ID')} = "$row[0]:$row[1]";
9898                                 }
9899                                 if ($extra > 1){
9900                                         $rows[$j]{main::key($num++,'chip ID')} = $row[2];
9901                                 }
9902                                 if ($show{'network-advanced'}){
9903                                         if (!$bsd_type){
9904                                                 my (@temp,$vendor,$chip);
9905                                                 @temp = split (/:/, $row[2]) if $row[2];
9906                                                 ($vendor,$chip) = ($temp[0],$temp[1]) if @temp;
9907                                                 @data = advanced_data_sys($vendor,$chip,0,$b_wifi,$path);
9908                                         }
9909                                         # NOTE: we need the driver.number, like wlp0 to get a match, and
9910                                         # we can't get that from usb data, so we have to let it fall back down
9911                                         # to the check function for BSDs.
9912                                         #else {
9913                                         #       @data = advanced_data_bsd($row[2],$b_wifi);
9914                                         #}
9915                                         @rows = (@rows,@data) if @data;
9916                                 }
9917                                 $j = scalar @rows;
9918                         }
9919                 }
9920         }
9921         eval $end if $b_log;
9922         return @rows;
9923 }
9924 sub advanced_data_sys {
9925         eval $start if $b_log;
9926         return if ! -d '/sys/class/net';
9927         my ($vendor,$chip,$count,$b_wifi,$path_usb) = @_;
9928         my $num = 0;
9929         my $key = 'IF';
9930         my ($b_check,$b_usb,$if,$path,@paths,@row,@rows);
9931         # ntoe: we've already gotten the base path, now we
9932         # we just need to get the IF path, which is one level in:
9933         # usb1/1-1/1-1:1.0/net/enp0s20f0u1/
9934         if ($path_usb){
9935                 $b_usb = 1;
9936                 @paths = main::globber("${path_usb}*/net/*");
9937         }
9938         else {
9939                 @paths = main::globber('/sys/class/net/*');
9940         }
9941         @paths = grep {!/\/lo$/} @paths;
9942         if ( $count > 0 && $count < scalar @paths ){
9943                 @paths = splice @paths, $count, scalar @paths;
9944         }
9945         if ($vendor eq 'check'){
9946                 $b_check = 1;
9947                 $key = 'IF-ID';
9948         }
9949         #print join '; ', @paths,  $count, "\n";
9950         foreach (@paths){
9951                 my ($data1,$data2,$duplex,$mac,$speed,$state);
9952                 # for usb, we already know where we are
9953                 if (!$b_usb){
9954                         if (!$b_arm || $b_pci_tool ){
9955                                 $path = "$_/device/vendor";
9956                                 $data1 = (main::reader($path))[0] if -e $path;
9957                                 $data1 =~ s/^0x// if $data1;
9958                                 $path = "$_/device/device";
9959                                 $data2 = (main::reader($path))[0] if -e $path;
9960                                 $data2 =~ s/^0x// if $data2;
9961                                 # this is a fix for a redhat bug in virtio
9962                                 $data2 = (defined $data2 && $data2 eq '0001' && defined $chip && $chip eq '1000') ? '1000' : $data2;
9963                         }
9964                         elsif ($b_arm) {
9965                                 $path = Cwd::abs_path($_);
9966                                 $path =~ /($chip)/;
9967                                 if ($1){
9968                                         $data1 = $vendor;
9969                                         $data2 = $chip;
9970                                 }
9971                         }
9972                 }
9973                 #print "d1:$data1 v:$vendor d2:$data2 c:$chip\n";
9974                 if ( $b_usb || $b_check || ( $data1 && $data2 && $data1 eq $vendor && $data2 eq $chip )) {
9975                         $if = $_;
9976                         $if =~ s/^\/.+\///;
9977                         # print "top: if: $if ifs: @ifs_found\n";
9978                         next if ($b_check && grep {/$if/} @ifs_found);
9979                         $path = "$_/duplex";
9980                         $duplex = (main::reader($path))[0] if -e $path;
9981                         $duplex ||= 'N/A';
9982                         $path = "$_/address";
9983                         $mac = (main::reader($path))[0] if -e $path;
9984                         $mac = main::apply_filter($mac);
9985                         $path = "$_/speed";
9986                         $speed = (main::reader($path))[0] if -e $path;
9987                         $speed ||= 'N/A';
9988                         $path = "$_/operstate";
9989                         $state = (main::reader($path))[0] if -e $path;
9990                         $state ||= 'N/A';
9991                         #print "$speed \n";
9992                         @row = ({
9993                         main::key($num++,$key) => $if,
9994                         main::key($num++,'state') => $state,
9995                         },);
9996                         #my $j = scalar @row - 1;
9997                         push (@ifs_found, $if) if (!$b_check && (! grep {/$if/} @ifs_found));
9998                         # print "push: if: $if ifs: @ifs_found\n";
9999                         # no print out for wifi since it doesn't have duplex/speed data available
10000                         # note that some cards show 'unknown' for state, so only testing explicitly
10001                         # for 'down' string in that to skip showing speed/duplex
10002                         # /sys/class/net/$if/wireless : nont always there, but worth a try: wlan/wl/ww/wlp
10003                         $b_wifi = 1 if !$b_wifi && ( -e "$_$if/wireless" || $if =~ /^(wl|ww)/);
10004                         if (!$b_wifi && $state ne 'down' && $state ne 'no'){
10005                                 # make sure the value is strictly numeric before appending Mbps
10006                                 $speed = ($speed =~ /^[0-9]+$/) ? "$speed Mbps" : $speed;
10007                                 $row[0]{main::key($num++,'speed')} = $speed;
10008                                 $row[0]{main::key($num++,'duplex')} = $duplex;
10009                         }
10010                         $row[0]{main::key($num++,'mac')} = $mac;
10011                         if ($b_check){
10012                                 @rows = (@rows,@row);
10013                         }
10014                         else {
10015                                 @rows = @row;
10016                         }
10017                         if ($show{'ip'}){
10018                                 @row = if_ip($if);
10019                                 @rows = (@rows,@row);
10020                         }
10021                         last if !$b_check;
10022                 }
10023         }
10024         eval $end if $b_log;
10025         return @rows;
10026 }
10027 sub advanced_data_bsd {
10028         eval $start if $b_log;
10029         return if ! @ifs_bsd;
10030         my ($if,$b_wifi) = @_;
10031         my (@data,@row,@rows,$working_if);
10032         my ($b_check,$state,$speed,$duplex,$mac);
10033         my $num = 0;
10034         my $key = 'IF';
10035         my $j = 0;
10036         if ($if eq 'check'){
10037                 $b_check = 1;
10038                 $key = 'IF-ID';
10039         }
10040         foreach my $ref (@ifs_bsd){
10041                 if (ref $ref ne 'ARRAY'){
10042                         $working_if = $ref;
10043                         # print "$working_if\n";
10044                         next;
10045                 }
10046                 else {
10047                         @data = @$ref;
10048                 }
10049                 if ( $b_check || $working_if eq $if){
10050                         $if = $working_if if $b_check;
10051                         # print "top: if: $if ifs: @ifs_found\n";
10052                         next if ($b_check && grep {/$if/} @ifs_found);
10053                         foreach my $line (@data){
10054                                 # ($state,$speed,$duplex,$mac)
10055                                 $duplex = $data[2];
10056                                 $duplex ||= 'N/A';
10057                                 $mac = main::apply_filter($data[3]);
10058                                 $speed = $data[1];
10059                                 $speed ||= 'N/A';
10060                                 $state = $data[0];
10061                                 $state ||= 'N/A';
10062                                 #print "$speed \n";
10063                                 @row = ({
10064                                 main::key($num++,$key) => $if,
10065                                 main::key($num++,'state') => $state,
10066                                 },);
10067                                 push (@ifs_found, $if) if (!$b_check && (! grep {/$if/} @ifs_found ));
10068                                 # print "push: if: $if ifs: @ifs_found\n";
10069                                 # no print out for wifi since it doesn't have duplex/speed data available
10070                                 # note that some cards show 'unknown' for state, so only testing explicitly
10071                                 # for 'down' string in that to skip showing speed/duplex
10072                                 if (!$b_wifi && $state ne 'down' && $state ne 'no'){
10073                                         # make sure the value is strictly numeric before appending Mbps
10074                                         $speed = ($speed =~ /^[0-9]+$/) ? "$speed Mbps" : $speed;
10075                                         $row[0]{main::key($num++,'speed')} = $speed;
10076                                         $row[0]{main::key($num++,'duplex')} = $duplex;
10077                                 }
10078                                 $row[0]{main::key($num++,'mac')} = $mac;
10079                         }
10080                         @rows = (@rows,@row);
10081                         if ($show{'ip'}){
10082                                 @row = if_ip($if) if $if;
10083                                 @rows = (@rows,@row) if @row;
10084                         }
10085                 }
10086         }
10087         eval $end if $b_log;
10088         return @rows;
10089 }
10090 ## values:
10091 # 0 - ipv
10092 # 1 - ip
10093 # 2 - broadcast, if found
10094 # 3 - scope, if found
10095 # 4 - scope if, if different from if
10096 sub if_ip {
10097         eval $start if $b_log;
10098         my ($if) = @_;
10099         my (@data,@row,@rows,$working_if);
10100         my $num = 0;
10101         my $j = 0;
10102         $b_ip_run = 1;
10103         OUTER:
10104         foreach my $ref (@ifs){
10105                 if (ref $ref ne 'ARRAY'){
10106                         $working_if = $ref;
10107                         # print "if:$if wif:$working_if\n";
10108                         next;
10109                 }
10110                 else {
10111                         @data = @$ref;
10112                         # print "ref:$ref\n";
10113                 }
10114                 if ($working_if eq $if){
10115                         foreach my $ref2 (@data){
10116                                 $j = scalar @rows;
10117                                 $num = 1;
10118                                 if ($limit > 0 && $j >= $limit){
10119                                         @row  = ({
10120                                         main::key($num++,'Message') => main::row_defaults('output-limit',scalar @data),
10121                                         },);
10122                                         @rows = (@rows,@row);
10123                                         last OUTER;
10124                                 }
10125                                 my @data2 = @$ref2;
10126                                 #print "$data2[0] $data2[1]\n";
10127                                 my ($ipv,$ip,$broadcast,$scope,$scope_id);
10128                                 $ipv = ($data2[0])? $data2[0]: 'N/A';
10129                                 $ip = main::apply_filter($data2[1]);
10130                                 $scope = ($data2[3])? $data2[3]: 'N/A';
10131                                 if ($if ne 'all'){
10132                                         if (defined $data2[4] && $working_if ne $data2[4]){
10133                                                 # scope global temporary deprecated dynamic
10134                                                 # scope global dynamic
10135                                                 # scope global temporary deprecated dynamic
10136                                                 # scope site temporary deprecated dynamic
10137                                                 # scope global dynamic noprefixroute enx403cfc00ac68
10138                                                 # scope global eth0
10139                                                 # scope link
10140                                                 # scope site dynamic
10141                                                 # scope link
10142                                                 # trim off if at end of multi word string if found
10143                                                 $data2[4] =~ s/\s$if$// if $data2[4] =~ /[^\s]+\s$if$/;
10144                                                 my $key = ($data2[4] =~ /deprecated|dynamic|temporary|noprefixroute/ ) ? 'type':'virtual' ;
10145                                                 @row  = ({
10146                                                 main::key($num++,"IP v$ipv") => $ip,
10147                                                 main::key($num++,$key) => $data2[4],
10148                                                 main::key($num++,'scope') => $scope,
10149                                                 },);
10150                                         }
10151                                         else {
10152                                                 @row  = ({
10153                                                 main::key($num++,"IP v$ipv") => $ip,
10154                                                 main::key($num++,'scope') => $scope,
10155                                                 },);
10156                                         }
10157                                 }
10158                                 else {
10159                                         @row  = ({
10160                                         main::key($num++,'IF') => $if,
10161                                         main::key($num++,"IP v$ipv") => $ip,
10162                                         main::key($num++,'scope') => $scope,
10163                                         },);
10164                                 }
10165                                 @rows = (@rows,@row);
10166                                 if ($extra > 1 && $data2[2]){
10167                                         $broadcast = main::apply_filter($data2[2]);
10168                                         $rows[$j]{main::key($num++,'broadcast')} = $broadcast;
10169                                 }
10170                         }
10171                 }
10172         }
10173         eval $end if $b_log;
10174         return @rows;
10175 }
10176 # get ip using downloader to stdout. This is a clean, text only IP output url,
10177 # single line only, ending in the ip address. May have to modify this in the future
10178 # to handle ipv4 and ipv6 addresses but should not be necessary.
10179 # ip=$( echo  2001:0db8:85a3:0000:0000:8a2e:0370:7334 | gawk  --re-interval '
10180 # ip=$( wget -q -O - $WAN_IP_URL | gawk  --re-interval '
10181 # this generates a direct dns based ipv4 ip address, but if opendns.com goes down,
10182 # the fall backs will still work.
10183 # note: consistently slower than domain based:
10184 # dig +short +time=1 +tries=1 myip.opendns.com. A @208.67.222.222
10185 sub wan_ip {
10186         eval $start if $b_log;
10187         my (@data,$ip);
10188         my $num = 0;
10189         # time: 0.06 - 0.07 seconds
10190         if (my $program = main::check_program('dig')){
10191                 $ip = (main::grabber("$program +short +time=1 +tries=1 myip.opendns.com \@resolver1.opendns.com 2>/dev/null"))[0];
10192         }
10193         else {
10194                 # note: tests: akamai: 0.055 - 0.065 icanhazip.com: 0.177 0.164
10195                 # smxi: 0.525, so almost 10x slower. Dig is fast too
10196                 # leaving smxi as last test because I know it will always be up.
10197                 my @urls = qw( http://whatismyip.akamai.com/ http://icanhazip.com/ https://smxi.org/opt/ip.php);
10198                 foreach (@urls){
10199                         $ip = main::download_file('stdout',$_);
10200                         if ($ip){
10201                                 # print "$_\n";
10202                                 chomp $ip;
10203                                 $ip = (split /\s+/, $ip)[-1];
10204                                 last;
10205                         }
10206                 }
10207         }
10208         if ($ip && $show{'filter'}){
10209                 $ip = $filter_string;
10210         }
10211         $ip ||= main::row_defaults('IP', 'WAN IP');
10212         @data = ({
10213         main::key($num++,'WAN IP') => $ip,
10214         },);
10215         eval $end if $b_log;
10216         return @data;
10217 }
10218
10219 ### USB networking search string data, because some brands can have other products than
10220 ### wifi/nic cards, they need further identifiers, with wildcards.
10221 ### putting the most common and likely first, then the less common, then some specifics
10222
10223 # Wi-Fi.*Adapter Wireless.*Adapter Ethernet.*Adapter WLAN.*Adapter
10224 # Network.*Adapter 802\.11 Atheros Atmel D-Link.*Adapter D-Link.*Wireless Linksys
10225 # Netgea Ralink Realtek.*Network Realtek.*Wireless Realtek.*WLAN Belkin.*Wireless
10226 # Belkin.*WLAN Belkin.*Network Actiontec.*Wireless Actiontec.*Network AirLink.*Wireless
10227 # Asus.*Network Asus.*Wireless Buffalo.*Wireless Davicom DWA-.*RangeBooster DWA-.*Wireless
10228 # ENUWI-.*Wireless LG.*Wi-Fi Rosewill.*Wireless RNX-.*Wireless Samsung.*LinkStick
10229 # Samsung.*Wireless Sony.*Wireless TEW-.*Wireless TP-Link.*Wireless
10230 # WG[0-9][0-9][0-9].*Wireless WNA[0-9][0-9][0-9] WNDA[0-9][0-9][0-9]
10231 # Zonet.*ZEW.*Wireless
10232 sub network_device {
10233         eval $start if $b_log;
10234         my ($device_string) = @_;
10235         my ($b_network);
10236         # belkin=050d; d-link=07d1; netgear=0846; ralink=148f; realtek=0bda;
10237         # Atmel makes other stuff
10238         my @tests = qw(wifi Wi-Fi.*Adapter Ethernet \bLAN\b WLAN Network 802\.11
10239         Wireless.*Adapter 54\sMbps Network 100\/1000 Mobile\sBroadband Atheros D-Link.*Adapter
10240         Dell.*Wireless D-Link.*Wireless Linksys Netgea Ralink Realtek.*Network Realtek.*Wireless
10241         Belkin.*Wireless Actiontec.*Wireless AirLink.*Wireless Asus.*Wireless
10242         Buffalo.*Wireless Davicom DWA-.*RangeBooster DWA-.*Wireless
10243         ENUWI-.*Wireless LG.*Wi-Fi Rosewill.*Wireless RNX-.*Wireless Samsung.*LinkStick
10244         Samsung.*Wireless Sony.*Wireless TEW-.*Wireless TP-Link.*Wireless
10245         WG[0-9][0-9][0-9].*Wireless WNA[0-9][0-9][0-9] WNDA[0-9][0-9][0-9]
10246         Zonet.*ZEW.*Wireless 050d:935b 0bda:8189 0bda:8197
10247         );
10248         foreach (@tests){
10249                 if ($device_string =~ /$_/i ){
10250                         $b_network = 1;
10251                         last;
10252                 }
10253         }
10254         eval $end if $b_log;
10255         return $b_network;
10256 }
10257 sub check_wifi {
10258         my ($item) = @_;
10259         my $b_wifi = ($item =~ /wireless|wifi|wi-fi|wlan|802\.11|centrino/i) ? 1 : 0;
10260         return $b_wifi;
10261 }
10262 }
10263
10264 ## OpticalData
10265 {
10266 package OpticalData;
10267
10268 sub get {
10269         eval $start if $b_log;
10270         my (@data,@rows,$key1,$val1);
10271         my $num = 0;
10272         if ($bsd_type){
10273                 #@data = optical_data_bsd();
10274                 $key1 = 'Optical Report';
10275                 $val1 = main::row_defaults('optical-data-bsd');
10276                 @data = ({main::key($num++,$key1) => $val1,});
10277                 if ( @dm_boot_optical){
10278                         @data = optical_data_bsd();
10279                 }
10280                 else{
10281                         my $file = main::system_files('dmesg-boot');
10282                         if ( $file && ! -r $file ){
10283                                 $val1 = main::row_defaults('dmesg-boot-permissions');
10284                         }
10285                         elsif (!$file){
10286                                 $val1 = main::row_defaults('dmesg-boot-missing');
10287                         }
10288                         else {
10289                                 $val1 = main::row_defaults('optical-data-bsd');
10290                         }
10291                         $key1 = 'Optical Report';
10292                         @data = ({main::key($num++,$key1) => $val1,});
10293                 }
10294         }
10295         else {
10296                 @data = optical_data_linux();
10297         }
10298         if (!@data){
10299                 $key1 = 'Message';
10300                 $val1 = main::row_defaults('optical-data');
10301                 @data = ({main::key($num++,$key1) => $val1,});
10302         }
10303         @rows = (@rows,@data);
10304         eval $end if $b_log;
10305         return @rows;
10306 }
10307 sub create_output {
10308         eval $start if $b_log;
10309         my (%devices) = @_;
10310         my (@data,@rows);
10311         my $num = 0;
10312         my $j = 0;
10313         # build floppy if any
10314         foreach my $key (sort keys %devices){
10315                 if ($devices{$key}{'type'} eq 'floppy'){
10316                         @data = ({ main::key($num++,ucfirst($devices{$key}{'type'})) => "/dev/$key"});
10317                         @rows = (@rows,@data);
10318                         delete $devices{$key};
10319                 }
10320         }
10321         foreach my $key (sort keys %devices){
10322                 $j = scalar @rows;
10323                 $num = 1;
10324                 my $vendor = $devices{$key}{'vendor'};
10325                 $vendor ||= 'N/A';
10326                 my $model = $devices{$key}{'model'};
10327                 $model ||= 'N/A';
10328                 @data = ({
10329                 main::key($num++,ucfirst($devices{$key}{'type'})) => "/dev/$key",
10330                 main::key($num++,'vendor') => $vendor,
10331                 main::key($num++,'model') => $model,
10332                 });
10333                 @rows = (@rows,@data);
10334                 if ($extra > 0){
10335                         my $rev = $devices{$key}{'rev'};
10336                         $rev ||= 'N/A';
10337                         $rows[$j]{ main::key($num++,'rev')} = $rev;
10338                 }
10339                 if ($extra > 1 && $devices{$key}{'serial'}){
10340                         $rows[$j]{ main::key($num++,'serial')} = main::apply_filter($devices{$key}{'serial'});
10341                 }
10342                 my $ref = $devices{$key}{'links'};
10343                 my $links = (@$ref) ? join ',', sort @$ref: 'N/A' ;
10344                 $rows[$j]{ main::key($num++,'dev-links')} = $links;
10345                 if ($show{'optical'}){
10346                         $j = scalar @rows;
10347                         my $speed = $devices{$key}{'speed'};
10348                         $speed ||= 'N/A';
10349                         my ($audio,$multisession) = ('','');
10350                         if (defined $devices{$key}{'multisession'}){
10351                                 $multisession = ( $devices{$key}{'multisession'} == 1 ) ? 'yes' : 'no' ;
10352                         }
10353                         $multisession ||= 'N/A';
10354                         if (defined $devices{$key}{'audio'}){
10355                                 $audio = ( $devices{$key}{'audio'} == 1 ) ? 'yes' : 'no' ;
10356                         }
10357                         $audio ||= 'N/A';
10358                         my $dvd = 'N/A';
10359                         my (@rw,$rws);
10360                         if (defined $devices{$key}{'dvd'}){
10361                                 $dvd = ( $devices{$key}{'dvd'} == 1 ) ? 'yes' : 'no' ;
10362                         }
10363                         if ($devices{$key}{'cdr'}){
10364                                 push @rw, 'cd-r';
10365                         }
10366                         if ($devices{$key}{'cdrw'}){
10367                                 push @rw, 'cd-rw';
10368                         }
10369                         if ($devices{$key}{'dvdr'}){
10370                                 push @rw, 'dvd-r';
10371                         }
10372                         if ($devices{$key}{'dvdram'}){
10373                                 push @rw, 'dvd-ram';
10374                         }
10375                         $rws = (@rw) ? join ',', @rw: 'none' ;
10376                         @data = ({
10377                         main::key($num++,'Features') => '',
10378                         main::key($num++,'speed') => $speed,
10379                         main::key($num++,'multisession') => $multisession,
10380                         main::key($num++,'audio') => $audio,
10381                         main::key($num++,'dvd') => $dvd,
10382                         main::key($num++,'rw') => $rws,
10383                         });
10384                         @rows = (@rows,@data);
10385
10386                         if ($extra > 0 ){
10387                                 my $state = $devices{$key}{'state'};
10388                                 $state ||= 'N/A';
10389                                 $rows[$j]{ main::key($num++,'state')} = $state;
10390                         }
10391                 }
10392         }
10393         #print Data::Dumper::Dumper \%devices;
10394         eval $end if $b_log;
10395         return @rows;
10396 }
10397 sub optical_data_bsd {
10398         eval $start if $b_log;
10399         my (@data,%devices,@rows,@temp);
10400         my ($count,$i,$working) = (0,0,'');
10401         foreach (@dm_boot_optical){
10402                 $_ =~ s/(cd[0-9]+)\(([^:]+):([0-9]+):([0-9]+)\):/$1:$2-$3.$4,/;
10403                 my @row = split /:\s*/, $_;
10404                 next if ! defined $row[1];
10405                 if ($working ne $row[0]){
10406                         # print "$id_holder $row[0]\n";
10407                         $working = $row[0];
10408                 }
10409                 # no dots, note: ada2: 2861588MB BUT: ada2: 600.000MB/s
10410                 if (! exists $devices{$working}){
10411                         $devices{$working} = ({});
10412                         $devices{$working}{'links'} = ([]);
10413                         $devices{$working}{'model'} = '';
10414                         $devices{$working}{'rev'} = '';
10415                         $devices{$working}{'state'} = '';
10416                         $devices{$working}{'vendor'} = '';
10417                         $devices{$working}{'temp'} = '';
10418                         $devices{$working}{'type'} = ($working =~ /^cd/) ? 'optical' : 'unknown';
10419                 }
10420                 #print "$_\n";
10421                 if ($bsd_type ne 'openbsd'){
10422                         if ($row[1] && $row[1] =~ /^<([^>]+)>/){
10423                                 $devices{$working}{'model'} = $1;
10424                                 $count = ($devices{$working}{'model'} =~ tr/ //);
10425                                 if ($count && $count > 1){
10426                                         @temp = split /\s+/, $devices{$working}{'model'};
10427                                         $devices{$working}{'vendor'} = $temp[0];
10428                                         my $index = ($#temp > 2 ) ? ($#temp - 1): $#temp;
10429                                         $devices{$working}{'model'} = join ' ', @temp[1..$index];
10430                                         $devices{$working}{'rev'} = $temp[-1] if $count > 2;
10431                                 }
10432                                 if ($show{'optical'}){
10433                                         if (/\bDVD\b/){
10434                                                 $devices{$working}{'dvd'} = 1;
10435                                         }
10436                                         if (/\bRW\b/){
10437                                                 $devices{$working}{'cdrw'} = 1;
10438                                                 $devices{$working}{'dvdr'} = 1 if $devices{$working}{'dvd'};
10439                                         }
10440                                 }
10441                         }
10442                         if ($row[1] && $row[1] =~ /^Serial/){
10443                                 @temp = split /\s+/,$row[1];
10444                                 $devices{$working}{'serial'} = $temp[-1];
10445                         }
10446                         if ($show{'optical'}){
10447                                 if ($row[1] =~ /^([0-9\.]+[MGTP][B]?\/s)/){
10448                                         $devices{$working}{'speed'} = $1;
10449                                         $devices{$working}{'speed'} =~ s/\.[0-9]+//;
10450                                 }
10451                                 if (/\bDVD[-]?RAM\b/){
10452                                         $devices{$working}{'cdr'} = 1;
10453                                         $devices{$working}{'dvdram'} = 1;
10454                                 }
10455                                 if ($row[2] && $row[2] =~ /,\s(.*)$/){
10456                                         $devices{$working}{'state'} = $1;
10457                                         $devices{$working}{'state'} =~ s/\s+-\s+/, /;
10458                                 }
10459                         }
10460                 }
10461                 else {
10462                         if ($row[2] && $row[2] =~ /<([^>]+)>/){
10463                                 $devices{$working}{'model'} = $1;
10464                                 $count = ($devices{$working}{'model'} =~ tr/,//);
10465                                 #print "c: $count $row[2]\n";
10466                                 if ($count && $count > 1){
10467                                         @temp = split /,\s*/, $devices{$working}{'model'};
10468                                         $devices{$working}{'vendor'} = $temp[0];
10469                                         $devices{$working}{'model'} = $temp[1];
10470                                         $devices{$working}{'rev'} = $temp[2];
10471                                 }
10472                                 if ($show{'optical'}){
10473                                         if (/\bDVD\b/){
10474                                                 $devices{$working}{'dvd'} = 1;
10475                                         }
10476                                         if (/\bRW\b/){
10477                                                 $devices{$working}{'cdrw'} = 1;
10478                                                 $devices{$working}{'dvdr'} = 1 if $devices{$working}{'dvd'};
10479                                         }
10480                                         if (/\bDVD[-]?RAM\b/){
10481                                                 $devices{$working}{'cdr'} = 1;
10482                                                 $devices{$working}{'dvdram'} = 1;
10483                                         }
10484                                 }
10485                         }
10486                         if ($show{'optical'}){
10487                                 #print "$row[1]\n";
10488                                 if (($row[1] =~ tr/,//) > 1){
10489                                         @temp = split /,\s*/, $row[1];
10490                                         $devices{$working}{'speed'} = $temp[2];
10491                                 }
10492
10493                         }
10494                 }
10495         }
10496
10497         main::log_data('dump','%devices',\%devices) if $b_log;
10498         #print Data::Dumper::Dumper \%devices;
10499         @rows = create_output(%devices) if %devices;
10500         eval $end if $b_log;
10501         return @rows;
10502 }
10503 sub optical_data_linux {
10504         eval $start if $b_log;
10505         my (@data,%devices,@info,@rows);
10506         @data = main::globber('/dev/dvd* /dev/cdr* /dev/scd* /dev/sr* /dev/fd[0-9]');
10507         # Newer kernel is NOT linking all optical drives. Some, but not all.
10508         # Get the actual disk dev location, first try default which is easier to run,
10509         # need to preserve line breaks
10510         foreach (@data){
10511                 my $working = readlink($_);
10512                 $working = ($working) ? $working: $_;
10513                 next if $working =~ /random/;
10514                 # possible fix: puppy has these in /mnt not /dev they say
10515                 $working =~ s/\/(dev|media|mnt)\///;
10516                 $_ =~ s/\/(dev|media|mnt)\///;
10517                 if  (! defined $devices{$working}){
10518                         my @temp = ($_ ne $working) ? ([$_]) : ([]);
10519                         $devices{$working} = ({'links' => @temp});
10520                         $devices{$working}{'type'} = ($working =~ /^fd/) ? 'floppy' : 'optical' ;
10521                 }
10522                 else {
10523                         my $ref = $devices{$working}{'links'};
10524                         push @$ref, $_ if $_ ne $working;
10525                 }
10526                 #print "$working\n";
10527         }
10528         if ($show{'optical'} && -e '/proc/sys/dev/cdrom/info'){
10529                 @info = main::reader('/proc/sys/dev/cdrom/info','strip');
10530         }
10531         #print join '; ', @data, "\n";
10532         foreach my $key (keys %devices){
10533                 next if $devices{$key}{'type'} eq 'floppy';
10534                 my $device = "/sys/block/$key/device";
10535                 if ( -d $device){
10536                         if (-e "$device/vendor"){
10537                                 $devices{$key}{'vendor'} = (main::reader("$device/vendor"))[0];
10538                                 $devices{$key}{'vendor'} = main::cleaner($devices{$key}{'vendor'});
10539                                 $devices{$key}{'state'} = (main::reader("$device/state"))[0];
10540                                 $devices{$key}{'model'} = (main::reader("$device/model"))[0];
10541                                 $devices{$key}{'model'} = main::cleaner($devices{$key}{'model'});
10542                                 $devices{$key}{'rev'} = (main::reader("$device/rev"))[0];
10543                         }
10544                 }
10545                 elsif ( -e "/proc/ide/$_/model"){
10546                         $devices{$key}{'vendor'} = (main::reader("/proc/ide/$_/model"))[0];
10547                         $devices{$key}{'vendor'} = main::cleaner($devices{$key}{'vendor'});
10548                 }
10549                 if ($show{'optical'} && @info){
10550                         my $index = 0;
10551                         foreach my $item (@info){
10552                                 next if $item =~ /^\s*$/;
10553                                 my @split = split '\s+', $item;
10554                                 if ($item =~ /^drive name:/){
10555                                         foreach my $id (@split){
10556                                                 last if ($id eq $key);
10557                                                 $index++;
10558                                         }
10559                                         last if ! $index; # index will be > 0 if it was found
10560                                 }
10561                                 elsif ($item =~/^drive speed:/) {
10562                                         $devices{$key}{'speed'} = $split[$index];
10563                                 }
10564                                 elsif ($item =~/^Can read multisession:/) {
10565                                         $devices{$key}{'multisession'}=$split[$index+1];
10566                                 }
10567                                 elsif ($item =~/^Can read MCN:/) {
10568                                         $devices{$key}{'mcn'}=$split[$index+1];
10569                                 }
10570                                 elsif ($item =~/^Can play audio:/) {
10571                                         $devices{$key}{'audio'}=$split[$index+1];
10572                                 }
10573                                 elsif ($item =~/^Can write CD-R:/) {
10574                                         $devices{$key}{'cdr'}=$split[$index+1];
10575                                 }
10576                                 elsif ($item =~/^Can write CD-RW:/) {
10577                                         $devices{$key}{'cdrw'}=$split[$index+1];
10578                                 }
10579                                 elsif ($item =~/^Can read DVD:/) {
10580                                         $devices{$key}{'dvd'}=$split[$index+1];
10581                                 }
10582                                 elsif ($item =~/^Can write DVD-R:/) {
10583                                         $devices{$key}{'dvdr'}=$split[$index+1];
10584                                 }
10585                                 elsif ($item =~/^Can write DVD-RAM:/) {
10586                                         $devices{$key}{'dvdram'}=$split[$index+1];
10587                                 }
10588                         }
10589                 }
10590         }
10591         main::log_data('dump','%devices',\%devices) if $b_log;
10592         #print Data::Dumper::Dumper \%devices;
10593         @rows = create_output(%devices) if %devices;
10594         eval $end if $b_log;
10595         return @rows;
10596 }
10597
10598 }
10599
10600 ## PartitionData
10601 {
10602 package PartitionData;
10603
10604 sub get {
10605         eval $start if $b_log;
10606         my (@rows,$key1,$val1);
10607         my $num = 0;
10608         partition_data() if !$b_partitions;
10609         if (!@partitions) {
10610                 $key1 = 'Message';
10611                 #$val1 = ($bsd_type && $bsd_type eq 'darwin') ?
10612                 # main::row_defaults('darwin-feature') : main::row_defaults('partition-data');
10613                 $val1 = main::row_defaults('partition-data');
10614                 @rows = ({main::key($num++,$key1) => $val1,});
10615         }
10616         else {
10617                 @rows = create_output();
10618         }
10619         eval $end if $b_log;
10620         return @rows;
10621 }
10622 sub create_output {
10623         eval $start if $b_log;
10624         my $num = 0;
10625         my $j = 0;
10626         my (@data,@data2,%part,@rows,$dev,$dev_type,$fs);
10627         @partitions = sort { $a->{'id'} cmp $b->{'id'} } @partitions;
10628         foreach my $ref (@partitions){
10629                 my %row = %$ref;
10630                 $num = 1;
10631                 next if $row{'type'} eq 'secondary' && $show{'partition'};
10632                 @data2 = main::get_size($row{'size'}) if (defined $row{'size'});
10633                 my $size = (@data2) ? $data2[0] . ' ' . $data2[1]: 'N/A';
10634                 @data2 = main::get_size($row{'used'}) if (defined $row{'used'});
10635                 my $used = (@data2) ? $data2[0] . ' ' . $data2[1]: 'N/A';
10636                 my $percent = (defined $row{'percent-used'}) ? ' (' . $row{'percent-used'} . '%)' : '';
10637                 %part = ();
10638                 if (defined $row{'dev-base'}){
10639                         if ($row{'dev-base'} =~ /^non-dev-/){
10640                                 $row{'dev-base'} =~ s/^non-dev-//;
10641                                 $dev_type = 'raid';
10642                                 $dev = $row{'dev-base'};
10643                         }
10644                         # note: I have seen this: beta:data/ for sshfs path
10645                         elsif ($row{'dev-base'} =~ /^\/\/|:\//){
10646                                 $dev_type = 'remote';
10647                                 $dev = $row{'dev-base'};
10648                         }
10649                         # an error has occurred almost for sure
10650                         elsif (!$row{'dev-base'}){
10651                                 $dev_type = 'dev';
10652                                 $dev = main::row_defaults('unknown-dev');
10653                         }
10654                         else {
10655                                 $dev_type = 'dev';
10656                                 $dev = '/dev/' . $row{'dev-base'};
10657                         }
10658                 }
10659                 else {
10660                         $dev_type = 'dev';
10661                 }
10662                 $fs = ($row{'fs'}) ? lc($row{'fs'}): 'N/A';
10663                 $dev ||= 'N/A';
10664                 $j = scalar @rows;
10665                 @data = ({
10666                 main::key($num++,'ID') => $row{'id'},
10667                 main::key($num++,'size') => $size,
10668                 main::key($num++,'used') => $used . $percent,
10669                 main::key($num++,'fs') => $fs,
10670                 main::key($num++,$dev_type) => $dev,
10671                 });
10672                 @rows = (@rows,@data);
10673                 if ($show{'label'}){
10674                         $rows[$j]{main::key($num++,'label')} = ($row{'label'}) ? $row{'label'}: 'N/A';
10675                 }
10676                 if ($show{'uuid'}){
10677                         $rows[$j]{main::key($num++,'uuid')} = ($row{'uuid'}) ? $row{'uuid'}: 'N/A';
10678                 }
10679         }
10680         eval $end if $b_log;
10681         return @rows;
10682 }
10683
10684 sub partition_data {
10685         eval $start if $b_log;
10686         #return if $bsd_type && $bsd_type eq 'darwin'; # darwin has muated output, of course
10687         my (@data,@rows,@mapper,@mount,@partitions_working,%part);
10688         my ($b_fake_map,$b_fs,$b_load,$cols,$roots) = (0,1,0,6,0);
10689         my ($back_size,$back_used) = (4,3);
10690         my ($dev_base,$fs,$id,$label,$percent_used,$size,$type,$uuid,$used);
10691         $b_partitions = 1;
10692         set_lsblk() if !$bsd_type && !$b_lsblk;
10693         # set labels, uuid, gpart
10694         set_label_uuid() if !$b_label_uuid;
10695         # most current OS support -T and -k, but -P means different things
10696         # in freebsd. However since most use is from linux, we make that default
10697         if (!$bsd_type){
10698                 @partitions_working = main::grabber("df -P -T -k 2>/dev/null");
10699                 if (-d '/dev/mapper'){
10700                         @mapper = main::globber('/dev/mapper/*');
10701                 }
10702         }
10703         else {
10704                 # this is missing the file system data
10705                 if ($bsd_type ne 'darwin'){
10706                         @partitions_working = main::grabber("df -T -k 2>/dev/null");
10707                 }
10708                 #Filesystem 1024-blocks Used Available Capacity iused ifree %iused Mounted on
10709                 else {
10710                         $cols = 8;
10711                         $b_fake_map = 1;
10712                         ($back_size,$back_used) = (7,6);
10713                 }
10714         }
10715         # busybox only supports -k and -P, openbsd, darwin
10716         if (!@partitions_working){
10717                 @partitions_working = main::grabber("df -k 2>/dev/null");
10718                 $b_fs = 0;
10719                 $cols = 5 if !$bsd_type || $bsd_type ne 'darwin';
10720                 if (my $path = main::check_program('mount')){
10721                         @mount = main::grabber("$path 2>/dev/null");
10722                 }
10723         }
10724         # determine positions
10725         my $row1 = shift @partitions_working;
10726         # new kernels/df have rootfs and / repeated, creating two entries for the same partition
10727         # so check for two string endings of / then slice out the rootfs one, I could check for it
10728         # before slicing it out, but doing that would require the same action twice re code execution
10729         foreach (@partitions_working){
10730                 if (/\s\/$/){
10731                         $roots++;
10732                 }
10733         }
10734         @partitions_working = grep {!/^rootfs/} @partitions_working if $roots > 1;
10735         my $filters = '^(aufs|cgroup.*|cgmfs|configfs|debugfs|\/dev|dev|\/dev/loop[0-9]*|';
10736         $filters .= 'devfs|devtmpfs|fdescfs|iso9660|linprocfs|none|procfs|\/run(\/.*)?|';
10737         $filters .= 'run|shm|squashfs|sys|\/sys\/.*|sysfs|tmpfs|type|udev|unionfs|vartmp)$';
10738         foreach (@partitions_working){
10739                 # stupid apple bullshit
10740                 $_ =~ s/^map\s+([\S]+)/map:\/$1/ if $b_fake_map;
10741                 my @row = split /\s+/, $_;
10742                 if ($row[0] =~ /$filters/ || $row[0] =~ /^ROOT/i || ($b_fs && $row[1] eq 'tmpfs')){
10743                         next;
10744                 }
10745                 $dev_base = '';
10746                 $fs = '';
10747                 $id = '';
10748                 $label = '';
10749                 $size = 0;
10750                 $used = 0;
10751                 %part = ();
10752                 $percent_used = 0;
10753                 $type = '';
10754                 $uuid = '';
10755                 $b_load = 0;
10756                 # NOTE: using -P for linux fixes line wraps, and for bsds, assuming they don't use such long file names
10757                 if ($row[0] =~ /^\/dev\/|:\/|\/\//){
10758                         # this could point to by-label or by-uuid so get that first. In theory, abs_path should
10759                         # drill down to get the real path, but it isn't always working.
10760                         if ($row[0] eq '/dev/root'){
10761                                 $row[0] = get_root();
10762                         }
10763                         # sometimes paths are set using /dev/disk/by-[label|uuid] so we need to get the /dev/xxx path
10764                         if ($row[0] =~ /by-label|by-uuid/){
10765                                 $row[0] = Cwd::abs_path($row[0]);
10766                         }
10767                         elsif ($row[0] =~ /mapper\// && @mapper){
10768                                 $row[0] = get_mapper($row[0],@mapper);
10769                         }
10770                         $dev_base = $row[0];
10771                         $dev_base =~ s/^\/dev\///;
10772                         %part = check_lsblk($dev_base,0) if @lsblk;
10773                 }
10774                 # this handles zfs type devices/partitions, which do not start with / but contain /
10775                 # note: Main/jails/transmission_1 path can be > 1 deep
10776                 # Main zfs 3678031340 8156 3678023184 0% /mnt/Main
10777                 if (!$dev_base && ($row[0] =~ /^([^\/]+\/)(.+)/ || ($row[0] =~ /^[^\/]+$/ && $row[1] =~ /^(btrfs|zfs)$/ ) ) ){
10778                         $dev_base = "non-dev-$row[0]";
10779                 }
10780                 # this handles yet another fredforfaen special case where a mounted drive
10781                 # has the search string in its name
10782                 if ($row[-1] =~ /^\/$|^\/boot$|^\/var$|^\/var\/tmp$|^\/var\/log$|^\/home$|^\/opt$|^\/tmp$|^\/usr$/){
10783                         $b_load = 1;
10784                         # note, older df in bsd do not have file system column
10785                         $type = 'main';
10786                 }
10787                 elsif ($row[$cols] !~ /^\/$|^\/boot$|^\/var$|^\/var\/tmp$|^\/var\/log$|^\/home$|^\/opt$|^\/tmp$|^\/usr$|^filesystem/){
10788                         $b_load = 1;
10789                         $type = 'secondary';
10790                 }
10791                 if ($b_load){
10792                         if (!$bsd_type){
10793                                 if ($b_fs){
10794                                         $fs = (%part && $part{'fs'}) ? $part{'fs'} : $row[1];
10795                                 }
10796                                 else {
10797                                         $fs = get_mounts_fs($row[0],@mount);
10798                                 }
10799                                 if ($show{'label'}) {
10800                                         if (%part && $part{'label'}) {
10801                                                 $label = $part{'label'};
10802                                         }
10803                                         elsif ( @labels){
10804                                                 $label = get_label($row[0]);
10805                                         }
10806                                 }
10807                                 if ($show{'uuid'}) {
10808                                         if (%part && $part{'uuid'}) {
10809                                                 $uuid = $part{'uuid'};
10810                                         }
10811                                         elsif ( @uuids){
10812                                                 $uuid = get_uuid($row[0]);
10813                                         }
10814                                 }
10815                         }
10816                         else {
10817                                 $fs = ($b_fs) ? $row[1]: get_mounts_fs($row[0],@mount);
10818                                 if (@gpart && ($show{'label'} || $show{'uuid'} ) ){
10819                                         my @extra = get_bsd_label_uuid("$dev_base");
10820                                         if (@extra){
10821                                                 $label = $extra[0];
10822                                                 $uuid = $extra[1];
10823                                         }
10824                                 }
10825                         }
10826                         $id = join ' ', @row[$cols .. $#row];
10827                         $id =~ s/\/home\/[^\/]+\/(.*)/\/home\/$filter_string\/$1/ if $show{'filter'};
10828                         $size = $row[$cols - $back_size];
10829                         $used = $row[$cols - $back_used];
10830                         $percent_used = sprintf( "%.1f", ( $used/$size )*100 ) if ($size);
10831                         @data = ({
10832                         'id' => $id,
10833                         'dev-base' => $dev_base,
10834                         'fs' => $fs,
10835                         'label' => $label,
10836                         'size' => $size,
10837                         'type' => $type,
10838                         'used' => $used,
10839                         'uuid' => $uuid,
10840                         'percent-used' => $percent_used,
10841                         });
10842                         @partitions = (@partitions,@data);
10843                 }
10844         }
10845         @data = swap_data();
10846         @partitions = (@partitions,@data);
10847         main::log_data('dump','@partitions',\@partitions) if $b_log;
10848         # print Data::Dumper::Dumper \@partitions;
10849         eval $end if $b_log;
10850 }
10851
10852 sub swap_data {
10853         eval $start if $b_log;
10854         my (@swap,@working,$path,$label,$uuid);
10855         my ($s,$j,$size_id,$used_id) = (1,0,2,3);
10856         if (!$bsd_type){
10857                 # faster, avoid subshell, same as swapon -s
10858                 if ( -r '/proc/swaps'){
10859                         @working = main::reader("/proc/swaps");
10860                 }
10861                 elsif ( $path = main::check_program('swapon') ){
10862                         # note: while -s is deprecated, --show --bytes is not supported
10863                         # on older systems
10864                         @working = main::grabber("$path -s 2>/dev/null");
10865                 }
10866         }
10867         else {
10868                 if ( $path = main::check_program('swapctl') ){
10869                         # output in in KB blocks
10870                         @working = main::grabber("$path -l -k 2>/dev/null");
10871                 }
10872                 ($size_id,$used_id) = (1,2);
10873         }
10874         # now add the swap partition data, don't want to show swap files, just partitions,
10875         # though this can include /dev/ramzswap0. Note: you can also use /proc/swaps for this
10876         # data, it's the same exact output as swapon -s
10877         foreach (@working){
10878                 next if ! /^\/dev/ || /^\/dev\/(ramzwap|zram)/;
10879                 my @data = split /\s+/, $_;
10880                 my $dev_base = $data[0];
10881                 $dev_base =~ s/^\/dev\///;
10882                 my $size = $data[$size_id];
10883                 my $used = $data[$used_id];
10884                 my $percent_used = sprintf( "%.1f", ( $used/$size )*100 );
10885                 if ($show{'label'} && @labels){
10886                         $label = get_label($data[0]);
10887                 }
10888                 if ($show{'uuid'} && @uuids){
10889                         $uuid = get_uuid($data[0]);
10890                 }
10891                 if ($bsd_type && @gpart && ($show{'label'} || $show{'uuid'} ) ){
10892                         my @extra = get_bsd_label_uuid("$dev_base");
10893                         if (@extra){
10894                                 $label = $extra[0];
10895                                 $uuid = $extra[1];
10896                         }
10897                 }
10898                 @data = ({
10899                 'id' => "swap-$s",
10900                 'dev-base' => $dev_base,
10901                 'fs' => 'swap',
10902                 'label' => $label,
10903                 'size' => $size,
10904                 'type' => 'main',
10905                 'used' => $used,
10906                 'uuid' => $uuid,
10907                 'percent-used' => $percent_used,
10908                 });
10909                 @swap = (@swap,@data);
10910                 $s++;
10911         }
10912         eval $end if $b_log;
10913         return @swap;
10914 }
10915 sub get_mounts_fs {
10916         eval $start if $b_log;
10917         my ($item,@mount) = @_;
10918         $item =~ s/map:\/(\S+)/map $1/ if $bsd_type && $bsd_type eq 'darwin';
10919         return 'N/A' if ! @mount;
10920         my ($fs) = ('');
10921         # linux: /dev/sdb6 on /var/www/m type ext4 (rw,relatime,data=ordered)
10922         # /dev/sda3 on /root.dev/ugw type ext3 (rw,relatime,errors=continue,user_xattr,acl,barrier=1,data=journal)
10923         # bsd: /dev/ada0s1a on / (ufs, local, soft-updates)
10924         foreach (@mount){
10925                 if ($bsd_type && $_ =~ /^$item\son.*\(([^,\s\)]+)[,\s]*.*\)/){
10926                         $fs = $1;
10927                         last;
10928                 }
10929                 elsif (!$bsd_type && $_ =~ /^$item\son.*\stype\s([\S]+)\s\([^\)]+\)/){
10930                         $fs = $1;
10931                         last;
10932                 }
10933         }
10934         eval $end if $b_log;
10935         main::log_data('data',"fs: $fs") if $b_log;
10936         return $fs;
10937 }
10938 # 1. Name: ada1p1
10939 #   label: (null)
10940 #   label: ssd-root
10941 #   rawuuid: b710678b-f196-11e1-98fd-021fc614aca9
10942 sub get_bsd_label_uuid {
10943         eval $start if $b_log;
10944         my ($item) = @_;
10945         my (@data,$b_found);
10946         foreach (@gpart){
10947                 my @working = split /\s*:\s*/, $_;
10948                 if ($_ =~ /^[0-9]+\.\sName:/ && $working[1] eq $item){
10949                         $b_found = 1;
10950                 }
10951                 elsif ($_ =~ /^[0-9]+\.\sName:/ && $working[1] ne $item){
10952                         $b_found = 0;
10953                 }
10954                 if ($b_found){
10955                         if ($working[0] eq 'label'){
10956                                 $data[0] = $working[1];
10957                                 $data[0] =~ s/\(|\)//g; # eg: label:(null) - we want to show null
10958                         }
10959                         if ($working[0] eq 'rawuuid'){
10960                                 $data[1] = $working[1];
10961                                 $data[0] =~ s/\(|\)//g;
10962                         }
10963                 }
10964         }
10965         main::log_data('dump','@data',\@data) if $b_log;
10966         eval $end if $b_log;
10967         return @data;
10968 }
10969 sub set_label_uuid {
10970         eval $start if $b_log;
10971         $b_label_uuid = 1;
10972         if ( $show{'unmounted'} || $show{'label'} || $show{'uuid'} ){
10973                 if (!$bsd_type){
10974                         if (-d '/dev/disk/by-label'){
10975                                 @labels = main::globber('/dev/disk/by-label/*');
10976                         }
10977                         if (-d '/dev/disk/by-uuid'){
10978                                 @uuids = main::globber('/dev/disk/by-uuid/*');
10979                         }
10980                 }
10981                 else {
10982                         if ( my $path = main::check_program('gpart')){
10983                                 @gpart = main::grabber("$path list 2>/dev/null",'strip');
10984                         }
10985                 }
10986         }
10987         eval $end if $b_log;
10988 }
10989 sub set_lsblk {
10990         eval $start if $b_log;
10991         $b_lsblk = 1;
10992         my (@temp,@working);
10993         if (my $program = main::check_program('lsblk')){
10994                 @working = main::grabber("$program -bP --output NAME,TYPE,RM,FSTYPE,SIZE,LABEL,UUID,SERIAL,MOUNTPOINT 2>/dev/null");
10995                 foreach (@working){
10996                         if (/NAME="([^"]*)"\s+TYPE="([^"]*)"\s+RM="([^"]*)"\s+FSTYPE="([^"]*)"\s+SIZE="([^"]*)"\s+LABEL="([^"]*)"\s+UUID="([^"]*)"\s+SERIAL="([^"]*)"\s+MOUNTPOINT="([^"]*)"/){
10997                                 my $size = ($5) ? $5/1024: 0;
10998                                 # some versions of lsblk do not return serial, fs, uuid, or label
10999                                 my @temp = ({
11000                                 'name' => $1,
11001                                 'type' => $2,
11002                                 'rm' => $3,
11003                                 'fs' => $4,
11004                                 'size' => $size,
11005                                 'label' => $6,
11006                                 'uuid' => $7,
11007                                 'serial' => $8,
11008                                 'mount' => $9,
11009                                 });
11010                                 @lsblk = (@lsblk,@temp);
11011                         }
11012                 }
11013         }
11014         # print Data::Dumper::Dumper \@lsblk;
11015         main::log_data('dump','@lsblk',\@lsblk) if $b_log;
11016         eval $end if $b_log;
11017 }
11018 sub check_lsblk {
11019         eval $start if $b_log;
11020         my ($name,$b_size) = @_;
11021         my (%part,@row);
11022         foreach my $ref (@lsblk){
11023                 my %row = %$ref;
11024                 next if ! $row{'name'};
11025                 if ($name eq $row{'name'}){
11026                         %part = %row;
11027                         last;
11028                 }
11029         }
11030         # print Data::Dumper::Dumper \%part;
11031         main::log_data('dump','%part',\%part) if $b_log;
11032         eval $end if $b_log;
11033         return %part;
11034 }
11035 sub get_label {
11036         eval $start if $b_log;
11037         my ($item) = @_;
11038         my $label = '';
11039         foreach (@labels){
11040                 if ($item eq Cwd::abs_path($_)){
11041                         $label = $_;
11042                         $label =~ s/\/dev\/disk\/by-label\///;
11043                         $label =~ s/\\x20/ /g;
11044                         $label =~ s%\\x2f%/%g;
11045                         last;
11046                 }
11047         }
11048         $label ||= 'N/A';
11049         eval $end if $b_log;
11050         return $label;
11051 }
11052 # args: $1 - dev item $2 - @mapper
11053 # check for mapper, then get actual dev item if mapped
11054 # /dev/mapper/ will usually be a symbolic link to the real /dev id
11055 sub get_mapper {
11056         eval $start if $b_log;
11057         my ($item,@mapper) = @_;
11058         my $mapped = '';
11059         foreach (@mapper){
11060                 if ($item eq $_){
11061                         my $temp = Cwd::abs_path($_);
11062                         $mapped = $temp if $temp;
11063                         last;
11064                 }
11065         }
11066         $mapped ||= $item;
11067         eval $end if $b_log;
11068         return $mapped;
11069 }
11070 sub get_root {
11071         eval $start if $b_log;
11072         my ($path) = ('/dev/root');
11073         # note: the path may be a symbolic link to by-label/by-uuid but not
11074         # sure how far in abs_path resolves the path.
11075         my $temp = Cwd::abs_path($path);
11076         $path = $temp if $temp;
11077         # note: it's a kernel config option to have /dev/root be a sym link
11078         # or not, if it isn't, path will remain /dev/root, if so, then try mount
11079         if ($path eq '/dev/root' && (my $program = main::check_program('mount'))){
11080                 my @data = main::grabber("$program 2>/dev/null");
11081                 # /dev/sda2 on / type ext4 (rw,noatime,data=ordered)
11082                 foreach (@data){
11083                         if (/^([\S]+)\son\s\/\s/){
11084                                 $path = $1;
11085                                 # note: we'll be handing off any uuid/label paths to the next
11086                                 # check tools after get_root() above, so don't trim those.
11087                                 $path =~ s/.*\/// if $path !~ /by-uuid|by-label/;
11088                                 last;
11089                         }
11090                 }
11091         }
11092         eval $end if $b_log;
11093         return $path;
11094 }
11095
11096 sub get_uuid {
11097         eval $start if $b_log;
11098         my ($item) = @_;
11099         my $uuid = '';
11100         foreach (@uuids){
11101                 if ($item eq Cwd::abs_path($_)){
11102                         $uuid = $_;
11103                         $uuid =~ s/\/dev\/disk\/by-uuid\///;
11104                         last;
11105                 }
11106         }
11107         $uuid ||= 'N/A';
11108         eval $end if $b_log;
11109         return $uuid;
11110 }
11111 }
11112
11113 ## ProcessData
11114 {
11115 package ProcessData;
11116
11117 sub get {
11118         eval $start if $b_log;
11119         my (@processes,@rows);
11120         if ($show{'ps-cpu'}){
11121                 @rows = cpu_processes();
11122                 @processes = (@processes,@rows);
11123         }
11124         if ($show{'ps-mem'}){
11125                 @rows = mem_processes();
11126                 @processes = (@processes,@rows);
11127         }
11128         return @processes;
11129         eval $end if $b_log;
11130 }
11131 sub cpu_processes {
11132         eval $start if $b_log;
11133         my ($j,$num,$cpu,$cpu_mem,$mem) = (0,0,'','','');
11134         my (@processes);
11135         my $count = ($b_irc)? 5: $ps_count;
11136         my @rows = sort {
11137                 my @a = split(/\s+/,$a);
11138                 my @b = split(/\s+/,$b);
11139                 $b[2] <=> $a[2] } @ps_aux;
11140         # if there's a count limit, for irc, etc, only use that much of the data
11141         @rows = splice @rows,0,$count;
11142
11143         $j = scalar @rows;
11144         # $cpu_mem = ' - Memory: MiB / % used' if $extra > 0;
11145         my $throttled = throttled($ps_count,$count,$j);
11146         #my $header = "CPU  % used - Command - pid$cpu_mem - top";
11147         #my $header = "Top $count by CPU";
11148         my @data = ({
11149         main::key($num++,'CPU top') => "$count$throttled",
11150         },);
11151         @processes = (@processes,@data);
11152         my $i = 1;
11153         foreach (@rows){
11154                 $num = 1;
11155                 $j = scalar @processes;
11156                 my @row = split /\s+/, $_;
11157                 my @command = process_starter(scalar @row, $row[10],$row[11]);
11158                 @data = ({
11159                 main::key($num++,$i++) => '',
11160                 main::key($num++,'cpu') => $row[2] . '%',
11161                 main::key($num++,'command') => $command[0],
11162                 },);
11163                 @processes = (@processes,@data);
11164                 if ($command[1]) {
11165                         $processes[$j]{main::key($num++,'started by')} = $command[1];
11166                 }
11167                 $processes[$j]{main::key($num++,'pid')} = $row[1];
11168                 if ($extra > 0){
11169                         my $decimals = ($row[5]/1024 > 10 ) ? 1 : 2;
11170                         $mem = (defined $row[5]) ? sprintf( "%.${decimals}f", $row[5]/1024 ) . ' MiB' : 'N/A';
11171                         $mem .= ' (' . $row[3] . '%)';
11172                         $processes[$j]{main::key($num++,'mem')} = $mem;
11173                 }
11174                 #print Data::Dumper::Dumper \@processes, "i: $i; j: $j ";
11175         }
11176         eval $end if $b_log;
11177         return @processes;
11178 }
11179 sub mem_processes {
11180         eval $start if $b_log;
11181         my ($j,$num,$cpu,$cpu_mem,$mem) = (0,0,'','','');
11182         my (@data,@processes,$memory);
11183         my $count = ($b_irc)? 5: $ps_count;
11184         my @rows = sort {
11185                 my @a = split(/\s+/,$a);
11186                 my @b = split(/\s+/,$b);
11187                 $b[5] <=> $a[5] } @ps_aux;
11188         @rows = splice @rows,0,$count;
11189         #print Data::Dumper::Dumper \@rows;
11190         @processes = main::memory_data_full('process') if !$b_mem;
11191         $j = scalar @rows;
11192         my $throttled = throttled($ps_count,$count,$j);
11193         #$cpu_mem = ' - CPU: % used' if $extra > 0;
11194         #my $header = "Memory MiB/% used - Command - pid$cpu_mem - top";
11195         #my $header = "Top $count by Memory";
11196         @data = ({
11197         main::key($num++,'Memory top') => "$count$throttled",
11198         },);
11199         @processes = (@processes,@data);
11200         my $i = 1;
11201         foreach (@rows){
11202                 $num = 1;
11203                 $j = scalar @processes;
11204                 my @row = split /\s+/, $_;
11205                 my $decimals = ($row[5]/1024 > 10 ) ? 1 : 2;
11206                 $mem = ($row[5]) ? sprintf( "%.${decimals}f", $row[5]/1024 ) . ' MiB' : 'N/A';
11207                 my @command = process_starter(scalar @row, $row[10],$row[11]);
11208                 $mem .= " (" . $row[3] . "%)";
11209                 @data = ({
11210                 main::key($num++,$i++) => '',
11211                 main::key($num++,'mem') => $mem,
11212                 main::key($num++,'command') => $command[0],
11213                 },);
11214                 @processes = (@processes,@data);
11215                 if ($command[1]) {
11216                         $processes[$j]{main::key($num++,'started by')} = $command[1];
11217                 }
11218                 $processes[$j]{main::key($num++,'pid')} = $row[1];
11219                 if ($extra > 0){
11220                         $cpu = $row[2] . '%';
11221                         $processes[$j]{main::key($num++,'cpu')} = $cpu;
11222                 }
11223                 #print Data::Dumper::Dumper \@processes, "i: $i; j: $j ";
11224         }
11225         eval $end if $b_log;
11226         return @processes;
11227 }
11228 sub process_starter {
11229         my ($count, $row10, $row11) = @_;
11230         my (@return);
11231         # note: [migration/0] would clear with a simple basename
11232         if ($count > 11 && $row11 =~ /^\//){
11233                 $row11 =~ s/^\/.*\///;
11234                 $return[0] = $row11;
11235                 $row10 =~ s/^\/.*\///;
11236                 $return[1] = $row10;
11237         }
11238         else {
11239                 $row10 =~ s/^\/.*\///;
11240                 $return[0] = $row10;
11241                 $return[1] = '';
11242         }
11243         return @return;
11244 }
11245 sub throttled {
11246         my ($ps_count,$count,$j) = @_;
11247         my $throttled = '';
11248         if ($count > $j){
11249                 $throttled = " ( $j processes)";
11250         }
11251         elsif ($count < $ps_count){
11252                 $throttled = " (throttled from $ps_count)";
11253         }
11254         return $throttled;
11255 }
11256 }
11257
11258 ## RaidData
11259 {
11260 package RaidData;
11261 # debugger switches
11262 my ($b_md,$b_zfs);
11263
11264 sub get {
11265         eval $start if $b_log;
11266         my (@rows,$key1,$val1);
11267         my $num = 0;
11268         raid_data() if !$b_raid;
11269         #print 'get: ', Data::Dumper::Dumper \@raid;
11270         if (!@raid && !@hardware_raid){
11271                 if ($show{'raid-forced'}){
11272                         $key1 = 'Message';
11273                         $val1 = main::row_defaults('raid-data');
11274                 }
11275         }
11276         else {
11277                 @rows = create_output();
11278         }
11279         if (!@rows && $key1){
11280                 @rows = ({main::key($num++,$key1) => $val1,});
11281         }
11282         eval $end if $b_log;
11283         ($b_md,$b_zfs,@hardware_raid) = undef;
11284         return @rows;
11285 }
11286 sub create_output {
11287         eval $start if $b_log;
11288         my (@arrays,@arrays_holder,@components,@components_good,@data,@failed,@rows,
11289         @sizes,@spare,@temp);
11290         my ($allocated,$available,$blocks_avail,$chunk_raid,$component_string,$raid,
11291         $ref2,$ref3,$report_size,$size,$status);
11292         my ($b_row_1_sizes);
11293         my ($i,$j,$num,$status_id) = (0,0,0,0);
11294         #print Data::Dumper::Dumper \@raid;
11295         if (@hardware_raid){
11296                 foreach my $ref (@hardware_raid){
11297                         my %row = %$ref;
11298                         $num = 1;
11299                         my $device = ($row{'device'}) ? $row{'device'}: 'N/A';
11300                         my $driver = ($row{'driver'}) ? $row{'driver'}: 'N/A';
11301                         @data = ({
11302                         main::key($num++,'Hardware') => $device,
11303                         });
11304                         @rows = (@rows,@data);
11305                         $j = scalar @rows - 1;
11306                         $rows[$j]{main::key($num++,'vendor')} = $row{'vendor'} if $row{'vendor'};
11307                         $rows[$j]{main::key($num++,'driver')} = $driver;
11308                         if ($extra > 0){
11309                                 my $driver_version = ($row{'driver-version'}) ?  $row{'driver-version'}: 'N/A' ;
11310                                 $rows[$j]{main::key($num++,'v')} = $driver_version;
11311                                 if ($extra > 2){
11312                                         my $port= ($row{'port'}) ? $row{'port'}: 'N/A' ;
11313                                         $rows[$j]{main::key($num++,'port')} = $port;
11314                                 }
11315                                 my $bus_id = (defined $row{'bus-id'} && defined $row{'sub-id'}) ?  "$row{'bus-id'}.$row{'sub-id'}": 'N/A' ;
11316                                 $rows[$j]{main::key($num++,'bus ID')} = $bus_id;
11317                         }
11318                         if ($extra > 1){
11319                                 my $chip_id = (defined $row{'vendor-id'} && defined $row{'chip-id'}) ?  "$row{'vendor-id'}.$row{'chip-id'}": 'N/A' ;
11320                                 $rows[$j]{main::key($num++,'chip ID')} = $chip_id;
11321                         }
11322                         if ($extra > 2){
11323                                 my $rev= (defined $row{'rev'} && $row{'rev'}) ? $row{'rev'}: 'N/A' ;
11324                                 $rows[$j]{main::key($num++,'rev')} = $rev;
11325                         }
11326                 }
11327         }
11328         if ($extra > 2 && $raid[0]{'system-supported'}){
11329                 @data = ({
11330                 main::key($num++,'Supported md-raid types') => $raid[0]{'system-supported'},
11331                 });
11332                 @rows = (@rows,@data);
11333         }
11334         foreach my $ref (@raid){
11335                 $j = scalar @rows;
11336                 my %row = %$ref;
11337                 $b_row_1_sizes = 0;
11338                 next if !%row;
11339                 $num = 1;
11340                 @data = ({
11341                 main::key($num++,'Device') => $row{'id'},
11342                 main::key($num++,'type') => $row{'type'},
11343                 main::key($num++,'status') => $row{'status'},
11344                 });
11345                 @rows = (@rows,@data);
11346                 if ($row{'type'} eq 'mdraid'){
11347                         $blocks_avail = 'blocks';
11348                         $chunk_raid = 'chunk size';
11349                         $report_size = 'report';
11350                         if ($extra > 0){
11351                                 $available = ($row{'blocks'}) ? $row{'blocks'} : 'N/A';
11352                         }
11353                         $size = ($row{'report'}) ? $row{'report'}: '';
11354                         $size .= " $row{'u-data'}" if $size;
11355                         $size ||= 'N/A';
11356                         $status_id = 2;
11357                 }
11358                 else {
11359                         $blocks_avail = 'free';
11360                         $chunk_raid = 'allocated';
11361                         $report_size = 'size';
11362                         @sizes = ($row{'size'}) ? main::get_size($row{'size'}) : ();
11363                         $size = (@sizes) ? "$sizes[0] $sizes[1]" : '';
11364                         @sizes = ($row{'free'}) ? main::get_size($row{'free'}) : ();
11365                         $available = (@sizes) ? "$sizes[0] $sizes[1]" : '';
11366                         if ($extra > 2){
11367                                 @sizes = ($row{'allocated'}) ? main::get_size($row{'allocated'}) : ();
11368                                 $allocated = (@sizes) ? "$sizes[0] $sizes[1]" : '';
11369                         }
11370                         $status_id = 1;
11371                 }
11372                 $ref2 = $row{'arrays'};
11373                 @arrays = @$ref2;
11374                 @arrays = grep {defined $_} @arrays;
11375                 @arrays_holder = @arrays;
11376                 if (($row{'type'} eq 'mdraid' && $extra == 0 ) || !defined $arrays[0]{'raid'} ){
11377                         $raid = (defined $arrays[0]{'raid'}) ? $arrays[0]{'raid'}: 'no-raid';
11378                         $rows[$j]{main::key($num++,'raid')} = $raid;
11379                 }
11380                 if ( ( $row{'type'} eq 'zfs' || ($row{'type'} eq 'mdraid' && $extra == 0 ) ) && $size){
11381                         #print "here 0\n";
11382                         $rows[$j]{main::key($num++,$report_size)} = $size;
11383                         $size = '';
11384                         $b_row_1_sizes = 1;
11385                 }
11386                 if ( $row{'type'} eq 'zfs' && $available){
11387                         $rows[$j]{main::key($num++,$blocks_avail)} = $available;
11388                         $available = '';
11389                         $b_row_1_sizes = 1;
11390                 }
11391                 if ( $row{'type'} eq 'zfs' && $allocated){
11392                         $rows[$j]{main::key($num++,$chunk_raid)} = $allocated;
11393                         $allocated = '';
11394                 }
11395                 $i = 0;
11396                 my $count = scalar @arrays;
11397                 foreach $ref3 (@arrays){
11398                         my %row2 = %$ref3;
11399                         if ($count > 1){
11400                                 $j = scalar @rows;
11401                                 $num = 1;
11402                                 @sizes = ($row2{'size'}) ? main::get_size($row2{'size'}) : ();
11403                                 $size = (@sizes) ? "$sizes[0] $sizes[1]" : 'N/A';
11404                                 @sizes = ($row2{'free'}) ? main::get_size($row2{'free'}) : ();
11405                                 $available = (@sizes) ? "$sizes[0] $sizes[1]" : '';
11406                                 $raid = (defined $row2{'raid'}) ? $row2{'raid'}: 'no-raid';
11407                                 $status = ($row2{'status'}) ? $row2{'status'}: 'N/A';
11408                                 @data = ({
11409                                 main::key($num++,'array') => $raid,
11410                                 main::key($num++,'status') => $status,
11411                                 main::key($num++,'size') => $size,
11412                                 main::key($num++,'free') => $available,
11413                                 });
11414                                 @rows = (@rows,@data);
11415                         }
11416                         # items like cache may have one component, with a size on that component
11417                         elsif (!$b_row_1_sizes && $row{'type'} eq 'zfs'){
11418                                 #print "here $count\n";
11419                                 @sizes = ($row2{'size'}) ? main::get_size($row2{'size'}) : ();
11420                                 $size = (@sizes) ? "$sizes[0] $sizes[1]" : '';
11421                                 @sizes = ($row2{'free'}) ? main::get_size($row2{'free'}) : ();
11422                                 $available = (@sizes) ? "$sizes[0] $sizes[1]" : '';
11423                                 $rows[$j]{main::key($num++,'size')} = $size;
11424                                 $rows[$j]{main::key($num++,'free')} = $available;
11425                                 if ($extra > 2){
11426                                         @sizes = ($row{'allocated'}) ? main::get_size($row2{'allocated'}) : ();
11427                                         $allocated = (@sizes) ? "$sizes[0] $sizes[1]" : '';
11428                                         if ($allocated){
11429                                                 $rows[$j]{main::key($num++,$chunk_raid)} = $allocated;
11430                                         }
11431                                 }
11432                         }
11433                         $ref3 = $row2{'components'};
11434                         @components = (ref $ref3 eq 'ARRAY') ? @$ref3 : ();
11435                         @failed = ();
11436                         @spare = ();
11437                         @components_good = ();
11438                         # @spare = split(/\s+/, $row{'unused'}) if $row{'unused'};
11439                         foreach my $item (@components){
11440                                 @temp = split /~/, $item;
11441                                 if (defined $temp[$status_id] && $temp[$status_id] =~ /^(F|DEGRADED|FAULTED|UNAVAIL)$/){
11442                                         $temp[0] = "$temp[0]~$temp[1]" if $status_id == 2;
11443                                         push @failed, $temp[0];
11444                                 }
11445                                 elsif (defined $temp[$status_id] && $temp[$status_id] =~ /(S|OFFLINE)$/){
11446                                         $temp[0] = "$temp[0]~$temp[1]" if $status_id == 2;
11447                                         push @spare, $temp[0];
11448                                 }
11449                                 else {
11450                                         $temp[0] = ($status_id == 2) ? "$temp[0]~$temp[1]" : $temp[0];
11451                                         push @components_good, $temp[0];
11452                                 }
11453                         }
11454                         $component_string = (@components_good) ? join ' ', @components_good : 'N/A';
11455                         $rows[$j]{main::key($num++,'Components')} = '';
11456                         $rows[$j]{main::key($num++,'online')} = $component_string;
11457                         if (@failed){
11458                                 $rows[$j]{main::key($num++,'FAILED')} = join ' ', @failed;
11459                         }
11460                         if (@spare){
11461                                 $rows[$j]{main::key($num++,'spare')} = join ' ', @spare;
11462                         }
11463                         if ($row{'type'} eq 'mdraid' && $extra > 0 ){
11464                                 $j = scalar @rows;
11465                                 $num = 1;
11466                                 #print Data::Dumper::Dumper \@arrays_holder;
11467                                 $rows[$j]{main::key($num++,'Info')} = '';
11468                                 $raid = (defined $arrays_holder[0]{'raid'}) ? $arrays_holder[0]{'raid'}: 'no-raid';
11469                                 $rows[$j]{main::key($num++,'raid')} = $raid;
11470                                 $rows[$j]{main::key($num++,$blocks_avail)} = $available;
11471                                 if ($size){
11472                                         $rows[$j]{main::key($num++,$report_size)} = $size;
11473                                 }
11474                                 my $chunk = ($row{'chunk-size'}) ? $row{'chunk-size'}: 'N/A';
11475                                 $rows[$j]{main::key($num++,$chunk_raid)} = $chunk;
11476                                 if ($extra > 1){
11477                                         if ($row{'bitmap'}){
11478                                                 $rows[$j]{main::key($num++,'bitmap')} = $row{'bitmap'};
11479                                         }
11480                                         if ($row{'super-block'}){
11481                                                 $rows[$j]{main::key($num++,'super blocks')} = $row{'super-block'};
11482                                         }
11483                                         if ($row{'algorithm'}){
11484                                                 $rows[$j]{main::key($num++,'algorithm')} = $row{'algorithm'};
11485                                         }
11486                                 }
11487                         }
11488                         $i++;
11489                 }
11490                 if ($row{'recovery-percent'}){
11491                         $j = scalar @rows;
11492                         $num = 1;
11493                         my $percent = $row{'recovery-percent'};
11494                         if ($extra > 1 && $row{'progress-bar'}){
11495                                 $percent .= " $row{'progress-bar'}"
11496                         }
11497                         $rows[$j]{main::key($num++,'Recovering')} = $percent;
11498                         my $finish = ($row{'recovery-finish'})?$row{'recovery-finish'} : 'N/A';
11499                         $rows[$j]{main::key($num++,'time remaining')} = $finish;
11500                         if ($extra > 0){
11501                                 if ($row{'sectors-recovered'}){
11502                                         $rows[$j]{main::key($num++,'sectors')} = $row{'sectors-recovered'};
11503                                 }
11504                         }
11505                         if ($extra > 1 && $row{'recovery-speed'}){
11506                                 $rows[$j]{main::key($num++,'speed')} = $row{'recovery-speed'};
11507                         }
11508                 }
11509         }
11510         eval $end if $b_log;
11511         #print Data::Dumper::Dumper \@rows;
11512         return @rows;
11513 }
11514 sub raid_data {
11515         eval $start if $b_log;
11516         my (@data);
11517         $b_raid = 1;
11518         if ($b_hardware_raid){
11519                 hardware_raid();
11520         }
11521         if ($b_md || (my $file = main::system_files('mdstat') )){
11522                 @data = mdraid_data($file);
11523                 @raid = (@raid,@data) if @data;
11524         }
11525         if ($b_zfs || (my $path = main::check_program('zpool') )){
11526                 @data = zfs_data($path);
11527                 @raid = (@raid,@data) if @data;
11528         }
11529         main::log_data('dump','@raid',\@raid) if $b_log;
11530         #print Data::Dumper::Dumper \@raid;
11531         eval $end if $b_log;
11532 }
11533 # 0 type
11534 # 1 type_id
11535 # 2 bus_id
11536 # 3 sub_id
11537 # 4 device
11538 # 5 vendor_id
11539 # 6 chip_id
11540 # 7 rev
11541 # 8 port
11542 # 9 driver
11543 # 10 modules
11544 sub hardware_raid {
11545         eval $start if $b_log;
11546         my ($driver,$vendor,@data,@working);
11547         foreach my $ref (@pci){
11548                 @working = @$ref;
11549                 next if $working[1] ne '0104';
11550                 $driver = ($working[9]) ? lc($working[9]): '';
11551                 $driver =~ s/-/_/g if $driver;
11552                 my $driver_version = ($driver) ? main::get_module_version($driver): '';
11553                 if ($extra > 2 && $b_pci_tool && $working[11]){
11554                         $vendor = main::get_pci_vendor($working[4],$working[11]);
11555                 }
11556                 @data = ({
11557                 'bus-id' => $working[2],
11558                 'chip-id' => $working[6],
11559                 'device' => $working[4],
11560                 'driver' => $driver,
11561                 'driver-version' => $driver_version,
11562                 'port' => $working[8],
11563                 'rev' => $working[7],
11564                 'sub-id' => $working[3],
11565                 'vendor-id' => $working[5],
11566                 'vendor' => $vendor,
11567                 });
11568                 @hardware_raid = (@hardware_raid,@data);
11569         }
11570         # print Data::Dumper::Dumper \@hardware_raid;
11571         main::log_data('dump','@hardware_raid',\@hardware_raid) if $b_log;
11572         eval $end if $b_log;
11573 }
11574 sub mdraid_data {
11575         eval $start if $b_log;
11576         my ($mdstat) = @_;
11577         my $j = 0;
11578         #$mdstat = "$ENV{'HOME'}/bin/scripts/inxi/data/raid/md-4-device-1.txt";
11579         #$mdstat = "$ENV{'HOME'}/bin/scripts/inxi/data/raid/md-rebuild-1.txt";
11580         #$mdstat = "$ENV{'HOME'}/bin/scripts/inxi/data/raid/md-2-mirror-fserver2-1.txt";
11581         #$mdstat = "$ENV{'HOME'}/bin/scripts/inxi/data/raid/md-2-raid10-abucodonosor.txt";
11582         my @working = main::reader($mdstat,'strip');
11583         #print Data::Dumper::Dumper \@working;
11584         my (@data,@mdraid,@temp,$b_found,$system,$unused);
11585         # NOTE: a system with empty mdstat will still show these values
11586         if ($working[0] && $working[0] =~ /^Personalities/){
11587                 $system = ( split /:\s*/,  $working[0])[1];
11588                 $system =~ s/\[|\]//g if $system;
11589                 shift @working;
11590         }
11591         if ($working[-1] && $working[-1] =~ /^used\sdevices/){
11592                 $unused = ( split /:\s*/,  $working[0])[1];
11593                 $unused =~ s/<|>|none//g if $unused;
11594                 pop @working;
11595         }
11596         foreach (@working){
11597                 $_ =~ s/\s*:\s*/:/;
11598                 # print "$_\n";
11599                 #md126 : active (auto-read-only) raid1 sdq1[0]
11600                 if (/^(md[0-9]+)\s*:\s*([^\s]+)(\s\([^)]+\))?\s([^\s]+)\s(.*)/){
11601                         my $id = $1;
11602                         my $status = $2;
11603                         my $raid = $4;
11604                         my $component_string = $5;
11605                         @temp = ();
11606                         $raid =~ s/^raid1$/mirror/;
11607                         $raid =~ s/^raid/raid-/;
11608                         $raid = 'mirror' if $raid eq '1';
11609                         # remember, these include the [x] id, so remove that for disk/unmounted
11610                         my @components = split /\s+/, $component_string;
11611                         foreach my $component (@components){
11612                                 $component =~ /([\S]+)\[([0-9]+)\]\(?([SF])?\)?/;
11613                                 my $string = "$1~";
11614                                 $string .= (defined $2) ? "c$2" : '';
11615                                 $string .= (defined $3) ? "~$3" : '';
11616                                 push @temp, $string;
11617                         }
11618                         @components = @temp;
11619                         #print "$component_string\n";
11620                         $j = scalar @mdraid;
11621                         @data = ({
11622                         'id' => $id,
11623                         'arrays' => ([],),
11624                         'status' => $status,
11625                         'type' => 'mdraid',
11626                         });
11627                         @mdraid = (@mdraid,@data);
11628                         $mdraid[$j]{'arrays'}[0]{'raid'} = $raid;
11629                         $mdraid[$j]{'arrays'}[0]{'components'} = \@components;
11630                 }
11631                 #print "$_\n";
11632                 if ($_ =~ /^([0-9]+)\sblocks/){
11633                         $mdraid[$j]{'blocks'} = $1;
11634                 }
11635                 if ($_ =~ /super\s([0-9\.]+)\s/){
11636                         $mdraid[$j]{'super-block'} = $1;
11637                 }
11638                 if ($_ =~ /algorithm\s([0-9\.]+)\s/){
11639                         $mdraid[$j]{'algorithm'} = $1;
11640                 }
11641                 if ($_ =~ /\[([0-9]+\/[0-9]+)\]\s\[([U_]+)\]/){
11642                         $mdraid[$j]{'report'} = $1;
11643                         $mdraid[$j]{'u-data'} = $2;
11644                 }
11645                 if ($_ =~ /resync=([\S]+)/){
11646                         $mdraid[$j]{'resync'} = $1;
11647                 }
11648                 if ($_ =~ /([0-9]+[km])\schunk/i){
11649                         $mdraid[$j]{'chunk-size'} = $1;
11650                 }
11651                 if ($_ =~ /(\[[=]*>[\.]*\]).*(resync|recovery)\s*=\s*([0-9\.]+%)?(\s\(([0-9\/]+)\))?/){
11652                         $mdraid[$j]{'progress-bar'} = $1;
11653                         $mdraid[$j]{'recovery-percent'} = $3 if $3;
11654                         $mdraid[$j]{'sectors-recovered'} = $5 if $5;
11655                 }
11656                 if ($_ =~ /finish\s*=\s*([\S]+)\s+speed\s*=\s*([\S]+)/){
11657                         $mdraid[$j]{'recovery-finish'} = $1;
11658                         $mdraid[$j]{'recovery-speed'} = $2;
11659                 }
11660                 #print 'mdraid loop: ', Data::Dumper::Dumper \@mdraid;
11661         }
11662         if (@mdraid){
11663                 $mdraid[0]{'system-supported'} = $system if $system;
11664                 $mdraid[0]{'unused'} = $unused if $unused;
11665         }
11666         #print Data::Dumper::Dumper \@mdraid;
11667         eval $end if $b_log;
11668         return @mdraid;
11669 }
11670
11671 sub zfs_data {
11672         eval $start if $b_log;
11673         my ($zpool) = @_;
11674         my (@components,@data,@zfs);
11675         my ($allocated,$free,$ref,$size,$status);
11676         my $b_v = 1;
11677         my ($i,$j,$k) = (0,0,0);
11678         #my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/raid/zpool-list-1-mirror-main-solestar.txt";
11679         #my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/raid/zpool-list-2-mirror-main-solestar.txt";
11680         #my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/raid/zpool-list-v-tank-1.txt";
11681         #my @working = main::reader($file);$zpool = '';
11682         my @working = main::grabber("$zpool list -v 2>/dev/null");
11683         DiskData::set_glabel() if $bsd_type && !$b_glabel;
11684         # bsd sed does not support inserting a true \n so use this trick
11685         # some zfs does not have -v
11686         if (!@working){
11687                 @working = main::grabber("$zpool list 2>/dev/null");
11688                 $b_v = 0;
11689         }
11690         #print Data::Dumper::Dumper \@working;
11691         main::log_data('dump','@working',\@working) if $b_log;
11692         if (!@working){
11693                 main::log_data('data','no zpool list data') if $b_log;
11694                 eval $end if $b_log;
11695                 return ();
11696         }
11697         my ($status_i) = (0);
11698         # NAME   SIZE  ALLOC   FREE  EXPANDSZ   FRAG    CAP  DEDUP  HEALTH  ALTROOT
11699         my $test = shift @working; # get rid of first header line
11700         if ($test){
11701                 foreach (split /\s+/, $test){
11702                         last if $_ eq 'HEALTH';
11703                         $status_i++;
11704                 }
11705         }
11706         foreach (@working){
11707                 my @row = split /\s+/, $_;
11708                 if (/^[\S]+/){
11709                         @components = ();
11710                         $i = 0;
11711                         $size = ($row[1] && $row[1] ne '-')? main::translate_size($row[1]): '';
11712                         $allocated = ($row[2] && $row[2] ne '-')? main::translate_size($row[2]): '';
11713                         $free = ($row[3] && $row[3] ne '-')? main::translate_size($row[3]): '';
11714                         $status = (defined $row[$status_i] && $row[$status_i] ne '') ? $row[$status_i]: 'no-status';
11715                         $j = scalar @zfs;
11716                         @data = ({
11717                         'id' => $row[0],
11718                         'allocated' => $allocated,
11719                         'arrays' => ([],),
11720                         'free' => $free,
11721                         'size' => $size,
11722                         'status' => $status,
11723                         'type' => 'zfs',
11724                         });
11725                         @zfs = (@zfs,@data);
11726                 }
11727                 #print Data::Dumper::Dumper \@zfs;
11728                 # raid level is the second item in the output, unless it is not, sometimes it is absent
11729                 if ($row[1] =~ /raid|mirror/){
11730                         $row[1] =~ s/^raid1/mirror/;
11731                         #$row[1] =~ s/^raid/raid-/; # need to match in zpool status <device>
11732                         $ref = $zfs[$j]{'arrays'};
11733                         $k = scalar @$ref;
11734                         $zfs[$j]{'arrays'}[$k]{'raid'} = $row[1];
11735                         $i = 0;
11736                         $zfs[$j]{'arrays'}[$k]{'size'} = ($row[2] && $row[2] ne '-') ? main::translate_size($row[2]) : '';
11737                         $zfs[$j]{'arrays'}[$k]{'allocated'} = ($row[3] && $row[3] ne '-') ? main::translate_size($row[3]) : '';
11738                         $zfs[$j]{'arrays'}[$k]{'free'} = ($row[4] && $row[4] ne '-') ? main::translate_size($row[4]) : '';
11739                 }
11740                 # https://blogs.oracle.com/eschrock/entry/zfs_hot_spares
11741                 elsif ($row[1] =~ /spares/){
11742                         next;
11743                 }
11744                 # the first is a member of a raid array
11745                 #    ada2        -      -      -         -      -      -
11746                 # this second is a single device not in an array
11747                 #  ada0s2    25.9G  14.6G  11.3G         -     0%    56%
11748                 #    gptid/3838f796-5c46-11e6-a931-d05099ac4dc2      -      -      -         -      -      -
11749                 elsif ($row[1] =~ /^([a-z0-9]+[0-9]+|([\S]+)\/.*)$/ &&
11750                        ($row[2] eq '-' || $row[2] =~ /^[0-9\.]+[MGTP]$/ )){
11751                         $row[1] =~ /^([a-z0-9]+[0-9]+|([\S]+)\/.*)\s*(DEGRADED|FAULTED|OFFLINE)?$/;
11752                         my $working = $1;
11753                         my $state = ($3) ? $3 : '';
11754                         if ($working =~ /[\S]+\// && @glabel){
11755                                 $working = DiskData::match_glabel($working);
11756                         }
11757                         # kind of a hack, things like cache may not show size/free
11758                         # data since they have no array row, but they might show it in
11759                         # component row:
11760                         #   ada0s2    25.9G  19.6G  6.25G         -     0%    75%
11761                         if (!$zfs[$j]{'size'} && $row[2] && $row[2] ne '-') {
11762                                 $size = ($row[2])? main::translate_size($row[2]): '';
11763                                 $zfs[$j]{'arrays'}[$k]{'size'} = $size;
11764                         }
11765                         if (!$zfs[$j]{'allocated'} && $row[3] && $row[3] ne '-') {
11766                                 $allocated = ($row[3])? main::translate_size($row[3]): '';
11767                                 $zfs[$j]{'arrays'}[$k]{'allocated'} = $allocated;
11768                         }
11769                         if (!$zfs[$j]{'free'} && $row[4] && $row[4] ne '-') {
11770                                 $free = ($row[4])? main::translate_size($row[4]): '';
11771                                 $zfs[$j]{'arrays'}[$k]{'free'} = $free;
11772                         }
11773                         $zfs[$j]{'arrays'}[$k]{'components'}[$i] = $working . '~' . $state;
11774                         $i++;
11775                 }
11776         }
11777         # print Data::Dumper::Dumper \@zfs;
11778         # clear out undefined arrrays values
11779         $j = 0;
11780         foreach $ref (@zfs){
11781                 my %row = %$ref;
11782                 my $ref2 = $row{'arrays'};
11783                 my @arrays = (ref $ref2 eq 'ARRAY' ) ? @$ref2 : ();
11784                 @arrays = grep {defined $_} @arrays;
11785                 $zfs[$j]{'arrays'} = \@arrays;
11786                 $j++;
11787         }
11788         @zfs = zfs_status($zpool,@zfs);
11789         # print Data::Dumper::Dumper \@zfs;
11790         eval $end if $b_log;
11791         return @zfs;
11792 }
11793 sub zfs_status {
11794         eval $start if $b_log;
11795         my ($zpool,@zfs) = @_;
11796         my ($cmd,$status,$file,$raid,@arrays,@pool_status,@temp);
11797         my ($i,$j,$k,$l) = (0,0,0,0);
11798         foreach my $ref (@zfs){
11799                 my %row = %$ref;
11800                 $i = 0;
11801                 $k = 0;
11802                 #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/raid/zpool-status-1-mirror-main-solestar.txt";
11803                 #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/raid/zpool-status-2-mirror-main-solestar.txt";
11804                 #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/raid/zpool-status-tank-1.txt";
11805                 #@pool_status = main::reader($file,'strip');
11806                 $cmd = "$zpool status $row{'id'} 2>/dev/null";
11807                 @pool_status = main::grabber($cmd,"\n",'strip');
11808                 main::log_data('cmd',$cmd) if $b_log;
11809                 my $ref2 = $row{'arrays'};
11810                 @arrays = (ref $ref2 eq 'ARRAY' ) ? @$ref2 : ();
11811                 #print "$row{'id'} rs:$row{'status'}\n";
11812                 $status = ($row{'status'} && $row{'status'} eq 'no-status') ? check_status($row{'id'},@pool_status): $row{'status'};
11813                 $zfs[$j]{'status'} = $status if $status;
11814                 #@arrays = grep {defined $_} @arrays;
11815                 #print "$row{id} $#arrays\n";
11816                 #print Data::Dumper::Dumper \@arrays;
11817                 foreach my $array (@arrays){
11818                         #print 'ref: ', ref $array, "\n";
11819                         #next if ref $array ne 'HASH';
11820                         my %row2 = %$array;
11821                         my $ref3 = $row2{'components'};
11822                         my @components = (ref $ref3 eq 'ARRAY') ? @$ref3 : ();
11823                         $l = 0;
11824                         # zpool status: mirror-0  ONLINE       2     0     0
11825                         $raid = ($row2{'raid'}) ? "$row2{'raid'}-$i": $row2{'raid'};
11826                         $status = ($raid) ? check_status($raid,@pool_status): '';
11827                         $zfs[$j]{'arrays'}[$k]{'status'} = $status;
11828                         #print "$raid i:$i j:$j k:$k $status\n";
11829                         foreach my $component (@components){
11830                                 my @temp = split /~/, $component;
11831                                 $status = ($temp[0]) ? check_status($temp[0],@pool_status): '';
11832                                 $zfs[$j]{'arrays'}[$k]{'components'}[$l] .= $status if $status;
11833                                 $l++;
11834                         }
11835                         $k++;
11836                         # haven't seen a raid5/6 type array yet
11837                         $i++ if $row2{'raid'}; # && $row2{'raid'} eq 'mirror';
11838                 }
11839                 $j++;
11840         }
11841         eval $end if $b_log;
11842         return @zfs;
11843 }
11844 sub check_status {
11845         eval $start if $b_log;
11846         my ($item,@pool_status) = @_;
11847         my ($status) = ('');
11848         foreach (@pool_status){
11849                 my @temp = split /\s+/, $_;
11850                 if ($temp[0] eq $item){
11851                         last if !$temp[1];
11852                         $status = $temp[1];
11853                         last;
11854                 }
11855         }
11856         eval $end if $b_log;
11857         return $status;
11858 }
11859 }
11860
11861 ## RamData
11862 {
11863 package RamData;
11864
11865 sub get {
11866         my (@data,@rows,$key1,@ram,$val1);
11867         my $num = 0;
11868         my $ref = $alerts{'dmidecode'};
11869         @rows = main::memory_data_full('ram') if !$b_mem;
11870         if ( $$ref{'action'} ne 'use'){
11871                 $key1 = $$ref{'action'};
11872                 $val1 = $$ref{$key1};
11873                 @data = ({
11874                 main::key($num++,'RAM Report') => '',
11875                 main::key($num++,$key1) => $val1,
11876                 });
11877                 @rows = (@rows,@data);
11878         }
11879         else {
11880                 @ram = dmidecode_data();
11881                 if (@ram){
11882                         @data = create_output(@ram);
11883                 }
11884                 else {
11885                         $key1 = 'message';
11886                         $val1 = main::row_defaults('ram-data');
11887                         @data = ({
11888                         main::key($num++,'RAM Report') => '',
11889                         main::key($num++,$key1) => $val1,
11890                         });
11891                 }
11892                 @rows = (@rows,@data);
11893         }
11894         eval $end if $b_log;
11895         return @rows;
11896 }
11897
11898 sub create_output {
11899         eval $start if $b_log;
11900         my (@ram) = @_;
11901         return if !@ram;
11902         my $num = 0;
11903         my $j = 0;
11904         my (@data,@rows);
11905         foreach (@ram){
11906                 $j = scalar @rows;
11907                 my %ref = %$_;
11908                 $num = 1;
11909                 @data = ({
11910                 main::key($num++,'Array') => '',
11911                 main::key($num++,'capacity') => process_size($ref{'capacity'}),
11912                 });
11913                 @rows = (@rows,@data);
11914                 if ($ref{'cap-qualifier'}){
11915                         $rows[$j]{main::key($num++,'note')} = $ref{'cap-qualifier'};
11916                 }
11917                 $rows[$j]{main::key($num++,'slots')} = $ref{'slots'};
11918                 $rows[$j]{main::key($num++,'EC')} = $ref{'eec'};
11919                 if ($extra > 0 ){
11920                         $rows[$j]{main::key($num++,'max module size')} = process_size($ref{'max-module-size'});
11921                         if ($ref{'mod-qualifier'}){
11922                                 $rows[$j]{main::key($num++,'note')} = $ref{'mod-qualifier'};
11923                         }
11924                 }
11925                 foreach my $ref2 ($ref{'modules'}){
11926                         my @modules = @$ref2;
11927                         # print Data::Dumper::Dumper \@modules;
11928                         foreach my $ref3 ( @modules){
11929                                 $num = 1;
11930                                 $j = scalar @rows;
11931                                 # multi array setups will start index at next from previous array
11932                                 next if ref $ref3 ne 'HASH';
11933                                 my %mod = %$ref3;
11934                                 $mod{'locator'} ||= 'N/A';
11935                                 @data = ({
11936                                 main::key($num++,'Device') => $mod{'locator'},
11937                                 main::key($num++,'size') => process_size($mod{'size'}),
11938                                 });
11939                                 @rows = (@rows,@data);
11940                                 next if ($mod{'size'} =~ /\D/);
11941                                 if ($extra > 1 && $mod{'type'} ){
11942                                         $rows[$j]{main::key($num++,'info')} = $mod{'type'};
11943                                 }
11944                                 $rows[$j]{main::key($num++,'speed')} = $mod{'speed'};
11945                                 if ($extra > 0 ){
11946                                         $mod{'device-type'} ||= 'N/A';
11947                                         $rows[$j]{main::key($num++,'type')} = $mod{'device-type'};
11948                                         if ($extra > 2 && $mod{'device-type'} ne 'N/A'){
11949                                                 $mod{'device-type-detail'} ||= 'N/A';
11950                                                 $rows[$j]{main::key($num++,'detail')} = $mod{'device-type-detail'};
11951                                         }
11952                                 }
11953                                 if ($extra > 2 ){
11954                                         $mod{'data-width'} ||= 'N/A';
11955                                         $rows[$j]{main::key($num++,'bus width')} = $mod{'data-width'};
11956                                         $mod{'total-width'} ||= 'N/A';
11957                                         $rows[$j]{main::key($num++,'total')} = $mod{'total-width'};
11958                                 }
11959                                 if ($extra > 1 ){
11960                                         $mod{'manufacturer'} ||= 'N/A';
11961                                         $rows[$j]{main::key($num++,'manufacturer')} = $mod{'manufacturer'};
11962                                         $mod{'part-number'} ||= 'N/A';
11963                                         $rows[$j]{main::key($num++,'part-no')} = $mod{'part-number'};
11964                                 }
11965                                 if ($extra > 2 ){
11966                                         $mod{'serial'} = main::apply_filter($mod{'serial'});
11967                                         $rows[$j]{main::key($num++,'serial')} = $mod{'serial'};
11968                                 }
11969                         }
11970                 }
11971         }
11972         eval $end if $b_log;
11973         return @rows;
11974 }
11975
11976 sub dmidecode_data {
11977         eval $start if $b_log;
11978         my ($b_5,$handle,@ram,@temp);
11979         my ($derived_module_size,$max_cap_5,$max_cap_16,$max_module_size) = (0,0,0,0);
11980         my ($i,$j,$k) = (0,0,0);
11981         foreach (@dmi){
11982                 my @ref = @$_;
11983                 # Portable Battery
11984                 if ($ref[0] == 5){
11985                         $ram[$k] = ({}) if !$ram[$k];
11986                         foreach my $item (@ref){
11987                                 @temp = split /:\s*/, $item;
11988                                 next if ! $temp[1];
11989                                 if ($temp[0] eq 'Maximum Memory Module Size'){
11990                                         $max_module_size = calculate_size($temp[1],$max_module_size);
11991                                         $ram[$k]{'max-module-size'} = $max_module_size;
11992                                 }
11993                                 elsif ($temp[0] eq 'Maximum Total Memory Size'){
11994                                         $max_cap_5 = calculate_size($temp[1],$max_cap_5);
11995                                         $ram[$k]{'max-capacity-5'} = $max_cap_5;
11996                                 }
11997                                 elsif ($temp[0] eq 'Memory Module Voltage'){
11998                                         $temp[1] =~ s/\s*V.*$//;
11999                                         $ram[$k]{'voltage'} = $temp[1];
12000                                 }
12001                                 elsif ($temp[0] eq 'Associated Memory Slots'){
12002                                         $ram[$k]{'slots-5'} = $temp[1];
12003                                 }
12004                         }
12005                         $ram[$k]{'modules'} = ([],);
12006                         #print Data::Dumper::Dumper \@ram;
12007                         $b_5 = 1;
12008                 }
12009                 elsif ($ref[0] == 6){
12010                         my ($size,$speed,$type) = (0,0,0);
12011                         foreach my $item (@ref){
12012                                 @temp = split /:\s*/, $item;
12013                                 next if ! $temp[1];
12014                                 if ($temp[0] eq 'Installed Size'){
12015                                         # get module size
12016
12017                                         $size = calculate_size($temp[1],0);
12018                                         # get data after module size
12019                                         $temp[1] =~ s/ Connection\)?//;
12020                                         $temp[1] =~ s/^[0-9]+\s*[MGTP]B\s*\(?//;
12021                                         $type = lc($temp[1]);
12022                                 }
12023                                 elsif ($temp[0] eq 'Current Speed'){
12024                                         $speed = $temp[1];
12025                                 }
12026                         }
12027                         $ram[$k]{'modules'}[$j] = ({
12028                         'size' => $size,
12029                         'speed-ns' => $speed,
12030                         'type' => $type,
12031                         });
12032                         #print Data::Dumper::Dumper \@ram;
12033                         $j++;
12034                 }
12035                 elsif ($ref[0] == 16){
12036                         $handle = $ref[1];
12037                         $ram[$handle] = $ram[$k] if $ram[$k];
12038                         $ram[$k] = undef;
12039                         $ram[$handle] = ({}) if !$ram[$handle];
12040                         foreach my $item (@ref){
12041                                 @temp = split /:\s*/, $item;
12042                                 next if ! $temp[1];
12043                                 if ($temp[0] eq 'Maximum Capacity'){
12044                                         $max_cap_16 = calculate_size($temp[1],$max_cap_16);
12045                                         $ram[$handle]{'max-capacity-16'} = $max_cap_16;
12046                                 }
12047                                 # note: these 3 have cleaned data in set_dmidecode_data, so replace stuff manually
12048                                 elsif ($temp[0] eq 'Location'){
12049                                         $temp[1] =~ s/\sOr\sMotherboard//;
12050                                         $temp[1] ||= 'System Board';
12051                                         $ram[$handle]{'location'} = $temp[1];
12052                                 }
12053                                 elsif ($temp[0] eq 'Use'){
12054                                         $temp[1] ||= 'System Memory';
12055                                         $ram[$handle]{'use'} = $temp[1];
12056                                 }
12057                                 elsif ($temp[0] eq 'Error Correction Type'){
12058                                         $temp[1] ||= 'None';
12059                                         $ram[$handle]{'eec'} = $temp[1];
12060                                 }
12061                                 elsif ($temp[0] eq 'Number Of Devices'){
12062                                         $ram[$handle]{'slots-16'} = $temp[1];
12063                                 }
12064                                 #print "0: $temp[0]\n";
12065                         }
12066                         $ram[$handle]{'derived-module-size'} = 0;
12067                         $ram[$handle]{'device-count-found'} = 0;
12068                         $ram[$handle]{'used-capacity'} = 0;
12069                         #print "s16: $ram[$handle]{'slots-16'}\n";
12070                 }
12071                 elsif ($ref[0] == 17){
12072                         my ($bank_locator,$configured_clock_speed,$data_width) = ('','','');
12073                         my ($device_type,$device_type_detail,$form_factor,$locator,$main_locator) = ('','','','','');
12074                         my ($manufacturer,$part_number,$serial,$speed,$total_width) = ('','','','','');
12075                         my ($device_size,$i_data,$i_total,$working_size) = (0,0,0,0);
12076                         foreach my $item (@ref){
12077                                 @temp = split /:\s*/, $item;
12078                                 next if ! $temp[1];
12079                                 if ($temp[0] eq 'Array Handle'){
12080                                         $handle = hex($temp[1]);
12081                                 }
12082                                 elsif ($temp[0] eq 'Data Width'){
12083                                         $data_width = $temp[1];
12084                                 }
12085                                 elsif ($temp[0] eq 'Total Width'){
12086                                         $total_width = $temp[1];
12087                                 }
12088                                 # do not try to guess from installed modules, only use this to correct type 5 data
12089                                 elsif ($temp[0] eq 'Size'){
12090                                         # we want any non real size data to be preserved
12091                                         if ( $temp[1] =~ /^[0-9]+\s*[MTPG]B/ ) {
12092                                                 $derived_module_size = calculate_size($temp[1],$derived_module_size);
12093                                                 $working_size = calculate_size($temp[1],0);
12094                                                 $device_size = $working_size;
12095                                         }
12096                                         else {
12097                                                 $device_size = $temp[1];
12098                                         }
12099                                 }
12100                                 elsif ($temp[0] eq 'Locator'){
12101                                         $temp[1] =~ s/RAM slot #/Slot/;
12102                                         $locator = $temp[1];
12103                                 }
12104                                 elsif ($temp[0] eq 'Bank Locator'){
12105                                         $bank_locator = $temp[1];
12106                                 }
12107                                 elsif ($temp[0] eq 'Form Factor'){
12108                                         $form_factor = $temp[1];
12109                                 }
12110                                 elsif ($temp[0] eq 'Type'){
12111                                         $device_type = $temp[1];
12112                                 }
12113                                 elsif ($temp[0] eq 'Type Detail'){
12114                                         $device_type_detail = $temp[1];
12115                                 }
12116                                 elsif ($temp[0] eq 'Speed'){
12117                                         $speed = $temp[1];
12118                                 }
12119                                 elsif ($temp[0] eq 'Configured Clock Speed'){
12120                                         $configured_clock_speed = $temp[1];
12121                                 }
12122                                 elsif ($temp[0] eq 'Manufacturer'){
12123                                         $temp[1] = main::dmi_cleaner($temp[1]);
12124                                         $manufacturer = $temp[1];
12125                                 }
12126                                 elsif ($temp[0] eq 'Part Number'){
12127                                         $temp[1] =~ s/(^[0]+$||.*Module.*|Undefined.*|PartNum.*|\[Empty\]|^To be filled.*)//g;
12128                                         $part_number = $temp[1];
12129                                 }
12130                                 elsif ($temp[0] eq 'Serial Number'){
12131                                         $temp[1] =~ s/(^[0]+$|Undefined.*|SerNum.*|\[Empty\]|^To be filled.*)//g;
12132                                         $serial = $temp[1];
12133                                 }
12134                         }
12135                         # because of the wide range of bank/slot type data, we will just use
12136                         # the one that seems most likely to be right. Some have: Bank: SO DIMM 0 slot: J6A
12137                         # so we dump the useless data and use the one most likely to be visibly correct
12138                         if ( $bank_locator =~ /DIMM/ ) {
12139                                 $main_locator = $bank_locator;
12140                         }
12141                         else {
12142                                 $main_locator = $locator;
12143                         }
12144                         if ($working_size =~ /^[0-9][0-9]+$/) {
12145                                 $ram[$handle]{'device-count-found'}++;
12146                                 # build up actual capacity found for override tests
12147                                 $ram[$handle]{'used-capacity'} += $working_size;
12148                         }
12149                         # sometimes the data is just wrong, they reverse total/data. data I believe is
12150                         # used for the actual memory bus width, total is some synthetic thing, sometimes missing.
12151                         # note that we do not want a regular string comparison, because 128 bit memory buses are
12152                         # in our future, and 128 bits < 64 bits with string compare
12153                         $data_width =~ /(^[0-9]+).*/;
12154                         $i_data = $1;
12155                         $total_width =~ /(^[0-9]+).*/;
12156                         $i_total = $1;
12157                         if ($i_data && $i_total && $i_data > $i_total){
12158                                 my $temp_width = $data_width;
12159                                 $data_width = $total_width;
12160                                 $total_width = $temp_width;
12161                         }
12162                         $ram[$handle]{'derived-module-size'} = $derived_module_size;
12163                         $ram[$handle]{'modules'}[$i]{'configured-clock-speed'} = $configured_clock_speed;
12164                         $ram[$handle]{'modules'}[$i]{'data-width'} = $data_width;
12165                         $ram[$handle]{'modules'}[$i]{'size'} = $device_size;
12166                         $ram[$handle]{'modules'}[$i]{'device-type'} = $device_type;
12167                         $ram[$handle]{'modules'}[$i]{'device-type-detail'} = lc($device_type_detail);
12168                         $ram[$handle]{'modules'}[$i]{'form-factor'} = $form_factor;
12169                         $ram[$handle]{'modules'}[$i]{'locator'} = $main_locator;
12170                         $ram[$handle]{'modules'}[$i]{'manufacturer'} = $manufacturer;
12171                         $ram[$handle]{'modules'}[$i]{'part-number'} = $part_number;
12172                         $ram[$handle]{'modules'}[$i]{'serial'} = $serial;
12173                         $ram[$handle]{'modules'}[$i]{'speed'} = $speed;
12174                         $ram[$handle]{'modules'}[$i]{'total-width'} = $total_width;
12175                         $i++
12176                 }
12177                 elsif ($ref[0] < 17 ){
12178                         next;
12179                 }
12180                 elsif ($ref[0] > 17 ){
12181                         last;
12182                 }
12183         }
12184         @ram = data_processor(@ram) if @ram;
12185         main::log_data('dump','@ram',\@ram) if $b_log;
12186         # print Data::Dumper::Dumper \@ram;
12187         eval $end if $b_log;
12188         return @ram;
12189 }
12190 sub data_processor {
12191         eval $start if $b_log;
12192         my (@ram) = @_;
12193         my $b_debug = 0;
12194         my (@return,@temp);
12195         my $est = 'est.';
12196
12197         foreach (@ram){
12198                 # because we use the actual array handle as the index,
12199                 # there will be many undefined keys
12200                 next if ! defined $_;
12201                 my %ref = %$_;
12202                 my ($max_cap,$max_mod_size) = (0,0);
12203                 my ($alt_cap,$est_cap,$est_mod,$unit) = (0,'','','');
12204                 $max_cap = $ref{'max-capacity-16'};
12205                 # make sure they are integers not string if empty
12206                 $ref{'slots-5'} ||= 0;
12207                 $ref{'slots-16'} ||= 0;
12208                 $ref{'max-capacity-5'} ||= 0;
12209                 $ref{'max-module-size'} ||= 0;
12210                 #$ref{'max-module-size'} = 0;# debugger
12211                 # 1: if max cap 1 is null, and max cap 2 not null, use 2
12212                 if ($b_debug){
12213                         print "1: mms: $ref{'max-module-size'} :dms: $ref{'derived-module-size'} :mc: $max_cap :uc: $ref{'used-capacity'}\n";
12214                         print "1a: s5: $ref{'slots-5'} s16: $ref{'slots-16'}\n";
12215                 }
12216                 if (!$max_cap && $ref{'max-capacity-5'}) {
12217                         $max_cap = $ref{'max-capacity-5'};
12218                 }
12219                 if ($b_debug){
12220                         print "2: mms: $ref{'max-module-size'} :dms: $ref{'derived-module-size'} :mc: $max_cap :uc: $ref{'used-capacity'}\n";
12221                 }
12222                 # 2: now check to see if actually found module sizes are > than listed max module, replace if >
12223                 if ( $ref{'max-module-size'} && $ref{'derived-module-size'} &&
12224                      $ref{'derived-module-size'} > $ref{'max-module-size'} ){
12225                         $ref{'max-module-size'} = $ref{'derived-module-size'};
12226                         $est_mod = $est;
12227                 }
12228                 if ($b_debug){
12229                         print "3: dcf: $ref{'device-count-found'} :dms: $ref{'derived-module-size'} :mc: $max_cap :uc: $ref{'used-capacity'}\n";
12230                 }
12231                 # note: some cases memory capacity == max module size, so one stick will fill it
12232                 # but I think only with cases of 2 slots does this happen, so if > 2, use the count of slots.
12233                 if ($max_cap && ($ref{'device-count-found'} || $ref{'slots-16'}) ){
12234                         # first check that actual memory found is not greater than listed max cap, or
12235                         # checking to see module count * max mod size is not > used capacity
12236                         if ($ref{'used-capacity'} && $ref{'max-capacity-16'}){
12237                                 if ($ref{'used-capacity'} > $max_cap){
12238                                         if ($ref{'max-module-size'} &&
12239                                           $ref{'used-capacity'} < ($ref{'slots-16'} * $ref{'max-module-size'} )){
12240                                                 $max_cap = $ref{'slots-16'} * $ref{'max-module-size'};
12241                                                 $est_cap = $est;
12242                                                 print "A\n" if $b_debug;
12243                                         }
12244                                         elsif ($ref{'derived-module-size'} &&
12245                                           $ref{'used-capacity'} < ($ref{'slots-16'} * $ref{'derived-module-size'}) ){
12246                                                 $max_cap = $ref{'slots-16'} * $ref{'derived-module-size'};
12247                                                 $est_cap = $est;
12248                                                 print "B\n" if $b_debug;
12249                                         }
12250                                         else {
12251                                                 $max_cap = $ref{'used-capacity'};
12252                                                 $est_cap = $est;
12253                                                 print "C\n" if $b_debug;
12254                                         }
12255                                 }
12256                         }
12257                         # note that second case will never really activate except on virtual machines and maybe
12258                         # mobile devices
12259                         if (!$est_cap){
12260                                 # do not do this for only single modules found, max mod size can be equal to the array size
12261                                 if ($ref{'slots-16'} > 1 && $ref{'device-count-found'} > 1 &&
12262                                   $max_cap < ($ref{'derived-module-size'} * $ref{'slots-16'} ) ){
12263                                         $max_cap = $ref{'derived-module-size'} * $ref{'slots-16'};
12264                                         $est_cap = $est;
12265                                         print "D\n" if $b_debug;
12266                                 }
12267                                 elsif ($ref{'device-count-found'} > 0 && $max_cap < ( $ref{'derived-module-size'} * $ref{'device-count-found'} )){
12268                                         $max_cap = $ref{'derived-module-size'} * $ref{'device-count-found'};
12269                                         $est_cap = $est;
12270                                         print "E\n" if $b_debug;
12271                                 }
12272                                 ## handle cases where we have type 5 data: mms x device count equals type 5 max cap
12273                                 # however do not use it if cap / devices equals the derived module size
12274                                 elsif ($ref{'max-module-size'} > 0 &&
12275                                   ($ref{'max-module-size'} * $ref{'slots-16'}) == $ref{'max-capacity-5'} &&
12276                                   $ref{'max-capacity-5'} != $ref{'max-capacity-16'} &&
12277                                   $ref{'derived-module-size'} != ($ref{'max-capacity-16'}/$ref{'slots-16'}) ){
12278                                         $max_cap = $ref{'max-capacity-5'};
12279                                         $est_cap = $est;
12280                                         print "F\n" if $b_debug;
12281                                 }
12282
12283                         }
12284                         if ($b_debug){
12285                                 print "4: mms: $ref{'max-module-size'} :dms: $ref{'derived-module-size'} :mc: $max_cap :uc: $ref{'used-capacity'}\n";
12286                         }
12287                         # some cases of type 5 have too big module max size, just dump the data then since
12288                         # we cannot know if it is valid or not, and a guess can be wrong easily
12289                         if ($ref{'max-module-size'} && $max_cap && $ref{'max-module-size'} > $max_cap){
12290                                 $ref{'max-module-size'} = 0;
12291                         }
12292                         if ($b_debug){
12293                                 print "5: dms: $ref{'derived-module-size'} :s16: $ref{'slots-16'} :mc: $max_cap\n";
12294                         }
12295
12296                         # now prep for rebuilding the ram array data
12297                         if (!$ref{'max-module-size'}){
12298                                 # ie: 2x4gB
12299                                 if (!$est_cap && $ref{'derived-module-size'} > 0 && $max_cap > ($ref{'derived-module-size'} * $ref{'slots-16'} * 4) ){
12300                                         $est_cap = 'check';
12301                                         print "G\n" if $b_debug;
12302                                 }
12303                                 if ($max_cap && ($ref{'slots-16'} || $ref{'slots-5'})){
12304                                         my $slots = 0;
12305                                         if ($ref{'slots-16'} && $ref{'slots-16'} >= $ref{'slots-5'}){
12306                                                 $slots = $ref{'slots-16'};
12307                                         }
12308                                         elsif ($ref{'slots-5'} && $ref{'slots-5'} > $ref{'slots-16'}){
12309                                                 $slots = $ref{'slots-5'};
12310                                         }
12311                                         if ($ref{'derived-module-size'} * $slots > $max_cap){
12312                                                 $ref{'max-module-size'} = $ref{'derived-module-size'};
12313                                         }
12314                                         else {
12315                                                 $ref{'max-module-size'} = sprintf("%.f",$max_cap/$slots);
12316                                         }
12317                                         $est_mod = $est;
12318                                 }
12319                         }
12320                         # case where listed max cap is too big for actual slots x max cap, eg:
12321                         # listed max cap, 8gb, max mod 2gb, slots 2
12322                         else {
12323                                 if (!$est_cap && $ref{'max-module-size'} > 0){
12324                                         if ($max_cap > ( $ref{'max-module-size'} * $ref{'slots-16'})){
12325                                                 $est_cap = 'check';
12326                                                 print "H\n" if $b_debug;
12327                                         }
12328                                 }
12329                         }
12330                 }
12331                 @temp = ({
12332                 'capacity' => $max_cap,
12333                 'cap-qualifier' => $est_cap,
12334                 'eec' => $ref{'eec'},
12335                 'location' => $ref{'location'},
12336                 'max-module-size' => $ref{'max-module-size'},
12337                 'mod-qualifier' => $est_mod,
12338                 'modules' => $ref{'modules'},
12339                 'slots' => $ref{'slots-16'},
12340                 'use' => $ref{'use'},
12341                 'voltage' => $ref{'voltage'},
12342                 });
12343                 @return = (@return,@temp);
12344         }
12345         eval $end if $b_log;
12346         return @return;
12347 }
12348 sub process_size {
12349         my ($size) = @_;
12350         my ($b_trim,$unit) = (0,'');
12351         return 'N/A' if ( ! $size );
12352         return $size if $size =~ /\D/;
12353         if ( $size < 1024 ){
12354                 $unit='MiB';
12355         }
12356         elsif ( $size < 1024000 ){
12357                 $size = $size / 1024;
12358                 $unit='GiB';
12359                 $b_trim = 1;
12360         }
12361         elsif ( $size < 1024000000 ){
12362                 $size = $size / 1024000;
12363                 $unit='TiB';
12364                 $b_trim = 1;
12365         }
12366         # we only want a max 2 decimal places, and only when it's
12367         # a unit > MB
12368         $size = sprintf("%.2f",$size) if $b_trim;
12369         $size =~ s/\.[0]+$//;
12370         $size = "$size $unit";
12371         return $size;
12372 }
12373 sub calculate_size {
12374         my ($data, $size) = @_;
12375         if ( $data =~ /^[0-9]+\s*[GMTP]B/) {
12376                 if ( $data =~ /([0-9]+)\s*GB/ ) {
12377                         $data = $1 * 1024;
12378                 }
12379                 elsif ( $data =~ /([0-9]+)\s*MB/ ) {
12380                         $data = $1;
12381                 }
12382                 elsif ( $data =~ /([0-9]+)\s*TB/ ) {
12383                         $data = $1 * 1024 * 1000;
12384                 }
12385                 elsif ( $data =~ /([0-9]+)\s*PB/ ) {
12386                         $data = $1 * 1024 * 1000 * 1000;
12387                 }
12388                 if ($data =~ /^[0-9][0-9]+$/ && $data > $size ) {
12389                         $size=$data;
12390                 }
12391         }
12392         else {
12393                 $size = 0;
12394         }
12395         return $size;
12396 }
12397 }
12398
12399 ## RepoData
12400 {
12401 package RepoData;
12402
12403 # easier to keep these package global, but undef after done
12404 my (@dbg_files,$debugger_dir);
12405 my $num = 0;
12406 sub get {
12407         eval $start if $b_log;
12408         ($debugger_dir) = @_;
12409         my (@data,@rows);
12410         if ($bsd_type){
12411                 @rows = get_repos_bsd();
12412         }
12413         else {
12414                 @rows = get_repos_linux();
12415         }
12416         if ($debugger_dir){
12417                 @rows = @dbg_files;
12418                 undef @dbg_files;
12419                 undef $debugger_dir;
12420         }
12421         else {
12422                 if (!@rows){
12423                         my $pm = (!$bsd_type) ? 'package manager': 'OS type';
12424                         @data = (
12425                         {main::key($num++,'Alert') => "No repo data detected. Does $self_name support your $pm?"},
12426                         );
12427                         @rows = (@data);
12428                 }
12429         }
12430         eval $end if $b_log;
12431         return @rows;
12432 }
12433 sub get_repos_linux {
12434         eval $start if $b_log;
12435         my (@content,@data,@data2,@data3,@files,$repo,@repos,@rows);
12436         my ($key,$path);
12437         my $apk = '/etc/apk/repositories';
12438         my $apt = '/etc/apt/sources.list';
12439         my $eopkg_dir = '/var/lib/eopkg/';
12440         my $pacman = '/etc/pacman.conf';
12441         my $pacman_g2 = '/etc/pacman-g2.conf';
12442         my $pisi_dir = '/etc/pisi/';
12443         my $portage_dir = '/etc/portage/repos.conf/';
12444         my $slackpkg = '/etc/slackpkg/mirrors';
12445         my $slackpkg_plus = '/etc/slackpkg/slackpkgplus.conf';
12446         my $yum_conf = '/etc/yum.conf';
12447         my $yum_repo_dir = '/etc/yum.repos.d/';
12448         my $zypp_repo_dir = '/etc/zypp/repos.d/';
12449         my $b_test = 0;
12450         # apt - debian, buntus, also sometimes some yum/rpm repos may create
12451         # apt repos here as well
12452         if (-f $apt || -d "$apt.d"){
12453                 my ($apt_arch,$apt_comp,$apt_suites,$apt_types,@apt_urls,@apt_working,
12454                 $b_apt_enabled,$file,$string);
12455                 my $counter = 0;
12456                 @files = main::globber('/etc/apt/sources.list.d/*.list');
12457                 push @files, $apt;
12458                 main::log_data('data',"apt repo files:\n" . main::joiner(\@files, "\n", 'unset') ) if $b_log;
12459                 foreach ( sort @files){
12460                         # altlinux uses rpms in apt files!
12461                         @data = repo_builder($_,'apt','^\s*(deb|rpm)') if -r $_;
12462                         @rows = (@rows,@data);
12463                 }
12464                 #@files = main::globber("$ENV{'HOME'}/bin/scripts/inxi/data/repo/apt/*.sources");
12465                 @files = main::globber('/etc/apt/sources.list.d/*.sources');
12466                 main::log_data('data',"apt deb822 repo files:\n" . main::joiner(\@files, "\n", 'unset') ) if $b_log;
12467                 foreach $file (@files){
12468                         @data2 = main::reader($file,'strip');
12469                         my $count = scalar @data2;
12470                         push @dbg_files, $file if $debugger_dir;
12471                         #print "$file\n";
12472                         @apt_urls = ();
12473                         @apt_working = ();
12474                         $counter = 0;
12475                         $b_apt_enabled = 1;
12476                         foreach my $row (@data2){
12477                                 $counter++;
12478                                 next if $row =~ /^\s*$|^\s*#/;
12479                                 #print "row:$row\n";
12480                                 if ($row =~ /^Types:\s*(.*)/){
12481                                         my $type_holder= $1;
12482                                         #print "ath:$type_holder\n";
12483                                         if ($apt_types && @apt_working){
12484                                                 if ($b_apt_enabled){
12485                                                         #print "1: url builder\n";
12486                                                         foreach $repo (@apt_working){
12487                                                                 $string = $apt_types;
12488                                                                 $string .= ' [arch=' . $apt_arch . ']' if $apt_arch;
12489                                                                 $string .= ' ' . $repo;
12490                                                                 $string .= ' ' . $apt_suites if $apt_suites ;
12491                                                                 $string .= ' ' . $apt_comp if $apt_comp;
12492
12493                                                                 #print "s1:$string\n";
12494                                                                 push @data3, $string;
12495                                                         }
12496                                                 }
12497                                                 #print join "\n",@data3,"\n";
12498                                                 @apt_urls = (@apt_urls,@data3);
12499                                                 @data3 = ();
12500                                                 @apt_working = ();
12501                                                 $apt_arch = '';
12502                                                 $apt_comp = '';
12503                                                 $apt_suites = '';
12504                                                 $apt_types = '';
12505                                         }
12506                                         $apt_types = $type_holder;
12507                                         $b_apt_enabled = 1;
12508                                 }
12509                                 if ($row =~ /^Enabled:\s*(.*)/){
12510                                         my $status = $1;
12511                                         $b_apt_enabled = ($status =~ /no/i) ? 0: 1;
12512                                 }
12513                                 if ($row =~ /:\//){
12514                                         my $url = $row;
12515                                         $url =~ s/^URIs:\s*//;
12516                                         push @apt_working, $url if $url;
12517                                 }
12518                                 if ($row =~ /^Suites:\s*(.*)/){
12519                                         $apt_suites = $1;
12520                                 }
12521                                 if ($row =~ /^Components:\s*(.*)/){
12522                                         $apt_comp = $1;
12523                                 }
12524                                 if ($row =~ /^Architectures:\s*(.*)/){
12525                                         $apt_arch = $1;
12526                                 }
12527                                 # we've hit the last line!!
12528                                 if ($counter == $count && @apt_working){
12529                                         #print "2: url builder\n";
12530                                         if ($b_apt_enabled){
12531                                                 foreach $repo (@apt_working){
12532                                                         my $string = $apt_types;
12533                                                         $string .= ' [arch=' . $apt_arch . ']' if $apt_arch;
12534                                                         $string .= ' ' . $repo;
12535                                                         $string .= ' ' . $apt_suites if $apt_suites ;
12536                                                         $string .= ' ' . $apt_comp if $apt_comp;
12537                                                         #print "s2:$string\n";
12538                                                         push @data3, $string;
12539                                                 }
12540                                         }
12541                                         #print join "\n",@data3,"\n";
12542                                         @apt_urls = (@apt_urls,@data3);
12543                                         @data3 = ();
12544                                         @apt_working = ();
12545                                         $apt_arch = '';
12546                                         $apt_comp = '';
12547                                         $apt_suites = '';
12548                                         $apt_types = '';
12549                                 }
12550                         }
12551                         if (@apt_urls){
12552                                 $key = repo_builder('active','apt');
12553                                 @apt_urls = url_cleaner(@apt_urls);
12554                         }
12555                         else {
12556                                 $key = repo_builder('missing','apt');
12557                         }
12558                         @data = (
12559                         {main::key($num++,$key) => $file},
12560                         [@apt_urls],
12561                         );
12562                         @rows = (@rows,@data);
12563                 }
12564                 @files = ();
12565         }
12566         # pacman: Arch and derived
12567         if (-f $pacman || -f $pacman_g2){
12568                 $repo = 'pacman';
12569                 if (-f $pacman_g2 ){
12570                         $pacman = $pacman_g2;
12571                         $repo = 'pacman-g2';
12572                 }
12573                 @files = main::reader($pacman,'strip');
12574                 if (@files){
12575                         @repos = grep {/^\s*Server/i} @files;
12576                         @files = grep {/^\s*Include/i} @files;
12577                 }
12578                 if (@files){
12579                         @files = map {
12580                                 my @working = split( /\s+=\s+/, $_);
12581                                 $working[1];
12582                         } @files;
12583                 }
12584                 @files = sort(@files);
12585                 @files = main::uniq(@files);
12586                 unshift @files, $pacman if @repos;
12587                 foreach (@files){
12588                         if (-f $_){
12589                                 @data = repo_builder($_,$repo,'^\s*Server','\s*=\s*',1);
12590                                 @rows = (@rows,@data);
12591                         }
12592                         else {
12593                                 # set it so the debugger knows the file wasn't there
12594                                 push @dbg_files, $_ if $debugger_dir;
12595                                 @data = (
12596                                 {main::key($num++,'File listed in') => $pacman},
12597                                 [("$_ does not seem to exist.")],
12598                                 );
12599                                 @rows = (@rows,@data);
12600                         }
12601                 }
12602                 if (!@rows){
12603                         @data = (
12604                         {main::key($num++,repo_builder('missing','no-files')) => $pacman },
12605                         );
12606                         @rows = (@rows,@data);
12607                 }
12608         }
12609         # slackware
12610         if (-f $slackpkg || -f $slackpkg_plus){
12611                 #$slackpkg = "$ENV{HOME}/bin/scripts/inxi/data/repo/slackware/slackpkg-2.conf";
12612                 if (-f $slackpkg){
12613                         @data = repo_builder($slackpkg,'slackpkg','^[[:space:]]*[^#]+');
12614                         @rows = (@rows,@data);
12615                 }
12616                 if (-f $slackpkg_plus){
12617                         push @dbg_files, $slackpkg_plus if $debugger_dir;
12618                         @data =  main::reader($slackpkg_plus,'strip');
12619                         my (@repoplus_list,$active_repos);
12620                         foreach my $row (@data){
12621                                 @data2 = split /\s*=\s*/, $row;
12622                                 @data2 = map { $_ =~ s/^\s+|\s+$//g ; $_ } @data2;
12623                                 last if $data2[0] =~ /^SLACKPKGPLUS/ && $data2[1] eq 'off';
12624                                 # REPOPLUS=( slackpkgplus restricted alienbob ktown multilib slacky)
12625                                 if ($data2[0] =~ /^REPOPLUS/){
12626                                         @repoplus_list = split /\s+/, $data2[1];
12627                                         @repoplus_list = map {s/\(|\)//g; $_} @repoplus_list;
12628                                         $active_repos = join ('|',@repoplus_list);
12629
12630                                 }
12631                                 # MIRRORPLUS['multilib']=http://taper.alienbase.nl/mirrors/people/alien/multilib/14.1/
12632                                 if ($active_repos && $data2[0] =~ /^MIRRORPLUS/){
12633                                         $data2[0] =~ s/MIRRORPLUS\[\'|\'\]//g;
12634                                         if ($data2[0] =~ /$active_repos/){
12635                                                 push @content,"$data2[0] ~ $data2[1]";
12636                                         }
12637                                 }
12638                         }
12639                         if (! @content){
12640                                 $key = repo_builder('missing','slackpkg+');
12641                         }
12642                         else {
12643                                 @content = url_cleaner(@content);
12644                                 $key = repo_builder('active','slackpkg+');
12645                         }
12646                         @data = (
12647                         {main::key($num++,$key) => $slackpkg_plus},
12648                         [@content],
12649                         );
12650                         @data = url_cleaner(@data);
12651                         @rows = (@rows,@data);
12652                         @content = ();
12653                 }
12654         }
12655         # redhat/suse
12656         if (-d $yum_repo_dir || -f $yum_conf || -d $zypp_repo_dir){
12657                 if (-d $yum_repo_dir || -f $yum_conf){
12658                         @files = main::globber("$yum_repo_dir*.repo");
12659                         push @files, $yum_conf if -f $yum_conf;
12660                         $repo = 'yum';
12661                 }
12662                 elsif (-d $zypp_repo_dir){
12663                         @files = main::globber("$zypp_repo_dir*.repo");
12664                         main::log_data('data',"zypp repo files:\n" . main::joiner(\@files, "\n", 'unset')) if $b_log;
12665                         $repo = 'zypp';
12666                 }
12667                 #$repo = 'yum';
12668                 #push @files, "$ENV{'HOME'}/bin/scripts/inxi/data/repo/yum/rpmfusion-nonfree-1.repo";
12669                 if (@files){
12670                         foreach (sort @files){
12671                                 @data2 = main::reader($_);
12672                                 push @dbg_files, $_ if $debugger_dir;
12673                                 my ($enabled,$url,$title) = (undef,'','');
12674                                 foreach my $line (@data2){
12675                                         # this is a hack, assuming that each item has these fields listed, we collect the 3
12676                                         # items one by one, then when the url/enabled fields are set, we print it out and
12677                                         # reset the data. Not elegant but it works. Note that if enabled was not present
12678                                         # we assume it is enabled then, and print the line, reset the variables. This will
12679                                         # miss the last item, so it is printed if found in END
12680                                         if ($line =~ /^\[(.+)\]/){
12681                                                 my $temp = $1;
12682                                                 if ($url && $title && defined $enabled){
12683                                                         if ($enabled > 0){
12684                                                                 push @content, "$title ~ $url";
12685                                                         }
12686                                                         ($enabled,$url,$title) = (undef,'','');
12687                                                 }
12688                                                 $title = $temp;
12689                                         }
12690                                         # Note: it looks like enabled comes before url
12691                                         elsif ($line =~ /^(metalink|mirrorlist|baseurl)\s*=\s*(.*)/){
12692                                                 $url = $2;
12693                                         }
12694                                         # note: enabled = 1. enabled = 0 means disabled
12695                                         elsif ($line =~ /^enabled\s*=\s*([01])/){
12696                                                 $enabled = $1;
12697                                         }
12698                                         # print out the line if all 3 values are found, otherwise if a new
12699                                         # repoTitle is hit above, it will print out the line there instead
12700                                         if ($url && $title && defined $enabled){
12701                                                 if ($enabled > 0){
12702                                                         push @content, "$title ~ $url";
12703                                                 }
12704                                                 ($enabled,$url,$title) = (0,'','');
12705                                         }
12706                                 }
12707                                 # print the last one if there is data for it
12708                                 if ($url && $title && $enabled){
12709                                         push @content, "$title ~ $url";
12710                                 }
12711
12712                                 if (! @content){
12713                                         $key = repo_builder('missing',$repo);
12714                                 }
12715                                 else {
12716                                         @content = url_cleaner(@content);
12717                                         $key = repo_builder('active',$repo);
12718                                 }
12719                                 @data = (
12720                                 {main::key($num++,$key) => $_},
12721                                 [@content],
12722                                 );
12723                                 @rows = (@rows,@data);
12724                                 @content = ();
12725                         }
12726                 }
12727                 # print Data::Dumper::Dumper \@rows;
12728         }
12729         # gentoo
12730         if (-d $portage_dir && main::check_program('emerge')){
12731                 @files = main::globber("$portage_dir*.conf");
12732                 $repo = 'portage';
12733                 if (@files){
12734                         foreach (sort @files){
12735                                 @data2 = main::reader($_);
12736                                 push @dbg_files, $_ if $debugger_dir;
12737                                 my ($enabled,$url,$title) = (undef,'','');
12738                                 foreach my $line (@data2){
12739                                         # this is a hack, assuming that each item has these fields listed, we collect the 3
12740                                         # items one by one, then when the url/enabled fields are set, we print it out and
12741                                         # reset the data. Not elegant but it works. Note that if enabled was not present
12742                                         # we assume it is enabled then, and print the line, reset the variables. This will
12743                                         # miss the last item, so it is printed if found in END
12744                                         if ($line =~ /^\[(.+)\]/){
12745                                                 my $temp = $1;
12746                                                 if ($url && $title && defined $enabled){
12747                                                         if ($enabled > 0){
12748                                                                 push @content, "$title ~ $url";
12749                                                         }
12750                                                         ($enabled,$url,$title) = (undef,'','');
12751                                                 }
12752                                                 $title = $temp;
12753                                         }
12754                                         elsif ($line =~ /^(sync-uri)\s*=\s*(.*)/){
12755                                                 $url = $2;
12756                                         }
12757                                         # note: enabled = 1. enabled = 0 means disabled
12758                                         elsif ($line =~ /^auto-sync\s*=\s*([01])/){
12759                                                 $enabled = $1;
12760                                         }
12761                                         # print out the line if all 3 values are found, otherwise if a new
12762                                         # repoTitle is hit above, it will print out the line there instead
12763                                         if ($url && $title && defined $enabled){
12764                                                 if ($enabled > 0){
12765                                                         push @content, "$title ~ $url";
12766                                                 }
12767                                                 ($enabled,$url,$title) = (undef,'','');
12768                                         }
12769                                 }
12770                                 # print the last one if there is data for it
12771                                 if ($url && $title && $enabled){
12772                                         push @content, "$title ~ $url";
12773                                 }
12774                                 if (! @content){
12775                                         $key = repo_builder('missing','portage');
12776                                 }
12777                                 else {
12778                                         @content = url_cleaner(@content);
12779                                         $key = repo_builder('active','portage');
12780                                 }
12781                                 @data = (
12782                                 {main::key($num++,$key) => $_},
12783                                 [@content],
12784                                 );
12785                                 @rows = (@rows,@data);
12786                                 @content = ();
12787                         }
12788                 }
12789         }
12790         # Alpine linux
12791         if (-f $apk){
12792                 @data = repo_builder($apk,'apk','^\s*[^#]+');
12793                 @rows = (@rows,@data);
12794         }
12795         # Mandriva/Mageia using: urpmq
12796         if ( $path = main::check_program('urpmq') ){
12797                 @data2 = main::grabber("$path --list-media active --list-url","\n",'strip');
12798                 main::writer("$debugger_dir/system-repo-data-urpmq.txt",@data2) if $debugger_dir;
12799                 # now we need to create the structure: repo info: repo path
12800                 # we do that by looping through the lines of the output and then
12801                 # putting it back into the <data>:<url> format print repos expects to see
12802                 # note this structure in the data, so store first line and make start of line
12803                 # then when it's an http line, add it, and create the full line collection.
12804                 # Contrib ftp://ftp.uwsg.indiana.edu/linux/mandrake/official/2011/x86_64/media/contrib/release
12805                 # Contrib Updates ftp://ftp.uwsg.indiana.edu/linux/mandrake/official/2011/x86_64/media/contrib/updates
12806                 # Non-free ftp://ftp.uwsg.indiana.edu/linux/mandrake/official/2011/x86_64/media/non-free/release
12807                 # Non-free Updates ftp://ftp.uwsg.indiana.edu/linux/mandrake/official/2011/x86_64/media/non-free/updates
12808                 # Nonfree Updates (Local19) /mnt/data/mirrors/mageia/distrib/cauldron/x86_64/media/nonfree/updates
12809                 foreach (@data2){
12810                         # need to dump leading/trailing spaces and clear out color codes for irc output
12811                         $_ =~ s/\x1B\[([0-9]{1,2}(;[0-9]{1,2})?)?[m|K]//g;
12812                         $_ =~ s/\e\[([0-9];)?[0-9]+m//g;
12813                         # urpmq output is the same each line, repo name space repo url, can be:
12814                         # rsync://, ftp://, file://, http:// OR repo is locally mounted on FS in some cases
12815                         if (/(.+)\s([\S]+:\/\/.+)/){
12816                                 # pack the repo url
12817                                 push @content, $1;
12818                                 @content = url_cleaner(@content);
12819                                 # get the repo
12820                                 $repo = $2;
12821                                 @data = (
12822                                 {main::key($num++,'urpmq repo') => $repo},
12823                                 [@content],
12824                                 );
12825                                 @rows = (@rows,@data);
12826                                 @content = ();
12827                         }
12828                 }
12829         }
12830         # Pardus/Solus
12831         if ( (-d $pisi_dir && ( $path = main::check_program('pisi') ) ) ||
12832                 (-d $eopkg_dir && ( $path = main::check_program('eopkg') ) ) ){
12833                 #$path = 'eopkg';
12834                 my $which = ($path =~ /pisi$/) ? 'pisi': 'eopkg';
12835                 my $cmd = ($which eq 'pisi') ? "$path list-repo": "$path lr";
12836                 #my $file = "$ENV{HOME}/bin/scripts/inxi/data/repo/solus/eopkg-2.txt";
12837                 #@data2 = main::reader($file,'strip');
12838                 @data2 = main::grabber("$cmd 2>/dev/null","\n",'strip');
12839                 main::writer("$debugger_dir/system-repo-data-$which.txt",@data2) if $debugger_dir;
12840                 # now we need to create the structure: repo info: repo path
12841                 # we do that by looping through the lines of the output and then
12842                 # putting it back into the <data>:<url> format print repos expects to see
12843                 # note this structure in the data, so store first line and make start of line
12844                 # then when it's an http line, add it, and create the full line collection.
12845                 # Pardus-2009.1 [Aktiv]
12846                 #       http://packages.pardus.org.tr/pardus-2009.1/pisi-index.xml.bz2
12847                 # Contrib [Aktiv]
12848                 #       http://packages.pardus.org.tr/contrib-2009/pisi-index.xml.bz2
12849                 # Solus [inactive]
12850                 #       https://packages.solus-project.com/shannon/eopkg-index.xml.xz
12851                 foreach (@data2){
12852                         next if /^\s*$/;
12853                         # need to dump leading/trailing spaces and clear out color codes for irc output
12854                         $_ =~ s/\x1B\[([0-9]{1,2}(;[0-9]{1,2})?)?[m|K]//g;
12855                         $_ =~ s/\e\[([0-9];)?[0-9]+m//g;
12856                         if (/^\/|:\/\//){
12857                                 push @content, $_ if $repo;
12858                         }
12859                         # Local [inactive] Unstable [active]
12860                         elsif ( /^(.*)\s\[([\S]+)\]/){
12861                                 $repo = $1;
12862                                 $repo = ($2 =~ /^activ/i) ? $repo : '';
12863                         }
12864                         if ($repo && @content){
12865                                 @content = url_cleaner(@content);
12866                                 $key = repo_builder('active',$which);
12867                                 @data = (
12868                                 {main::key($num++,$key) => $repo},
12869                                 [@content],
12870                                 );
12871                                 @rows = (@rows,@data);
12872                                 $repo = '';
12873                                 @content = ();
12874                         }
12875                 }
12876                 # last one if present
12877                 if ($repo && @content){
12878                         @content = url_cleaner(@content);
12879                         $key = repo_builder('active',$which);
12880                         @data = (
12881                         {main::key($num++,$key) => $repo},
12882                         [@content],
12883                         );
12884                         @rows = (@rows,@data);
12885                 }
12886         }
12887         # print Dumper \@rows;
12888         eval $end if $b_log;
12889         return @rows;
12890 }
12891 sub get_repos_bsd {
12892         eval $start if $b_log;
12893         my (@content,@data,@data2,@data3,@files,@rows);
12894         my ($key);
12895         my $bsd_pkg = '/usr/local/etc/pkg/repos/';
12896         my $freebsd = '/etc/freebsd-update.conf';
12897         my $freebsd_pkg = '/etc/pkg/FreeBSD.conf';
12898         my $netbsd = '/usr/pkg/etc/pkgin/repositories.conf';
12899         my $openbsd = '/etc/pkg.conf';
12900         my $openbsd2 = '/etc/installurl';
12901         my $portsnap =  '/etc/portsnap.conf';
12902         if ( -f $portsnap || -f $freebsd || -d $bsd_pkg){
12903                 if ( -f $portsnap ) {
12904                         @data = repo_builder($portsnap,'portsnap','^\s*SERVERNAME','\s*=\s*',1);
12905                         @rows = (@rows,@data);
12906                 }
12907                 if ( -f $freebsd ){
12908                         @data = repo_builder($freebsd,'freebsd','^\s*ServerName','\s+',1);
12909                         @rows = (@rows,@data);
12910                 }
12911 #               if ( -f $freebsd_pkg ){
12912 #                       @data = repo_builder($freebsd_pkg,'freebsd-pkg','^\s*url',':\s+',1);
12913 #                       @rows = (@rows,@data);
12914 #               }
12915                 if ( -d $bsd_pkg || -f $freebsd_pkg){
12916                         @files = main::globber('/usr/local/etc/pkg/repos/*.conf');
12917                         push @files, $freebsd_pkg if -f $freebsd_pkg;
12918                         if (@files){
12919                                 my ($url);
12920                                 foreach (@files){
12921                                         push @dbg_files, $_ if $debugger_dir;
12922                                         # these will be result sets separated by an empty line
12923                                         # first dump all lines that start with #
12924                                         @content =  main::reader($_,'strip');
12925                                         # then do some clean up on the lines
12926                                         @content = map { $_ =~ s/{|}|,|\*//g; $_; } @content if @content;
12927                                         # get all rows not starting with a # and starting with a non space character
12928                                         my $url = '';
12929                                         foreach my $line (@content){
12930                                                 if ($line !~ /^\s*$/){
12931                                                         my @data2 = split /\s*:\s*/, $line;
12932                                                         @data2 = map { $_ =~ s/^\s+|\s+$//g; $_; } @data2;
12933                                                         if ($data2[0] eq 'url'){
12934                                                                 $url = "$data2[1]:$data2[2]";
12935                                                                 $url =~ s/"|,//g;
12936                                                         }
12937                                                         #print "url:$url\n" if $url;
12938                                                         if ($data2[0] eq 'enabled'){
12939                                                                 if ($url && $data2[1] eq 'yes'){
12940                                                                         push @data3, "$url"
12941                                                                 }
12942                                                                 $url = '';
12943                                                         }
12944                                                 }
12945                                         }
12946                                         if (! @data3){
12947                                                 $key = repo_builder('missing','bsd-package');
12948                                         }
12949                                         else {
12950                                                 @data3 = url_cleaner(@data3);
12951                                                 $key = repo_builder('active','bsd-package');
12952                                         }
12953                                         @data = (
12954                                         {main::key($num++,$key) => $_},
12955                                         [@data3],
12956                                         );
12957                                         @rows = (@rows,@data);
12958                                         @data3 = ();
12959                                 }
12960                         }
12961                 }
12962         }
12963         elsif (-f $openbsd || -f $openbsd2) {
12964                 if (-f $openbsd){
12965                         @data = repo_builder($openbsd,'openbsd','^installpath','\s*=\s*',1);
12966                         @rows = (@rows,@data);
12967                 }
12968                 if (-f $openbsd2){
12969                         @data = repo_builder($openbsd2,'openbsd','^(http|ftp)','',1);
12970                         @rows = (@rows,@data);
12971                 }
12972         }
12973         elsif (-f $netbsd){
12974                 # not an empty row, and not a row starting with #
12975                 @data = repo_builder($netbsd,'netbsd','^\s*[^#]+$');
12976                 @rows = (@rows,@data);
12977         }
12978         # BSDs do not default always to having repo files, so show correct error
12979         # mesage in that case
12980         if (!@rows){
12981                 if ($bsd_type eq 'freebsd'){
12982                         $key = repo_builder('missing','freebsd-nf');
12983                 }
12984                 elsif ($bsd_type eq 'openbsd'){
12985                         $key = repo_builder('missing','openbsd-nf');
12986                 }
12987                 elsif ($bsd_type eq 'netbsd'){
12988                         $key = repo_builder('missing','netbsd-nf');
12989                 }
12990                 else {
12991                         $key = repo_builder('missing','bsd-nf');
12992                 }
12993                 @data = (
12994                 {main::key($num++,'Message') => $key},
12995                 [()],
12996                 );
12997                 @rows = (@rows,@data);
12998         }
12999         eval $start if $b_log;
13000         return @rows;
13001 }
13002 sub repo_builder {
13003         eval $start if $b_log;
13004         my ($file,$type,$search,$split,$count) = @_;
13005         my (@content,@data,$missing,$key);
13006         my %unfound = (
13007         'apk' => 'No active APK repos in',
13008         'apt' => 'No active apt repos in',
13009         'bsd-package' => 'No enabled BSD pkg servers in',
13010         'bsd-nf' => 'No BSD pkg server files found',
13011         'eopkg' => 'No active eopkg repos found',
13012         'pacman' => 'No active pacman repos in',
13013         'pacman-g2' => 'No active pacman-g2 repos in',
13014         'pisi' => 'No active pisi repos found',
13015         'portage' => 'No enabled portage sources in',
13016         'portsnap' => 'No ports servers in',
13017         'freebsd' => 'No FreeBSD update servers in',
13018         'freebsd-nf' => 'No FreeBSD update server files found',
13019         'freebsd-pkg' => 'No FreeBSD default pkg server in',
13020         'openbsd' => 'No OpenBSD pkg mirrors in',
13021         'openbsd-nf' => 'No OpenBSD pkg mirror files found',
13022         'netbsd' => 'No NetBSD pkg servers in',
13023         'netbsd-nf' => 'No NetBSD pkg server files found',
13024         'no-files' => 'No repo files found in',
13025         'slackpkg' => 'No active slackpkg repos in',
13026         'slackpkg+' => 'No active slackpkg+ repos in',
13027         'yum' => 'No active yum repos in',
13028         'zypp' => 'No active zypp repos in',
13029         );
13030         $missing = $unfound{$type};
13031         return $missing if $file eq 'missing';
13032         my %keys = (
13033         'apk' => 'APK repo',
13034         'apt' => 'Active apt repos in',
13035         'bsd-package' => 'BSD enabled pkg servers in',
13036         'eopkg' => 'Active eopkg repo',
13037         'freebsd' => 'FreeBSD update server',
13038         'freebsd-pkg' => 'FreeBSD default pkg server',
13039         'pacman' => 'Active pacman repo servers in',
13040         'pacman-g2' => 'Active pacman-g2 repo servers in',
13041         'pisi' => 'Active pisi repo',
13042         'portage' => 'Enabled portage sources in',
13043         'portsnap' => 'BSD ports server',
13044         'openbsd' => 'OpenBSD pkg mirror',
13045         'netbsd' => 'NetBSD pkg servers',
13046         'slackpkg' => 'slackpkg repos in',
13047         'slackpkg+' => 'slackpkg+ repos in',
13048         'yum' => 'Active yum repos in',
13049         'zypp' => 'Active zypp repos in',
13050         );
13051         $key = $keys{$type};
13052         return $key if $file eq 'active';
13053         push @dbg_files, $file if $debugger_dir;
13054         @content =  main::reader($file);
13055         @content = grep {/$search/i && !/^\s*$/} @content if @content;
13056         @content = data_cleaner(@content);
13057         if ($split){
13058                 @content = map {
13059                 my @inner = split (/$split/, $_);
13060                 $inner[$count];
13061                 } @content;
13062         }
13063         if (!@content){
13064                 $key = $missing;
13065         }
13066         else {
13067                 @content = url_cleaner(@content);
13068         }
13069         @data = (
13070         {main::key($num++,$key) => $file},
13071         [@content],
13072         );
13073         eval $end if $b_log;
13074         return @data;
13075 }
13076 sub data_cleaner {
13077         my (@content) = @_;
13078         # basics: trim white space, get rid of double spaces
13079         @content = map { $_ =~ s/^\s+|\s+$//g; $_ =~ s/\s\s+/ /g; $_} @content;
13080         return @content;
13081 }
13082 # clean if irc
13083 sub url_cleaner {
13084         my (@content) = @_;
13085         @content = map { $_ =~ s/:\//: \//; $_} @content if $b_irc;
13086         return @content;
13087 }
13088 sub file_path {
13089         my ($filename,$dir) = @_;
13090         my ($working);
13091         $working = $filename;
13092         $working =~ s/^\///;
13093         $working =~ s/\//-/g;
13094         $working = "$dir/file-repo-$working.txt";
13095         return $working;
13096 }
13097 }
13098
13099 ## SensorData
13100 {
13101 package SensorData;
13102 my (@sensors_data);
13103 my ($b_ipmi) = (0);
13104 sub get {
13105         eval $start if $b_log;
13106         my ($key1,$program,$val1,@data,@rows,%sensors);
13107         my $num = 0;
13108         my $source = 'sensors';
13109         # we're allowing 1 or 2 ipmi tools, first the gnu one, then the
13110         # almost certain to be present in BSDs
13111         if ( $b_ipmi ||
13112             ( main::globber('/dev/ipmi**') &&
13113             ( ( $program = main::check_program('ipmi-sensors') ) ||
13114             ( $program = main::check_program('ipmitool') ) ) ) ){
13115                 if ($b_ipmi || $b_root){
13116                         %sensors = ipmi_data($program);
13117                         @data = create_output('ipmi',%sensors);
13118                         if (!@data) {
13119                                 $key1 = 'Message';
13120                                 $val1 = main::row_defaults('sensors-data-ipmi');
13121                                 #$val1 = main::row_defaults('dev');
13122                                 @data = ({main::key($num++,$key1) => $val1,});
13123                         }
13124                         @rows = (@rows,@data);
13125                         $source = 'lm-sensors'; # trips per sensor type output
13126                 }
13127                 else {
13128                         $key1 = 'Permissions';
13129                         $val1 = main::row_defaults('sensors-ipmi-root');
13130                         @data = ({main::key($num++,$key1) => $val1,});
13131                         @rows = (@rows,@data);
13132                 }
13133         }
13134         my $ref = $alerts{'sensors'};
13135         if ( $$ref{'action'} ne 'use'){
13136                 #print "here 1\n";
13137                 $key1 = $$ref{'action'};
13138                 $val1 = $$ref{$key1};
13139                 $key1 = ucfirst($key1);
13140                 @data = ({main::key($num++,$key1) => $val1,});
13141                 @rows = (@rows,@data);
13142         }
13143         else {
13144                 %sensors = lm_sensors_data();
13145                 @data = create_output($source,%sensors);
13146                 #print "here 2\n";
13147                 if (!@data) {
13148                         $key1 = 'Message';
13149                         $val1 = main::row_defaults('sensors-data-linux');
13150                         @data = ({main::key($num++,$key1) => $val1,});
13151                 }
13152                 @rows = (@rows,@data);
13153         }
13154         undef @sensors_data;
13155         eval $end if $b_log;
13156         return @rows;
13157 }
13158 sub create_output {
13159         eval $start if $b_log;
13160         my ($source,%sensors) = @_;
13161         # note: might revisit this, since gpu sensors data might be present
13162         return if ! %sensors;
13163         my (@gpu,@data,@rows,@fan_default,@fan_main);
13164         my ($data_source) = ('');
13165         my $fan_number = 0;
13166         my $num = 0;
13167         my $j = 0;
13168         @gpu = gpu_data() if ( $source eq 'sensors' || $source eq 'lm-sensors' );
13169         my $temp_unit  = (defined $sensors{'temp-unit'}) ? " $sensors{'temp-unit'}": '';
13170         my $cpu_temp = (defined $sensors{'cpu-temp'}) ? $sensors{'cpu-temp'} . $temp_unit: 'N/A';
13171         my $mobo_temp = (defined $sensors{'mobo-temp'}) ? $sensors{'mobo-temp'} . $temp_unit: 'N/A';
13172         my $cpu1_key = ($sensors{'cpu2-temp'}) ? 'cpu-1': 'cpu' ;
13173         $data_source = $source if ($source eq 'ipmi' || $source eq 'lm-sensors');
13174         @data = ({
13175         main::key($num++,'System Temperatures') => $data_source,
13176         main::key($num++,$cpu1_key) => $cpu_temp,
13177         });
13178         @rows = (@rows,@data);
13179         if ($sensors{'cpu2-temp'}){
13180                 $rows[$j]{main::key($num++,'cpu-2')} = $sensors{'cpu2-temp'} . $temp_unit;
13181         }
13182         if ($sensors{'cpu3-temp'}){
13183                 $rows[$j]{main::key($num++,'cpu-3')} = $sensors{'cpu3-temp'} . $temp_unit;
13184         }
13185         if ($sensors{'cpu4-temp'}){
13186                 $rows[$j]{main::key($num++,'cpu-4')} = $sensors{'cpu4-temp'} . $temp_unit;
13187         }
13188         $rows[$j]{main::key($num++,'mobo')} = $mobo_temp;
13189         if (defined $sensors{'sodimm-temp'}){
13190                 my $sodimm_temp = $sensors{'sodimm-temp'} . $temp_unit;
13191                 $rows[$j]{main::key($num++,'sodimm')} = $sodimm_temp;
13192         }
13193         if (defined $sensors{'psu-temp'}){
13194                 my $psu_temp = $sensors{'psu-temp'} . $temp_unit;
13195                 $rows[$j]{main::key($num++,'psu')} = $psu_temp;
13196         }
13197         if (defined $sensors{'ambient-temp'}){
13198                 my $ambient_temp = $sensors{'ambient-temp'} . $temp_unit;
13199                 $rows[$j]{main::key($num++,'ambient')} = $ambient_temp;
13200         }
13201         if (scalar @gpu == 1){
13202                 my $gpu_temp = $gpu[0]{'temp'};
13203                 my $gpu_type = $gpu[0]{'type'};
13204                 my $gpu_unit = (defined $gpu[0]{'temp-unit'} && $gpu_temp ) ? " $gpu[0]{'temp-unit'}" : ' C';
13205                 $rows[$j]{main::key($num++,'gpu')} = $gpu_type;
13206                 $rows[$j]{main::key($num++,'temp')} = $gpu_temp . $gpu_unit;
13207         }
13208         $j = scalar @rows;
13209         my $ref_main = $sensors{'fan-main'};
13210         my $ref_default = $sensors{'fan-default'};
13211         @fan_main = @$ref_main if @$ref_main;
13212         @fan_default = @$ref_default if @$ref_default;
13213         my $fan_def = ($data_source) ? $data_source : '';
13214         if (!@fan_main && !@fan_default){
13215                 $fan_def = ($fan_def) ? "$data_source N/A" : 'N/A';
13216         }
13217         $rows[$j]{main::key($num++,'Fan Speeds (RPM)')} = $fan_def;
13218         my $b_cpu = 0;
13219         for (my $i = 0; $i < scalar @fan_main; $i++){
13220                 next if $i == 0;# starts at 1, not 0
13221                 if (defined $fan_main[$i]){
13222                         if ($i == 1 || ($i == 2 && !$b_cpu )){
13223                                 $rows[$j]{main::key($num++,'cpu')} = $fan_main[$i];
13224                                 $b_cpu = 1;
13225                         }
13226                         elsif ($i == 2 && $b_cpu){
13227                                 $rows[$j]{main::key($num++,'mobo')} = $fan_main[$i];
13228                         }
13229                         elsif ($i == 3){
13230                                 $rows[$j]{main::key($num++,'psu')} = $fan_main[$i];
13231                         }
13232                         elsif ($i == 4){
13233                                 $rows[$j]{main::key($num++,'sodimm')} = $fan_main[$i];
13234                         }
13235                         elsif ($i > 4){
13236                                 $fan_number = $i - 4;
13237                                 $rows[$j]{main::key($num++,"case-$fan_number")} = $fan_main[$i];
13238                         }
13239                 }
13240         }
13241         for (my $i = 0; $i < scalar @fan_default; $i++){
13242                 next if $i == 0;# starts at 1, not 0
13243                 if (defined $fan_default[$i]){
13244                         $rows[$j]{main::key($num++,"fan-$i")} = $fan_default[$i];
13245                 }
13246         }
13247         $rows[$j]{main::key($num++,'psu')} = $sensors{'fan-psu'} if defined $sensors{'fan-psu'};
13248         $rows[$j]{main::key($num++,'psu-1')} = $sensors{'fan-psu1'} if defined $sensors{'fan-psu1'};
13249         $rows[$j]{main::key($num++,'psu-2')} = $sensors{'fan-psu2'} if defined $sensors{'fan-psu2'};
13250         # note: so far, only nvidia-settings returns speed, and that's in percent
13251         if (scalar @gpu == 1 && defined $gpu[0]{'fan-speed'}){
13252                 my $gpu_fan = $gpu[0]{'fan-speed'} . $gpu[0]{'speed-unit'};
13253                 my $gpu_type = $gpu[0]{'type'};
13254                 $rows[$j]{main::key($num++,'gpu')} = $gpu_type;
13255                 $rows[$j]{main::key($num++,'fan')} = $gpu_fan;
13256         }
13257         if (scalar @gpu > 1){
13258                 $j = scalar @rows;
13259                 $rows[$j]{main::key($num++,'GPU')} = '';
13260                 my $gpu_unit = (defined $gpu[0]{'temp-unit'} ) ? " $gpu[0]{'temp-unit'}" : ' C';
13261                 foreach my $ref (@gpu){
13262                         my %info = %$ref;
13263                         # speed unit is either '' or %
13264                         my $gpu_fan = (defined $info{'fan-speed'}) ? $info{'fan-speed'} . $info{'speed-unit'}: undef ;
13265                         my $gpu_type = $info{'type'};
13266                         my $gpu_temp = (defined $info{'temp'} ) ? $info{'temp'} . $gpu_unit: 'N/A';
13267                         $rows[$j]{main::key($num++,'device')} = $gpu_type;
13268                         if (defined $info{'screen'} ){
13269                                 $rows[$j]{main::key($num++,'screen')} = $info{'screen'};
13270                         }
13271                         $rows[$j]{main::key($num++,'temp')} = $gpu_temp;
13272                         if (defined $gpu_fan){
13273                                 $rows[$j]{main::key($num++,'fan')} = $gpu_fan;
13274                         }
13275                 }
13276         }
13277         if ($extra > 0 && ($source eq 'ipmi' ||
13278            ($sensors{'volts-12'} || $sensors{'volts-5'} || $sensors{'volts-3.3'} || $sensors{'volts-vbat'}))){
13279                 $j = scalar @rows;
13280                 $sensors{'volts-12'} ||= 'N/A';
13281                 $sensors{'volts-5'} ||= 'N/A';
13282                 $sensors{'volts-3.3'} ||= 'N/A';
13283                 $sensors{'volts-vbat'} ||= 'N/A';
13284                 $rows[$j]{main::key($num++,'Voltages')} = $data_source;
13285                 $rows[$j]{main::key($num++,'12v')} = $sensors{'volts-12'};
13286                 $rows[$j]{main::key($num++,'5v')} = $sensors{'volts-5'};
13287                 $rows[$j]{main::key($num++,'3.3v')} = $sensors{'volts-3.3'};
13288                 $rows[$j]{main::key($num++,'vbat')} = $sensors{'volts-vbat'};
13289                 if ($extra > 1 && $source eq 'ipmi' ){
13290                         $sensors{'volts-dimm-p1'} ||= 'N/A';
13291                         $sensors{'volts-dimm-p2'} ||= 'N/A';
13292                         $rows[$j]{main::key($num++,'dimm-p1')} = $sensors{'volts-dimm-p1'} if $sensors{'volts-dimm-p1'};
13293                         $rows[$j]{main::key($num++,'dimm-p2')} = $sensors{'volts-dimm-p2'} if $sensors{'volts-dimm-p2'};
13294                         $rows[$j]{main::key($num++,'soc-p1')} = $sensors{'volts-soc-p1'} if $sensors{'volts-soc-p1'};
13295                         $rows[$j]{main::key($num++,'soc-p2')} = $sensors{'volts-soc-p2'} if $sensors{'volts-soc-p2'};
13296                 }
13297         }
13298         eval $end if $b_log;
13299         return @rows;
13300 }
13301 sub ipmi_data {
13302         eval $start if $b_log;
13303         my ($program) = @_;
13304         my ($b_cpu_0,$cmd,$file,@data,$fan_working,%sensors,@row,$sys_fan_nu,
13305         $temp_working,$working_unit);
13306         $program ||= 'ipmi-sensors'; # only for debugging, will always exist if reaches here
13307         my ($b_ipmitool,$i_key,$i_value,$i_unit);
13308         if ($program =~ /ipmi-sensors$/){
13309                 $cmd = $program;
13310                 ($b_ipmitool,$i_key,$i_value,$i_unit) = (0,1,3,4);
13311         }
13312         else {
13313                 $cmd = "$program sensors";
13314                 ($b_ipmitool,$i_key,$i_value,$i_unit) = (1,0,1,2);
13315         }
13316         @data = main::grabber("$cmd 2>/dev/null");
13317         #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/ipmitool/ipmitool-sensors-archerseven-1.txt";
13318         #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/ipmitool/ipmitool-sensors-crazy-epyc-1.txt";
13319         #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/ipmitool/ipmi-sensors-crazy-epyc-1.txt";$program='ipmi-sensors';
13320         #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/ipmitool/ipmitool-sensors-RK016013.txt";$program='ipmi-sensors';
13321         #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/ipmitool/ipmi-sensors-lathander.txt";
13322         #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/ipmitool/ipmi-sensors-zwerg.txt";
13323         #@data = main::reader($file);
13324         return if ! @data;
13325         foreach (@data){
13326                 next if /^\s*$/;
13327                 # print "$_\n";
13328                 @row = split /\s*\|\s*/, $_;
13329                 next if $row[$i_value] !~ /^[0-9\.]+$/i;
13330                 # print "$row[$i_key] - $row[$i_value]\n";
13331                 if ($row[$i_key] =~ /^(System[\s_]Temp|System[\s_]?Board)$/i){
13332                         $sensors{'mobo-temp'} = int($row[$i_value]);
13333                         $working_unit = $row[$i_unit];
13334                         $working_unit =~ s/degrees\s// if $b_ipmitool;
13335                         $sensors{'temp-unit'} = set_temp_unit($sensors{'temp-unit'},$working_unit) if $working_unit;
13336                 }
13337                 elsif ($row[$i_key] =~ /^(Ambient)$/i){
13338                         $sensors{'ambient-temp'} = int($row[$i_value]);
13339                         $working_unit = $row[$i_unit];
13340                         $working_unit =~ s/degrees\s// if $b_ipmitool;
13341                         $sensors{'temp-unit'} = set_temp_unit($sensors{'temp-unit'},$working_unit) if $working_unit;
13342                 }
13343                 # Platform Control Hub (PCH), it is the X370 chip on the Crosshair VI Hero.
13344                 # VRM: voltage regulator module
13345                 # NOTE: CPU0_TEMP CPU1_TEMP is possible, unfortunately; CPU Temp Interf
13346                 elsif ( !$sensors{'cpu-temp'} && $row[$i_key] =~ /^CPU([01])?([\s_]Temp)?$/i) {
13347                         $b_cpu_0 = 1 if defined $1 && $1 == 0;
13348                         $sensors{'cpu-temp'} = int($row[$i_value]);
13349                         $working_unit = $row[$i_unit];
13350                         $working_unit =~ s/degrees\s// if $b_ipmitool;
13351                         $sensors{'temp-unit'} = set_temp_unit($sensors{'temp-unit'},$working_unit) if $working_unit;
13352                 }
13353                 elsif ($row[$i_key] =~ /^CPU([1-4])([\s_]Temp)?$/i) {
13354                         $temp_working = $1;
13355                         $temp_working++ if $b_cpu_0;
13356                         $sensors{"cpu${temp_working}-temp"} = int($row[$i_value]);
13357                         $working_unit = $row[$i_unit];
13358                         $working_unit =~ s/degrees\s// if $b_ipmitool;
13359                         $sensors{'temp-unit'} = set_temp_unit($sensors{'temp-unit'},$working_unit) if $working_unit;
13360                 }
13361                 # for temp1/2 only use temp1/2 if they are null or greater than the last ones
13362                 elsif ($row[$i_key] =~ /^(MB[_]?TEMP1|Temp[\s_]1)$/i) {
13363                         $temp_working = int($row[$i_value]);
13364                         $working_unit = $row[$i_unit];
13365                         $working_unit =~ s/degrees\s// if $b_ipmitool;
13366                         if ( !$sensors{'temp1'} || ( defined $temp_working && $temp_working > 0 ) ) {
13367                                 $sensors{'temp1'} = $temp_working;
13368                         }
13369                         $sensors{'temp-unit'} = set_temp_unit($sensors{'temp-unit'},$working_unit) if $working_unit;
13370                 }
13371                 elsif ($row[$i_key] =~ /^(MB[_]?TEMP2|Temp[\s_]2)$/i) {
13372                         $temp_working = int($row[$i_value]);
13373                         $working_unit = $row[$i_unit];
13374                         $working_unit =~ s/degrees\s// if $b_ipmitool;
13375                         if ( !$sensors{'temp2'} || ( defined $temp_working && $temp_working > 0 ) ) {
13376                                 $sensors{'temp2'} = $temp_working;
13377                         }
13378                         $sensors{'temp-unit'} = set_temp_unit($sensors{'temp-unit'},$working_unit) if $working_unit;
13379                 }
13380                 # temp3 is only used as an absolute override for systems with all 3 present
13381                 elsif ($row[$i_key] =~ /^(MB[_]?TEMP3|Temp[\s_]3)$/i) {
13382                         $temp_working = int($row[$i_value]);
13383                         $working_unit = $row[$i_unit];
13384                         $working_unit =~ s/degrees\s// if $b_ipmitool;
13385                         if ( !$sensors{'temp3'} || ( defined $temp_working && $temp_working > 0 ) ) {
13386                                 $sensors{'temp3'} = $temp_working;
13387                         }
13388                         $sensors{'temp-unit'} = set_temp_unit($sensors{'temp-unit'},$working_unit) if $working_unit;
13389                 }
13390                 elsif (!$sensors{'sodimm-temp'} && $row[$i_key] =~ /^(DIMM-[0-9][A-Z]?)$/i){
13391                         $sensors{'sodimm-temp'} = int($row[$i_value]);
13392                         $working_unit = $row[$i_unit];
13393                         $working_unit =~ s/degrees\s// if $b_ipmitool;
13394                         $sensors{'temp-unit'} = set_temp_unit($sensors{'temp-unit'},$working_unit) if $working_unit;
13395                 }
13396                 # note: can be cpu fan:, cpu fan speed:, etc.
13397                 elsif ($row[$i_key] =~ /^(CPU|Processor)[\s_]Fan/i) {
13398                         $sensors{'fan-main'} = () if !$sensors{'fan-main'};
13399                         $sensors{'fan-main'}[1] = int($row[$i_value]);
13400                 }
13401                 # note that the counters are dynamically set for fan numbers here
13402                 # otherwise you could overwrite eg aux fan2 with case fan2 in theory
13403                 # note: cpu/mobo/ps are 1/2/3
13404                 elsif ($row[$i_key] =~ /^(SYS[\s_])?FAN[\s_]?([0-9A-F]+)/i) {
13405                         $sys_fan_nu = hex($2);
13406                         next if $row[$i_value] !~ /^[0-9\.]+$/;
13407                         $fan_working = int($row[$i_value]);
13408                         $sensors{'fan-default'} = () if !$sensors{'fan-default'};
13409                         if ( $sys_fan_nu =~ /^([0-9]+)$/ ) {
13410                                 # add to array if array index does not exist OR if number is > existing number
13411                                 if ( defined $sensors{'fan-default'}[$sys_fan_nu] ) {
13412                                         if ( $fan_working >= $sensors{'fan-default'}[$sys_fan_nu] ) {
13413                                                 $sensors{'fan-default'}[$sys_fan_nu] = $fan_working;
13414                                         }
13415                                 }
13416                                 else {
13417                                         $sensors{'fan-default'}[$sys_fan_nu] = $fan_working;
13418                                 }
13419                         }
13420                 }
13421                 elsif ($row[$i_key] =~ /^(FAN PSU|PSU FAN)$/i) {
13422                         $sensors{'fan-psu'} = int($row[$i_value]);
13423                 }
13424                 elsif ($row[$i_key] =~ /^(FAN PSU1|PSU1 FAN)$/i) {
13425                         $sensors{'fan-psu-1'} = int($row[$i_value]);
13426                 }
13427                 elsif ($row[$i_key] =~ /^(FAN PSU2|PSU2 FAN)$/i) {
13428                         $sensors{'fan-psu-2'} = int($row[$i_value]);
13429                 }
13430                 if ($extra > 0){
13431                         if ($row[$i_key] =~ /^(MAIN\s|P[_]?)?12V$/i) {
13432                                 $sensors{'volts-12'} = $row[$i_value];
13433                         }
13434                         elsif ($row[$i_key] =~ /^(MAIN\s5V|P5V|5VCC|5V PG)$/i) {
13435                                 $sensors{'volts-5'} = $row[$i_value];
13436                         }
13437                         elsif ($row[$i_key] =~ /^(MAIN\s3.3V|P3V3|3.3VCC|3.3V PG)$/i) {
13438                                 $sensors{'volts-3.3'} = $row[$i_value];
13439                         }
13440                         elsif ($row[$i_key] =~ /^((P_)?VBAT|CMOS Battery|BATT 3.0V)$/i) {
13441                                 $sensors{'volts-vbat'} = $row[$i_value];
13442                         }
13443                         # NOTE: VDimmP1ABC VDimmP1DEF
13444                         elsif (!$sensors{'volts-dimm-p1'} && $row[$i_key] =~ /^(P1_VMEM|VDimmP1|MEM RSR A PG)/i) {
13445                                 $sensors{'volts-dimm-p1'} = $row[$i_value];
13446                         }
13447                         elsif (! $sensors{'volts-dimm-p2'} && $row[$i_key] =~ /^(P2_VMEM|VDimmP2|MEM RSR B PG)/i) {
13448                                 $sensors{'volts-dimm-p2'} = $row[$i_value];
13449                         }
13450                         elsif (!$sensors{'volts-soc-p1'} && $row[$i_key] =~ /^(P1_SOC_RUN$)/i) {
13451                                 $sensors{'volts-soc-p1'} = $row[$i_value];
13452                         }
13453                         elsif (! $sensors{'volts-soc-p2'} && $row[$i_key] =~ /^(P2_SOC_RUN$)/i) {
13454                                 $sensors{'volts-soc-p2'} = $row[$i_value];
13455                         }
13456                 }
13457         }
13458         # print Data::Dumper::Dumper \%sensors;
13459         %sensors = data_processor(%sensors) if %sensors;
13460         main::log_data('dump','ipmi: %sensors',\%sensors) if $b_log;
13461         eval $end if $b_log;
13462         # print Data::Dumper::Dumper \%sensors;
13463         return %sensors;
13464 }
13465 sub lm_sensors_data {
13466         eval $start if $b_log;
13467         my (%sensors);
13468         my ($b_valid,$sys_fan_nu)  = (0,0);
13469         my ($adapter,$fan_working,$temp_working,$working_unit)  = ('','','','');
13470         @sensors_data = main::grabber(main::check_program('sensors') . " 2>/dev/null");
13471         #my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/sensors/amdgpu-w-fan-speed-stretch-k10.txt";
13472         #my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/sensors/peci-tin-geggo.txt";
13473         #my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/sensors/sensors-w-other-biker.txt";
13474         #my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/sensors/sensors-asus-chassis-1.txt";
13475         #my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/sensors/sensors-devnull-1.txt";
13476         #@sensors_data = main::reader($file);
13477         #print @sensors_data;
13478         @sensors_data = map {$_ =~ s/\s*:\s*\+?/:/;$_} @sensors_data;
13479         foreach (@sensors_data){
13480                 # we get this from gpu_data()
13481                 if (/^(amdgpu|intel|nouveau|radeon|.*hwmon)-pci/){
13482                         $b_valid = 0;
13483                         $adapter = '';
13484                         next;
13485                 }
13486                 if (/^(?:(?!amdgpu|intel|nouveau|radeon|.*hwmon).)*-(isa|pci|virtual)-/){
13487                         $b_valid = 1;
13488                         $adapter = $1;
13489                         next;
13490                 }
13491                 next if !$b_valid;
13492                 my @working = split /:/, $_;
13493                 next if !$working[0] || /^Adapter/;
13494                 #print "$working[0]:$working[1]\n";
13495                 # There are some guesses here, but with more sensors samples it will get closer.
13496                 # note: using arrays starting at 1 for all fan arrays to make it easier overall
13497                 # we have to be sure we are working with the actual real string before assigning
13498                 # data to real variables and arrays. Extracting C/F degree unit as well to use
13499                 # when constructing temp items for array.
13500                 # note that because of charset issues, no "°" degree sign used, but it is required
13501                 # in testing regex to avoid error. It might be because I got that data from a forum post,
13502                 # note directly via debugger.
13503                 if ($_ =~ /^(AMBIENT|M\/B|MB|SIO|SYS).*:([0-9\.]+)[\s°]*(C|F)/i) {
13504                         $sensors{'mobo-temp'} = $2;
13505                         $working_unit = $3;
13506                         $sensors{'temp-unit'} = set_temp_unit($sensors{'temp-unit'},$working_unit) if $working_unit;
13507                 }
13508                 # issue 58 msi/asus show wrong for CPUTIN so overwrite it if PECI 0 is present
13509                 # http://www.spinics.net/lists/lm-sensors/msg37308.html
13510                 # NOTE: had: ^CPU.*\+([0-9]+): but that misses: CPUTIN and anything not with + in starter
13511                 # However, "CPUTIN is not a reliable measurement because it measures difference to Tjmax,
13512                 # which is the maximum CPU temperature reported as critical temperature by coretemp"
13513                 # NOTE: I've seen an inexplicable case where: CPU:52.0°C fails to match with [\s°] but
13514                 # does match with: [\s°]*. I can't account for this, but that's why the * is there
13515                 # Tdie is a new k10temp-pci syntax for cpu die temp
13516                 elsif ($_ =~ /^(CPU.*|Tdie.*):([0-9\.]+)[\s°]*(C|F)/i) {
13517                         $temp_working = $2;
13518                         $working_unit = $3;
13519                         if ( !$sensors{'cpu-temp'} ||
13520                            ( defined $temp_working && $temp_working > 0 && $temp_working > $sensors{'cpu-temp'} ) ) {
13521                                 $sensors{'cpu-temp'} = $temp_working;
13522                         }
13523                         $sensors{'temp-unit'} = set_temp_unit($sensors{'temp-unit'},$working_unit) if $working_unit;
13524                 }
13525                 elsif ($_ =~ /^PECI\sAgent\s0.*:([0-9\.]+)[\s°]*(C|F)/i) {
13526                         $sensors{'cpu-peci-temp'} = $1;
13527                         $working_unit = $2;
13528                         $sensors{'temp-unit'} = set_temp_unit($sensors{'temp-unit'},$working_unit) if $working_unit;
13529                 }
13530                 elsif ($_ =~ /^(P\/S|Power).*:([0-9\.]+)[\s°]*(C|F)/i) {
13531                         $sensors{'psu-temp'} = $2;
13532                         $working_unit = $3;
13533                         $sensors{'temp-unit'} = set_temp_unit($sensors{'temp-unit'},$working_unit) if $working_unit;
13534                 }
13535                 elsif ($_ =~ /^SODIMM.*:([0-9\.]+)[\s°]*(C|F)/i) {
13536                         $sensors{'sodimm-temp'} = $1;
13537                         $working_unit = $2;
13538                         $sensors{'temp-unit'} = set_temp_unit($sensors{'temp-unit'},$working_unit) if $working_unit;
13539                 }
13540                 # for temp1/2 only use temp1/2 if they are null or greater than the last ones
13541                 elsif ($_ =~ /^temp1:([0-9\.]+)[\s°]*(C|F)/i) {
13542                         $temp_working = $1;
13543                         $working_unit = $2;
13544                         if ( !$sensors{'temp1'} ||
13545                            ( defined $temp_working && $temp_working > 0 && $temp_working > $sensors{'temp1'} ) ) {
13546                                 $sensors{'temp1'} = $temp_working;
13547                         }
13548                         $sensors{'temp-unit'} = set_temp_unit($sensors{'temp-unit'},$working_unit) if $working_unit;
13549                 }
13550                 elsif ($_ =~ /^temp2:([0-9\.]+)[\s°]*(C|F)/i) {
13551                         $temp_working = $1;
13552                         $working_unit = $2;
13553                         if ( !$sensors{'temp2'} ||
13554                            ( defined $temp_working && $temp_working > 0 && $temp_working > $sensors{'temp2'} ) ) {
13555                                 $sensors{'temp2'} = $temp_working;
13556                         }
13557                         $sensors{'temp-unit'} = set_temp_unit($sensors{'temp-unit'},$working_unit) if $working_unit;
13558                 }
13559                 # temp3 is only used as an absolute override for systems with all 3 present
13560                 elsif ($_ =~ /^temp3:([0-9\.]+)[\s°]*(C|F)/i) {
13561                         $temp_working = $1;
13562                         $working_unit = $2;
13563                         if ( !$sensors{'temp3'} ||
13564                            ( defined $temp_working && $temp_working > 0 && $temp_working > $sensors{'temp3'} ) ) {
13565                                 $sensors{'temp3'} = $temp_working;
13566                         }
13567                         $sensors{'temp-unit'} = set_temp_unit($sensors{'temp-unit'},$working_unit) if $working_unit;
13568                 }
13569                 # final fallback if all else fails, funtoo user showed sensors putting
13570                 # temp on wrapped second line, not handled
13571                 elsif ($_ =~ /^(core0|core 0|Physical id 0)(.*):([0-9\.]+)[\s°]*(C|F)/i) {
13572                         $temp_working = $3;
13573                         $working_unit = $4;
13574                         if ( !$sensors{'core-0-temp'} ||
13575                            ( defined $temp_working && $temp_working > 0 && $temp_working > $sensors{'core-0-temp'} ) ) {
13576                                 $sensors{'core-0-temp'} = $temp_working;
13577                         }
13578                         $sensors{'temp-unit'} = set_temp_unit($sensors{'temp-unit'},$working_unit) if $working_unit;
13579                 }
13580                 # note: can be cpu fan:, cpu fan speed:, etc.
13581                 elsif (!$sensors{'fan-main'}[1] && $_ =~ /^(CPU|Processor).*:([0-9]+)[\s]RPM/i) {
13582                         $sensors{'fan-main'} = () if !$sensors{'fan-main'};
13583                         $sensors{'fan-main'}[1] = $2;
13584                 }
13585                 elsif (!$sensors{'fan-main'}[2] && $_ =~ /^(M\/B|MB|SYS).*:([0-9]+)[\s]RPM/i) {
13586                         $sensors{'fan-main'} = () if !$sensors{'fan-main'};
13587                         $sensors{'fan-main'}[2] = $2;
13588                 }
13589                 elsif (!$sensors{'fan-main'}[3] && $_ =~ /(Power|P\/S|POWER).*:([0-9]+)[\s]RPM/i) {
13590                         $sensors{'fan-main'} = () if !$sensors{'fan-main'};
13591                         $sensors{'fan-main'}[3] = $2;
13592                 }
13593                 elsif (!$sensors{'fan-main'}[4] && $_ =~ /(SODIMM).*:([0-9]+)[\s]RPM/i) {
13594                         $sensors{'fan-main'} = () if !$sensors{'fan-main'};
13595                         $sensors{'fan-main'}[4] = $2;
13596                 }
13597                 # note that the counters are dynamically set for fan numbers here
13598                 # otherwise you could overwrite eg aux fan2 with case fan2 in theory
13599                 # note: cpu/mobo/ps/sodimm are 1/2/3/4
13600                 elsif ($_ =~ /^(AUX|CASE|CHASSIS).*:([0-9]+)[\s]RPM/i) {
13601                         $temp_working = $2;
13602                         $sensors{'fan-main'} = () if !$sensors{'fan-main'};
13603                         for ( my $i = 5; $i < 30; $i++ ){
13604                                 next if defined $sensors{'fan-main'}[$i];
13605                                 if ( !defined $sensors{'fan-main'}[$i] ){
13606                                         $sensors{'fan-main'}[$i] = $temp_working;
13607                                         last;
13608                                 }
13609                         }
13610                 }
13611                 # in rare cases syntax is like: fan1: xxx RPM
13612                 elsif ($_ =~ /^FAN(1)?:([0-9]+)[\s]RPM/i) {
13613                         $sensors{'fan-default'} = () if !$sensors{'fan-default'};
13614                         $sensors{'fan-default'}[1] = $2;
13615                 }
13616                 elsif ($_ =~ /^FAN([2-9]|1[0-9]).*:([0-9]+)[\s]RPM/i) {
13617                         $fan_working = $2;
13618                         $sys_fan_nu = $1;
13619                         $sensors{'fan-default'} = () if !$sensors{'fan-default'};
13620                         if ( $sys_fan_nu =~ /^([0-9]+)$/ ) {
13621                                 # add to array if array index does not exist OR if number is > existing number
13622                                 if ( defined $sensors{'fan-default'}[$sys_fan_nu] ) {
13623                                         if ( $fan_working >= $sensors{'fan-default'}[$sys_fan_nu] ) {
13624                                                 $sensors{'fan-default'}[$sys_fan_nu] = $fan_working;
13625                                         }
13626                                 }
13627                                 else {
13628                                         $sensors{'fan-default'}[$sys_fan_nu] = $fan_working;
13629                                 }
13630                         }
13631                 }
13632                 if ($extra > 0){
13633                         if ($_ =~ /^[+]?(12 Volt|12V).*:([0-9\.]+)\sV/i) {
13634                                 $sensors{'volts-12'} = $2;
13635                         }
13636                         # note: 5VSB is a field name
13637                         elsif ($_ =~ /^[+]?(5 Volt|5V):([0-9\.]+)\sV/i) {
13638                                 $sensors{'volts-5'} = $2;
13639                         }
13640                         elsif ($_ =~ /^[+]?(3\.3 Volt|3\.3V).*:([0-9\.]+)\sV/i) {
13641                                 $sensors{'volts-3.3'} = $2;
13642                         }
13643                         elsif ($_ =~ /^(Vbat).*:([0-9\.]+)\sV/i) {
13644                                 $sensors{'volts-vbat'} = $2;
13645                         }
13646                 }
13647         }
13648         # print Data::Dumper::Dumper \%sensors;
13649         %sensors = data_processor(%sensors) if %sensors;
13650         main::log_data('dump','lm-sensors: %sensors',\%sensors) if $b_log;
13651         # print Data::Dumper::Dumper \%sensors;
13652         eval $end if $b_log;
13653         return %sensors;
13654 }
13655
13656 # oddly, openbsd sysctl actually has hw.sensors data!
13657 sub sysctl_data {
13658         eval $start if $b_log;
13659         my (@data,%sensors);
13660         foreach (@sysctl_sensors){
13661                 if (/^hw.sensors\.([0-9a-z]+)\.(temp|fan|volt)([0-9])/){
13662                         my $sensor = $1;
13663                         my $type = $2;
13664                         my $number = $3;
13665                         my @working = split /:/, $_;
13666                 }
13667                 last if /^(hw.cpuspeed|hw.vendor|hw.physmem)/;
13668         }
13669
13670         %sensors = data_processor(%sensors) if %sensors;
13671         main::log_data('dump','%sensors',\%sensors) if $b_log;
13672         # print Data::Dumper::Dumper \%sensors;
13673         eval $end if $b_log;
13674         return %sensors;
13675 }
13676 sub set_temp_unit {
13677         my ($sensors,$working) = @_;
13678         my $return_unit = '';
13679
13680         if ( !$sensors && $working ){
13681                 $return_unit = $working;
13682         }
13683         elsif ($sensors){
13684                 $return_unit = $sensors;
13685         }
13686         return $return_unit;
13687 }
13688
13689 sub data_processor {
13690         eval $start if $b_log;
13691         my (%sensors) = @_;
13692         my ($cpu_temp,$cpu2_temp,$cpu3_temp,$cpu4_temp,$index_count_fan_default,
13693         $index_count_fan_main,$mobo_temp,$psu_temp) = (0,0,0,0,0,0,0,0);
13694         my ($fan_type,$i,$j) = (0,0,0);
13695         my $temp_diff = 20; # for C, handled for F after that is determined
13696         my (@fan_main,@fan_default);
13697         # first we need to handle the case where we have to determine which temp/fan to use for cpu and mobo:
13698         # note, for rare cases of weird cool cpus, user can override in their prefs and force the assignment
13699         # this is wrong for systems with > 2 tempX readings, but the logic is too complex with 3 variables
13700         # so have to accept that it will be wrong in some cases, particularly for motherboard temp readings.
13701         if ( $sensors{'temp1'} && $sensors{'temp2'} ){
13702                 if ( $sensors_cpu_nu ) {
13703                         $fan_type = $sensors_cpu_nu;
13704                 }
13705                 else {
13706                         # first some fringe cases with cooler cpu than mobo: assume which is cpu temp based on fan speed
13707                         # but only if other fan speed is 0.
13708                         if ( $sensors{'temp1'} >= $sensors{'temp2'} &&
13709                              defined $fan_default[1] && defined $fan_default[2] && $fan_default[1] == 0 && $fan_default[2] > 0 ) {
13710                                 $fan_type = 2;
13711                         }
13712                         elsif ( $sensors{'temp2'} >= $sensors{'temp1'} &&
13713                                 defined $fan_default[1] && defined $fan_default[2] && $fan_default[2] == 0 && $fan_default[1] > 0 ) {
13714                                 $fan_type = 1;
13715                         }
13716                         # then handle the standard case if these fringe cases are false
13717                         elsif ( $sensors{'temp1'} >= $sensors{'temp2'} ) {
13718                                 $fan_type = 1;
13719                         }
13720                         else {
13721                                 $fan_type = 2;
13722                         }
13723                 }
13724         }
13725         # need a case for no temps at all reported, like with old intels
13726         elsif ( !$sensors{'temp2'} && !$sensors{'cpu-temp'} ){
13727                 if ( !$sensors{'temp1'} && !$sensors{'mobo-temp'} ){
13728                         $fan_type = 1;
13729                 }
13730                 elsif ( $sensors{'temp1'} && !$sensors{'mobo-temp'} ){
13731                         $fan_type = 1;
13732                 }
13733                 elsif ( $sensors{'temp1'} && $sensors{'mobo-temp'} ){
13734                         $fan_type = 1;
13735                 }
13736         }
13737         # convert the diff number for F, it needs to be bigger that is
13738         if ( $sensors{'temp-unit'} && $sensors{'temp-unit'} eq "F" ) {
13739                 $temp_diff = $temp_diff * 1.8
13740         }
13741         if ( $sensors{'cpu-temp'} ) {
13742                 # specific hack to handle broken CPUTIN temps with PECI
13743                 if ( $sensors{'cpu-peci-temp'} && ( $sensors{'cpu-temp'} - $sensors{'cpu-peci-temp'} ) > $temp_diff ){
13744                         $cpu_temp = $sensors{'cpu-peci-temp'};
13745                 }
13746                 # then get the real cpu temp, best guess is hottest is real, though only within narrowed diff range
13747                 else {
13748                         $cpu_temp = $sensors{'cpu-temp'};
13749                 }
13750         }
13751         else {
13752                 if ($fan_type ){
13753                         # there are some weird scenarios
13754                         if ( $fan_type == 1 ){
13755                                 if ( $sensors{'temp1'} && $sensors{'temp2'} && $sensors{'temp2'} > $sensors{'temp1'} ) {
13756                                         $cpu_temp = $sensors{'temp2'};
13757                                 }
13758                                 else {
13759                                         $cpu_temp = $sensors{'temp1'};
13760                                 }
13761                         }
13762                         else {
13763                                 if ( $sensors{'temp1'} && $sensors{'temp2'} && $sensors{'temp1'} > $sensors{'temp2'} ) {
13764                                         $cpu_temp = $sensors{'temp1'};
13765                                 }
13766                                 else {
13767                                         $cpu_temp = $sensors{'temp2'};
13768                                 }
13769                         }
13770                 }
13771                 else {
13772                         $cpu_temp = $sensors{'temp1'}; # can be null, that is ok
13773                 }
13774                 if ( $cpu_temp ) {
13775                         # using $sensors{'temp3'} is just not reliable enough, more errors caused than fixed imo
13776                         #if ( $sensors{'temp3'} && $sensors{'temp3'} > $cpu_temp ) {
13777                         #       $cpu_temp = $sensors{'temp3'};
13778                         #}
13779                         # there are some absurdly wrong $sensors{'temp1'}: acpitz-virtual-0 $sensors{'temp1'}: +13.8°C
13780                         if ( $sensors{'core-0-temp'} && ($sensors{'core-0-temp'} - $cpu_temp) > $temp_diff ) {
13781                                 $cpu_temp = $sensors{'core-0-temp'};
13782                         }
13783                 }
13784         }
13785         # if all else fails, use core0/peci temp if present and cpu is null
13786         if ( !$cpu_temp ) {
13787                 if ( $sensors{'core-0-temp'} ) {
13788                         $cpu_temp = $sensors{'core-0-temp'};
13789                 }
13790                 # note that peci temp is known to be colder than the actual system
13791                 # sometimes so it is the last fallback we want to use even though in theory
13792                 # it is more accurate, but fact suggests theory wrong.
13793                 elsif ( $sensors{'cpu-peci-temp'} ) {
13794                         $cpu_temp = $sensors{'cpu-peci-temp'};
13795                 }
13796         }
13797         # then the real mobo temp
13798         if ( $sensors{'mobo-temp'} ){
13799                 $mobo_temp = $sensors{'mobo-temp'};
13800         }
13801         elsif ( $fan_type ){
13802                 if ( $fan_type == 1 ) {
13803                         if ( $sensors{'temp1'} && $sensors{'temp2'} && $sensors{'temp2'} > $sensors{'temp1'} ) {
13804                                 $mobo_temp = $sensors{'temp1'};
13805                         }
13806                         else {
13807                                 $mobo_temp = $sensors{'temp2'};
13808                         }
13809                 }
13810                 else {
13811                         if ( $sensors{'temp1'} && $sensors{'temp2'} && $sensors{'temp1'} > $sensors{'temp2'} ) {
13812                                 $mobo_temp = $sensors{'temp2'};
13813                         }
13814                         else {
13815                                 $mobo_temp = $sensors{'temp1'};
13816                         }
13817                 }
13818                 ## NOTE: not safe to assume $sensors{'temp3'} is the mobo temp, sad to say
13819                 #if ( $sensors{'temp1'} && $sensors{'temp2'} && $sensors{'temp3'} && $sensors{'temp3'} < $mobo_temp ) {
13820                 #       $mobo_temp = $sensors{'temp3'};
13821                 #}
13822         }
13823         else {
13824                 $mobo_temp = $sensors{'temp2'};
13825         }
13826         @fan_main = @{$sensors{'fan-main'}} if $sensors{'fan-main'};
13827         $index_count_fan_main = (@fan_main) ? scalar @fan_main : 0;
13828         @fan_default = @{$sensors{'fan-default'}} if $sensors{'fan-default'};
13829         $index_count_fan_default = (@fan_default) ? scalar @fan_default : 0;
13830         # then set the cpu fan speed
13831         if ( ! $fan_main[1] ) {
13832                 # note, you cannot test for $fan_default[1] or [2] != ""
13833                 # because that creates an array item in gawk just by the test itself
13834                 if ( $fan_type == 1 && defined $fan_default[1] ) {
13835                         $fan_main[1] = $fan_default[1];
13836                         $fan_default[1] = undef;
13837                 }
13838                 elsif ( $fan_type == 2 && defined $fan_default[2] ) {
13839                         $fan_main[1] = $fan_default[2];
13840                         $fan_default[2] = undef;
13841                 }
13842         }
13843         # clear out any duplicates. Primary fan real trumps fan working always if same speed
13844         for ($i = 1; $i <= $index_count_fan_main; $i++) {
13845                 if ( defined $fan_main[$i] && $fan_main[$i] ) {
13846                         for ($j = 1; $j <= $index_count_fan_default; $j++) {
13847                                 if ( defined $fan_default[$j] && $fan_main[$i] == $fan_default[$j] ) {
13848                                         $fan_default[$j] = undef;
13849                                 }
13850                         }
13851                 }
13852         }
13853         # now see if you can find the fast little mobo fan, > 5000 rpm and put it as mobo
13854         # note that gawk is returning true for some test cases when $fan_default[j] < 5000
13855         # which has to be a gawk bug, unless there is something really weird with arrays
13856         # note: 500 > $fan_default[j] < 1000 is the exact trigger, and if you manually
13857         # assign that value below, the > 5000 test works again, and a print of the value
13858         # shows the proper value, so the corruption might be internal in awk.
13859         # Note: gensub is the culprit I think, assigning type string for range 501-1000 but
13860         # type integer for all others, this triggers true for >
13861         for ($j = 1; $j <= $index_count_fan_default; $j++) {
13862                 if ( defined $fan_default[$j] && $fan_default[$j] > 5000 && !$fan_main[2] ) {
13863                         $fan_main[2] = $fan_default[$j];
13864                         $fan_default[$j] = '';
13865                         # then add one if required for output
13866                         if ( $index_count_fan_main < 2 ) {
13867                                 $index_count_fan_main = 2;
13868                         }
13869                 }
13870         }
13871         # if they are ALL null, print error message. psFan is not used in output currently
13872         if ( !$cpu_temp && !$mobo_temp && !$fan_main[1] && !$fan_main[2] && !$fan_main[1] && !@fan_default ) {
13873                 %sensors = ();
13874         }
13875         else {
13876                 my ($ambient_temp,$psu_fan,$psu1_fan,$psu2_fan,$psu_temp,$sodimm_temp,
13877                 $v_12,$v_5,$v_3_3,$v_dimm_p1,$v_dimm_p2,$v_soc_p1,$v_soc_p2,$v_vbat);
13878                 $psu_temp = $sensors{'psu-temp'} if $sensors{'psu-temp'};
13879                 # sodimm fan is fan_main[4]
13880                 $sodimm_temp = $sensors{'sodimm-temp'} if $sensors{'sodimm-temp'};
13881                 $cpu2_temp = $sensors{'cpu2-temp'} if $sensors{'cpu2-temp'};
13882                 $cpu3_temp = $sensors{'cpu3-temp'} if $sensors{'cpu3-temp'};
13883                 $cpu4_temp = $sensors{'cpu4-temp'} if $sensors{'cpu4-temp'};
13884                 $ambient_temp = $sensors{'ambient-temp'} if $sensors{'ambient-temp'};
13885                 $psu_fan = $sensors{'fan-psu'} if $sensors{'fan-psu'};
13886                 $psu1_fan = $sensors{'fan-psu-1'} if $sensors{'fan-psu-1'};
13887                 $psu2_fan = $sensors{'fan-psu-2'} if $sensors{'fan-psu-2'};
13888                 # so far only for ipmi, sensors data is junk for volts
13889                 if ($extra > 0 &&
13890                     ($sensors{'volts-12'} || $sensors{'volts-5'} || $sensors{'volts-3.3'} || $sensors{'volts-vbat'}) ){
13891                         $v_12 = $sensors{'volts-12'} if $sensors{'volts-12'};
13892                         $v_5 = $sensors{'volts-5'} if $sensors{'volts-5'};
13893                         $v_3_3 = $sensors{'volts-3.3'} if  $sensors{'volts-3.3'};
13894                         $v_vbat = $sensors{'volts-vbat'} if $sensors{'volts-vbat'};
13895                         $v_dimm_p1 = $sensors{'volts-dimm-p1'} if $sensors{'volts-dimm-p1'};
13896                         $v_dimm_p2 = $sensors{'volts-dimm-p2'} if $sensors{'volts-dimm-p2'};
13897                         $v_soc_p1 = $sensors{'volts-soc-p1'} if $sensors{'volts-soc-p1'};
13898                         $v_soc_p2 = $sensors{'volts-soc-p2'} if $sensors{'volts-soc-p2'};
13899                 }
13900                 %sensors = (
13901                 'ambient-temp' => $ambient_temp,
13902                 'cpu-temp' => $cpu_temp,
13903                 'cpu2-temp' => $cpu2_temp,
13904                 'cpu3-temp' => $cpu3_temp,
13905                 'cpu4-temp' => $cpu4_temp,
13906                 'mobo-temp' => $mobo_temp,
13907                 'psu-temp' => $psu_temp,
13908                 'temp-unit' => $sensors{'temp-unit'},
13909                 'fan-main' => \@fan_main,
13910                 'fan-default' => \@fan_default,
13911                 'fan-psu' => $psu_fan,
13912                 'fan-psu1' => $psu1_fan,
13913                 'fan-psu2' => $psu2_fan,
13914                 );
13915                 if ($psu_temp){
13916                         $sensors{'psu-temp'} = $psu_temp;
13917                 }
13918                 if ($sodimm_temp){
13919                         $sensors{'sodimm-temp'} = $sodimm_temp;
13920                 }
13921                 if ($extra > 0 && ($v_12 || $v_5 || $v_3_3 || $v_vbat) ){
13922                         $sensors{'volts-12'} = $v_12;
13923                         $sensors{'volts-5'} = $v_5;
13924                         $sensors{'volts-3.3'} = $v_3_3;
13925                         $sensors{'volts-vbat'} = $v_vbat;
13926                         $sensors{'volts-dimm-p1'} = $v_dimm_p1;
13927                         $sensors{'volts-dimm-p2'} = $v_dimm_p2;
13928                         $sensors{'volts-soc-p1'} = $v_soc_p1;
13929                         $sensors{'volts-soc-p2'} = $v_soc_p2;
13930                 }
13931         }
13932         eval $end if $b_log;
13933         return %sensors;
13934 }
13935 sub gpu_data {
13936         eval $start if $b_log;
13937         return @gpudata if $b_gpudata;
13938         my ($cmd,@data,@data2,$path,@screens,$temp);
13939         my ($j) = (0);
13940         if ($path = main::check_program('nvidia-settings')){
13941                 # first get the number of screens. This only work if you are in X
13942                 if ($b_display) {
13943                         @data = main::grabber("$path -q screens 2>/dev/null");
13944                         foreach (@data){
13945                                 if ( /(:[0-9]\.[0-9])/ ) {
13946                                         push @screens, $1;
13947                                 }
13948                         }
13949                 }
13950                 # do a guess, this will work for most users, it's better than nothing for out of X
13951                 else {
13952                         $screens[0] = ':0.0';
13953                 }
13954                 # now we'll get the gpu temp for each screen discovered. The print out function
13955                 # will handle removing screen data for single gpu systems. -t shows only data we want
13956                 # GPUCurrentClockFreqs: 520,600
13957                 # GPUCurrentFanSpeed: 50 0-100, not rpm, percent I think
13958                 # VideoRam: 1048576
13959                 # CUDACores: 16
13960                 # PCIECurrentLinkWidth: 16
13961                 # PCIECurrentLinkSpeed: 5000
13962                 # RefreshRate: 60.02 Hz [oer screen]
13963                 # ViewPortOut=1280x1024+0+0}, DPY-1: nvidia-auto-select @1280x1024 +1280+0 {ViewPortIn=1280x1024,
13964                 # ViewPortOut=1280x1024+0+0}
13965                 # ThermalSensorReading: 50
13966                 # PCIID: 4318,2661 - the pci stuff doesn't appear to work
13967                 # PCIBus: 2
13968                 # PCIDevice: 0
13969                 # Irq: 30
13970                 foreach my $screen (@screens){
13971                         my $screen2 = $screen;
13972                         $screen2 =~ s/\.[0-9]$//;
13973                         $cmd = '-q GPUCoreTemp -q VideoRam -q GPUCurrentClockFreqs -q PCIECurrentLinkWidth ';
13974                         $cmd .= '-q Irq -q PCIBus -q PCIDevice -q GPUCurrentFanSpeed';
13975                         $cmd = "$path -c $screen2 $cmd 2>/dev/null";
13976                         @data = main::grabber($cmd);
13977                         main::log_data('cmd',$cmd) if $b_log;
13978                         @data = (@data,@data2);
13979                         $j = scalar @gpudata;
13980                         $gpudata[$j] = ({});
13981                         foreach my $item (@data){
13982                                 if ($item =~ /^\s*Attribute\s\'([^']+)\'\s.*:\s*([\S]+)\.$/){
13983                                         my $attribute = $1;
13984                                         my $value = $2;
13985                                         $gpudata[$j]{'type'} = 'nvidia';
13986                                         $gpudata[$j]{'speed-unit'} = '%';
13987                                         $gpudata[$j]{'screen'} = $screen;
13988                                         if (!$gpudata[$j]{'temp'} && $attribute eq 'GPUCoreTemp'){
13989                                                 $gpudata[$j]{'temp'} = $value;
13990                                         }
13991                                         elsif (!$gpudata[$j]{'ram'} && $attribute eq 'VideoRam'){
13992                                                 $gpudata[$j]{'ram'} = $value;
13993                                         }
13994                                         elsif (!$gpudata[$j]{'clock'} && $attribute eq 'GPUCurrentClockFreqs'){
13995                                                 $gpudata[$j]{'clock'} = $value;
13996                                         }
13997                                         elsif (!$gpudata[$j]{'bus'} && $attribute eq 'PCIBus'){
13998                                                 $gpudata[$j]{'bus'} = $value;
13999                                         }
14000                                         elsif (!$gpudata[$j]{'bus-id'} && $attribute eq 'PCIDevice'){
14001                                                 $gpudata[$j]{'bus-id'} = $value;
14002                                         }
14003                                         elsif (!$gpudata[$j]{'fan-speed'} && $attribute eq 'GPUCurrentFanSpeed'){
14004                                                 $gpudata[$j]{'fan-speed'} = $value;
14005                                         }
14006                                 }
14007                         }
14008                 }
14009         }
14010         if ($path = main::check_program('aticonfig')){
14011                 # aticonfig --adapter=0 --od-gettemperature
14012                 @data = main::grabber("$path --adapter=all --od-gettemperature 2>/dev/null");
14013                 foreach (@data){
14014                         if (/Sensor [^0-9]*([0-9\.]+) /){
14015                                 $j = scalar @gpudata;
14016                                 $gpudata[$j] = ({});
14017                                 my $value = $1;
14018                                 $gpudata[$j]{'type'} = 'amd';
14019                                 $gpudata[$j]{'temp'} = $value;
14020                         }
14021                 }
14022         }
14023         if (@sensors_data){
14024                 my ($b_found,$holder) = (0,'');
14025                 foreach (@sensors_data){
14026                         next if (/^Adapter:/ || /^\s*$/);
14027                         if (/^(amdgpu|intel|nouveau|radeon)-pci-(.*)/){
14028                                 $b_found = 1;
14029                                 $holder = $1;
14030                                 $j = scalar @gpudata;
14031                         }
14032                         if (/^(?:(?!amdgpu|.*hwmon|intel|nouveau|radeon).)*-(pci|virtual|isa)-(.*)/){
14033                                 $b_found = 0;
14034                                 $holder = '';
14035                         }
14036                         if ($b_found){
14037                                 if (/^temp.*:([0-9]+).*(C|F)/){
14038                                         $gpudata[$j]{'temp'} = $1;
14039                                         $gpudata[$j]{'type'} = $holder;
14040                                         $gpudata[$j]{'unit'} = $2;
14041                                 }
14042                                 if (/^fan.*:([0-9]+).*(RPM)?/){
14043                                         $gpudata[$j]{'fan-speed'} = $1;
14044                                         # NOTE: we test for nvidia %, everything else stays with nothing
14045                                         $gpudata[$j]{'speed-unit'} = '';
14046                                 }
14047                                 main::log_data('dump','sensors output: video: @gpudata',\@gpudata);
14048                         }
14049                 }
14050         }
14051         # we'll probably use this data elsewhere so make it a one time call
14052         $b_gpudata = 1;
14053         # print Data::Dumper::Dumper \@gpudata;
14054         eval $end if $b_log;
14055         return @gpudata;
14056 }
14057 }
14058
14059 ## SlotData
14060 {
14061 package SlotData;
14062
14063 sub get {
14064         eval $start if $b_log;
14065         my (@data,@rows,$key1,$val1);
14066         my $num = 0;
14067         my $ref = $alerts{'dmidecode'};
14068         if ( $$ref{'action'} eq 'use' && (!$b_arm || $b_slot_tool )){
14069                 @rows = slot_data();
14070         }
14071         elsif ($b_arm && !$b_slot_tool){
14072                 $key1 = 'ARM';
14073                 $val1 = main::row_defaults('arm-pci','');
14074                 @rows = ({main::key($num++,$key1) => $val1,});
14075         }
14076         elsif ( $$ref{'action'} ne 'use'){
14077                 $key1 = $$ref{'action'};
14078                 $val1 = $$ref{$key1};
14079                 $key1 = ucfirst($key1);
14080                 @rows = ({main::key($num++,$key1) => $val1,});
14081         }
14082         eval $end if $b_log;
14083         return @rows;
14084 }
14085 sub slot_data {
14086         eval $start if $b_log;
14087         my (@data,@rows);
14088         my $num = 0;
14089         foreach (@dmi){
14090                 $num = 1;
14091                 my @ref = @$_;
14092                 if ($ref[0] == 9){
14093                         my ($designation,$id,$length,$type,$usage) = ('','','','','');
14094                         # skip first two row, we don't need that data
14095                         splice @ref, 0, 2 if @ref;
14096                         my $j = scalar @rows;
14097                         foreach my $item (@ref){
14098                                 if ($item !~ /^~/){ # skip the indented rows
14099                                         my @value = split /:\s+/, $item;
14100                                         if ($value[0] eq 'Type'){
14101                                                 $type = $value[1];
14102                                         }
14103                                         if ($value[0] eq 'Designation'){
14104                                                 $designation = $value[1];
14105                                         }
14106                                         if ($value[0] eq 'Current Usage'){
14107                                                 $usage = $value[1];
14108
14109                                         }
14110                                         if ($value[0] eq 'ID'){
14111                                                 $id = $value[1];
14112                                         }
14113                                         if ($extra > 1 && $value[0] eq 'Length'){
14114                                                 $length = $value[1];
14115                                         }
14116                                 }
14117                         }
14118                         if ($type){
14119                                 $id = 'N/A' if ($id eq '' );
14120                                 if ($type eq 'Other' && $designation){
14121                                         $type = $designation;
14122                                 }
14123                                 elsif ($type && $designation) {
14124                                         $type = "$type $designation";
14125                                 }
14126                                 @data = (
14127                                 {
14128                                 main::key($num++,'Slot') => $id,
14129                                 main::key($num++,'type') => $type,
14130                                 main::key($num++,'status') => $usage,
14131                                 },
14132                                 );
14133                                 @rows = (@rows,@data);
14134                                 if ($extra > 1 ){
14135                                         $rows[$j]{main::key($num++,'length')} = $length;
14136                                 }
14137                         }
14138                 }
14139         }
14140         if (!@rows){
14141                 my $key = 'Message';
14142                 @data = ({
14143                 main::key($num++,$key) => main::row_defaults('pci-slot-data',''),
14144                 },);
14145                 @rows = (@rows,@data);
14146         }
14147         eval $end if $b_log;
14148         return @rows;
14149 }
14150 }
14151
14152 ## UnmountedData
14153 {
14154 package UnmountedData;
14155
14156 sub get {
14157         eval $start if $b_log;
14158         my (@data,@rows,$key1,$val1);
14159         my $num = 0;
14160         if ($bsd_type){
14161                 $key1 = 'Message';
14162                 $val1 = main::row_defaults('unmounted-data-bsd');
14163         }
14164         else {
14165                 if (my $file = main::system_files('partitions')){
14166                         @data = unmounted_data($file);
14167                         if (!@data){
14168                                 $key1 = 'Message';
14169                                 $val1 = main::row_defaults('unmounted-data');
14170                         }
14171                         else {
14172                                 @rows = create_output(@data);
14173                         }
14174                 }
14175                 else {
14176                         $key1 = 'Message';
14177                         $val1 = main::row_defaults('unmounted-file');
14178                 }
14179         }
14180         if (!@rows && $key1){
14181                 @rows = ({main::key($num++,$key1) => $val1,});
14182         }
14183         eval $end if $b_log;
14184         return @rows;
14185 }
14186 sub create_output {
14187         eval $start if $b_log;
14188         my (@unmounted) = @_;
14189         my (@data,@rows,$fs);
14190         my $num = 0;
14191         @unmounted = sort { $a->{'dev-base'} cmp $b->{'dev-base'} } @unmounted;
14192         foreach my $ref (@unmounted){
14193                 my %row = %$ref;
14194                 $num = 1;
14195                 my @data2 = main::get_size($row{'size'}) if (defined $row{'size'});
14196                 my $size = (@data2) ? $data2[0] . ' ' . $data2[1]: 'N/A';
14197                 if ($row{'fs'}){
14198                         $fs = lc($row{'fs'});
14199                 }
14200                 else {
14201                         if (main::check_program('file')){
14202                                 $fs = ($b_root) ? 'N/A' : main::row_defaults('root-required');
14203                         }
14204                         else {
14205                                 $fs = 'requires file';
14206                         }
14207                 }
14208                 @data = ({
14209                 main::key($num++,'ID') => , "/dev/$row{'dev-base'}",
14210                 main::key($num++,'size') => , $size,
14211                 main::key($num++,'fs') => , $fs,
14212                 main::key($num++,'label') => , $row{'label'},
14213                 main::key($num++,'uuid') => , $row{'uuid'},
14214                 });
14215                 @rows = (@rows,@data);
14216         }
14217         eval $end if $b_log;
14218         return @rows;
14219 }
14220 sub unmounted_data {
14221         eval $start if $b_log;
14222         my ($file) = @_;
14223         my ($fs,$label,$size,$uuid,@data,%part,@unmounted);
14224         my @mounted = ('scd[0-9]+','sr[0-9]+','cdrom[0-9]*','cdrw[0-9]*',
14225         'dvd[0-9]*','dvdrw[0-9]*','fd[0-9]','ram[0-9]*');
14226         my @mounts = main::reader($file,'strip');
14227         my $num = 0;
14228         PartitionData::set_lsblk() if !$bsd_type && !$b_lsblk;
14229         # set labels, uuid, gpart
14230         PartitionData::partition_data() if !$b_partitions;
14231         PartitionData::set_label_uuid() if !$b_label_uuid;
14232         RaidData::raid_data() if !$b_raid;
14233         @mounted = get_mounted(@mounted);
14234         foreach (@mounts){
14235                 my @working = split /\s+/, $_;
14236                 ($fs,$label,$uuid,$size) = ('','','','');
14237                 # note that size 1 means it is a logical extended partition container
14238                 # lvm might have dm-1 type syntax
14239                 # need to exclude loop type file systems, squashfs for example
14240                 # NOTE: nvme needs special treatment because the main device is: nvme0n1
14241                 # note: $working[2] != 1 is wrong, it's not related
14242                 if ( $working[-1] !~ /^(nvme[0-9]+n|mmcblk|mtdblk|mtdblock)[0-9]+$/ &&
14243                      $working[-1] =~ /[a-z][0-9]+$|dm-[0-9]+$/ && $working[-1] !~ /loop/ &&
14244                      !(grep {$working[-1] =~ /$_/} @mounted)){
14245                         %part = PartitionData::check_lsblk($working[-1],0) if (@lsblk && $working[-1]);
14246                         if (%part){
14247                                 $fs = $part{'fs'};
14248                                 $label = $part{'label'};
14249                                 $uuid = $part{'uuid'};
14250                                 $size = $part{'size'} if $part{'size'} && !$working[2];
14251                         }
14252                         $size ||= $working[2];
14253                    $fs = unmounted_filesystem($working[-1]) if !$fs;
14254                    $label = PartitionData::get_label("/dev/$working[-1]") if !$label;
14255                         $uuid = PartitionData::get_uuid("/dev/$working[-1]") if !$uuid;
14256                         @data = ({
14257                         'dev-base' => $working[-1],
14258                         'fs' => $fs,
14259                         'label' => $label,
14260                         'size' => $size,
14261                         'uuid' => $uuid,
14262                         });
14263                         @unmounted = (@unmounted,@data);
14264                 }
14265         }
14266         # print Data::Dumper::Dumper @unmounted;
14267         main::log_data('dump','@unmounted',\@unmounted) if $b_log;
14268         eval $end if $b_log;
14269         return @unmounted;
14270 }
14271 sub get_mounted {
14272         eval $start if $b_log;
14273         my (@mounted) = @_;
14274         foreach my $ref (@partitions){
14275                 my %row = %$ref;
14276                 push @mounted, $row{'dev-base'} if $row{'dev-base'};
14277         }
14278         foreach my $ref (@raid){
14279                 my %row = %$ref;
14280                 my $ref2 = $row{'arrays'};
14281                 # we want to not show md0 etc in unmounted report
14282                 push @mounted, $row{'id'} if $row{'id'};
14283                 my @arrays = (ref $ref2 eq 'ARRAY' ) ? @$ref2 : ();
14284                 @arrays = grep {defined $_} @arrays;
14285                 foreach my $array (@arrays){
14286                         my %row2 = %$array;
14287                         my $ref3 = $row2{'components'};
14288                         my @components = (ref $ref3 eq 'ARRAY') ? @$ref3 : ();
14289                         foreach my $component (@components){
14290                                 my @temp = split /~/, $component;
14291                                 push @mounted, $temp[0];
14292                         }
14293                 }
14294         }
14295         eval $end if $b_log;
14296         return @mounted;
14297 }
14298 sub unmounted_filesystem {
14299         eval $start if $b_log;
14300         my ($item) = @_;
14301         my ($data,%part);
14302         my ($file,$fs,$path) = ('','','');
14303         if ($path = main::check_program('file')) {
14304                 $file = $path;
14305         }
14306         # order matters in this test!
14307         my @filesystems = ('ext2','ext3','ext4','ext5','ext','ntfs',
14308         'fat32','fat16','FAT\s\(.*\)','vfat','fatx','tfat','swap','btrfs',
14309         'ffs','hammer','hfs\+','hfs\splus','hfs\sextended\sversion\s[1-9]','hfsj',
14310         'hfs','jfs','nss','reiserfs','reiser4','ufs2','ufs','xfs','zfs');
14311         if ($file){
14312                 # this will fail if regular user and no sudo present, but that's fine, it will just return null
14313                 # note the hack that simply slices out the first line if > 1 items found in string
14314                 # also, if grub/lilo is on partition boot sector, no file system data is available
14315                 $data = (main::grabber("$sudo$file -s /dev/$item 2>/dev/null"))[0];
14316                 if ($data){
14317                         foreach (@filesystems){
14318                                 if ($data =~ /($_)[\s,]/i){
14319                                         $fs = $1;
14320                                         $fs = main::trimmer($fs);
14321                                         last;
14322                                 }
14323                         }
14324                 }
14325         }
14326         main::log_data('data',"fs: $fs") if $b_log;
14327         eval $end if $b_log;
14328         return $fs;
14329 }
14330 }
14331
14332 ## UsbData
14333 {
14334 package UsbData;
14335
14336 sub get {
14337         eval $start if $b_log;
14338         my (@data,@rows,$key1,$val1);
14339         my $num = 0;
14340         my $ref = $alerts{'lsusb'};
14341         my $ref2 = $alerts{'usbdevs'};
14342         if ( $$ref{'action'} ne 'use' && $$ref2{'action'} ne 'use'){
14343                 if ($os eq 'linux' ){
14344                         $key1 = $$ref{'action'};
14345                         $val1 = $$ref{$key1};
14346                 }
14347                 else {
14348                         $key1 = $$ref2{'action'};
14349                         $val1 = $$ref2{$key1};
14350                 }
14351                 $key1 = ucfirst($key1);
14352                 @rows = ({main::key($num++,$key1) => $val1,});
14353         }
14354         else {
14355                 @rows = usb_data();
14356                 if (!@rows){
14357                         my $key = 'Message';
14358                         @data = ({
14359                         main::key($num++,$key) => main::row_defaults('usb-data',''),
14360                         },);
14361                         @rows = (@rows,@data);
14362                 }
14363         }
14364         eval $end if $b_log;
14365         return @rows;
14366 }
14367 sub usb_data {
14368         eval $start if $b_log;
14369         return if ! @usb;
14370         my (@data,@row,@rows,$bus_id,$chip_id,$speed,$protocol,$class,$vendor,$product);
14371         my $num = 0;
14372         my $j = 0;
14373         # note: the data has been presorted in set_lsusb_data by:
14374         # bus id then device id, so we don't need to worry about the order
14375         foreach my $ref (@usb){
14376                 my @id = @$ref;
14377                 $j = scalar @rows;
14378                 $num = 1;
14379                 $bus_id = "$id[0]:$id[1]";
14380                 $chip_id = $id[2];
14381                 my $b_hub = 0;
14382                 # it's a hub
14383                 if ($id[1] == 1){
14384                         foreach my $line (@id){
14385                                 #print "$line\n";
14386                                 @row = split /:/, $line;
14387                                 next if ! defined $row[0];
14388                                 if ($row[0] eq 'bcdUSB' && defined $row[1]){
14389                                         $speed  = ($row[1] =~ /^[0-9,\.]+$/) ? sprintf("%1.1f",$row[1]) : $row[1];
14390                                 }
14391                                 elsif ($row[0] eq '~bInterfaceProtocol' && $row[2] ){
14392                                         $protocol = $row[2];
14393                                 }
14394                         }
14395                         $protocol ||= 'N/A';
14396                         $speed ||= 'N/A';
14397                         #print "pt0:$protocol\n";
14398                         @data = ({
14399                         main::key($num++,'Hub') => $bus_id,
14400                         main::key($num++,'usb') => $speed,
14401                         main::key($num++,'type') => $protocol,
14402                         },);
14403                         @rows = (@rows,@data);
14404                         if ($extra > 1){
14405                                 $rows[$j]{main::key($num++,'chip ID')} = $chip_id;
14406                         }
14407                 }
14408                 # it's a device
14409                 else {
14410                         ($class,$product,$protocol,$vendor,$speed) = ('','','','','');
14411                         foreach my $line (@id){
14412                                 @row = split /:/, $line;
14413                                 next if ! defined $row[0];
14414                                 if ($row[0] eq 'bcdUSB' && defined $row[1]){
14415                                         $speed  = sprintf("%.1f",$row[1]);
14416                                 }
14417                                 elsif ($row[0] eq 'bDeviceClass' && defined $row[1] && $row[1] == 9){
14418                                         $b_hub = 1;
14419                                 }
14420                                 elsif ($row[0] eq 'idVendor' && $row[2]){
14421                                         $vendor  = main::cleaner($row[2]);
14422                                 }
14423                                 elsif ($row[0] eq 'idProduct' && $row[2]){
14424                                         $product = main::cleaner($row[2]);
14425                                 }
14426                                 # we want hubs to cascade to last item
14427                                 elsif ($row[0] eq '~bInterfaceClass' && $row[2] && defined $row[1] && $row[1] != 9){
14428                                         $class = main::cleaner($row[2]);
14429                                 }
14430                                 elsif ($row[0] eq '~bInterfaceProtocol' && defined $row[2]){
14431                                         $protocol = $row[2];
14432                                         $protocol =~ s/none//i if $protocol;
14433                                         last if $class;
14434                                 }
14435                         }
14436                         if ( $b_hub ){
14437                                 if ($vendor && $product){
14438                                         $protocol = "$vendor $product";
14439                                 }
14440                                 elsif (!$product && $protocol && $vendor){
14441                                         $protocol = "$vendor $protocol";
14442                                 }
14443                                 $speed ||= 'N/A';
14444                                 $protocol ||= 'N/A';
14445                                 #print "pt2:$protocol\n";
14446                                 @data = ({
14447                                 main::key($num++,'Hub') => $bus_id,
14448                                 main::key($num++,'usb') => $speed,
14449                                 main::key($num++,'type') => $protocol,
14450                                 },);
14451                                 @rows = (@rows,@data);
14452                         }
14453                         else {
14454                                 if ($vendor && $product){
14455                                         if ($product !~ /$vendor/){
14456                                                 $product = "$vendor $product";
14457                                         }
14458                                 }
14459                                 elsif (!$product && !$vendor && $protocol){
14460                                         $product = $protocol;
14461                                 }
14462                                 elsif (!$product){
14463                                         $product = $vendor;
14464                                 }
14465                                 # bInterfaceProtocol:0 but $row[2] undefined
14466                                 #print "pt3:$class:$product\n";
14467                                 # for we want Mass Storage Device instead of Bulk-Only
14468                                 # we want to filter out certain protocol values that are less
14469                                 # informative than the class type.
14470                                 if ($protocol && $class && $class ne $protocol && protocol_filter($protocol) ){
14471                                         $class = $protocol;
14472                                 }
14473                                 $class ||= 'N/A';
14474                                 #print "pt3:$class:$product\n";
14475                                 $product ||= 'N/A';
14476                                 $speed ||= 'N/A';
14477                                 $rows[$j]{main::key($num++,'Device')} = $product;
14478                                 $rows[$j]{main::key($num++,'bus ID')} = $bus_id;
14479                                 if ($extra > 0){
14480                                         $rows[$j]{main::key($num++,'usb')} = $speed;
14481                                 }
14482                                 $rows[$j]{main::key($num++,'type')} = $class;
14483                         }
14484                         if ($extra > 1){
14485                                 $rows[$j]{main::key($num++,'chip ID')} = $chip_id;
14486                         }
14487                 }
14488         }
14489         #print Data::Dumper::Dumper \@rows;
14490         eval $end if $b_log;
14491         return @rows;
14492 }
14493 sub protocol_filter {
14494         eval $start if $b_log;
14495         my ($string) = @_;
14496         $string =~ s/Bulk-Only|streaming|Bidirectional|None//i if $string;
14497         eval $end if $b_log;
14498         return $string;
14499 }
14500 }
14501
14502 ## add metric / imperial (us) switch
14503 ## WeatherData
14504 {
14505 package WeatherData;
14506
14507 sub get {
14508         eval $start if $b_log;
14509         my (@rows,$key1,$val1);
14510         my $num = 0;
14511         @rows = create_output();
14512         eval $end if $b_log;
14513         return @rows;
14514 }
14515 sub create_output {
14516         eval $start if $b_log;
14517         my $num = 0;
14518         my (@data,@location,@rows,%weather,);
14519         my ($conditions) = ('NA');
14520         if ($show{'weather-location'}){
14521                 my $location_string;
14522                 $location_string = $show{'weather-location'};
14523                 $location_string =~ s/\+/ /g;
14524                 if ( $location_string =~ /,/){
14525                         my @temp = split /,/, $location_string;
14526                         my $sep = '';
14527                         my $string = '';
14528                         foreach (@temp){
14529                                 $_ = ucfirst($_);
14530                                 $string .= $sep . $_;
14531                                 $sep = ', ';
14532                         }
14533                         $location_string = $string;
14534                 }
14535                 $location_string = main::apply_filter($location_string);
14536                 @location = ($show{'weather-location'},$location_string,'');
14537         }
14538         else {
14539                 @location = get_location();
14540                 if (!$location[0]) {
14541                         return @rows = ({
14542                         main::key($num++,'Message') => main::row_defaults('weather-null','current location'),
14543                         });
14544                 }
14545         }
14546         %weather = get_weather(@location);
14547         if (!$weather{'weather'}) {
14548                 return @rows = ({
14549                 main::key($num++,'Message') => main::row_defaults('weather-null','weather data'),
14550                 });
14551         }
14552         $conditions = "$weather{'weather'}";
14553         my $temp = unit_output($weather{'temp'},$weather{'temp-c'},'C',$weather{'temp-f'},'F');
14554         @data = ({
14555         main::key($num++,'Temperature') => $temp,
14556         main::key($num++,'Conditions') => $conditions,
14557         },);
14558         @rows = (@rows,@data);
14559         if ($extra > 0){
14560                 my $pressure = unit_output($weather{'pressure'},$weather{'pressure-mb'},'mb',$weather{'pressure-in'},'in');
14561                 my $wind = wind_output($weather{'wind'},$weather{'wind-direction'},$weather{'wind-mph'},$weather{'wind-ms'},
14562                 $weather{'wind-gust-mph'},$weather{'wind-gust-ms'});
14563                 $rows[0]{main::key($num++,'Wind')} = $wind;
14564                 $rows[0]{main::key($num++,'Humidity')} = $weather{'humidity'};
14565                 $rows[0]{main::key($num++,'Pressure')} = $pressure;
14566         }
14567         if ($extra > 1){
14568                 if ($weather{'heat-index'}){
14569                         my $heat = unit_output($weather{'heat-index'},$weather{'heat-index-c'},'C',$weather{'heat-index-f'},'F');
14570                         $rows[0]{main::key($num++,'Heat Index')} = $heat;
14571                 }
14572                 if ($weather{'windchill'}){
14573                         my $chill = unit_output($weather{'windchill'},$weather{'windchill-c'},'C',$weather{'windchill-f'},'F');
14574                         $rows[0]{main::key($num++,'Wind Chill')} = $chill ;
14575                 }
14576                 if ($weather{'dewpoint'}){
14577                         my $dew = unit_output($weather{'dewpoint'},$weather{'dewpoint-c'},'C',$weather{'dewpoint-f'},'F');
14578                         $rows[0]{main::key($num++,'Dew Point')} = $dew;
14579                 }
14580         }
14581         if ($extra > 2){
14582                 if (!$show{'filter'}){
14583                         $rows[0]{main::key($num++,'Location')} = $location[1];
14584                         $rows[0]{main::key($num++,'altitude')} = elevation_output($weather{'elevation-m'},$weather{'elevation-ft'});
14585                 }
14586         }
14587         $rows[0]{main::key($num++,'Current Time')} = $weather{'date-time'};
14588         if ($extra > 2){
14589                 $rows[0]{main::key($num++,'Observation Time')} = $weather{'observation-time-local'};
14590         }
14591         eval $end if $b_log;
14592         return @rows;
14593 }
14594 sub elevation_output {
14595         eval $start if $b_log;
14596         my ($meters,$feet) = @_;
14597         my ($result,$i_unit,$m_unit) = ('','ft','m');
14598         $feet = sprintf("%.0f", 3.28 * $meters) if defined $meters && !$feet;
14599         $meters = sprintf("%.1f", $feet / 3.28 ) if defined $feet && !$meters;
14600         $meters = sprintf("%.0f", $meters) if $meters;
14601         if ( defined $meters  && $weather_unit eq 'mi' ){
14602                 $result = "$meters $m_unit ($feet $i_unit)";
14603         }
14604         elsif (defined $meters && $weather_unit eq 'im' ){
14605                 $result = "$feet $i_unit ($meters $m_unit)";
14606         }
14607         elsif (defined $meters && $weather_unit eq 'm' ){
14608                 $result = "$meters $m_unit";
14609         }
14610         elsif (defined $feet && $weather_unit eq 'i' ){
14611                 $result = "$feet $i_unit";
14612         }
14613         else {
14614                 $result = 'N/A';
14615         }
14616         eval $end if $b_log;
14617         return $result;
14618 }
14619 sub unit_output {
14620         eval $start if $b_log;
14621         my ($primary,$metric,$m_unit,$imperial,$i_unit) = @_;
14622         my $result = '';
14623         if ($metric && $imperial && $weather_unit eq 'mi' ){
14624                 $result = "$metric $m_unit ($imperial $i_unit)";
14625         }
14626         elsif ($metric && $imperial && $weather_unit eq 'im' ){
14627                 $result = "$imperial $i_unit ($metric $m_unit)";
14628         }
14629         elsif ($metric && $weather_unit eq 'm' ){
14630                 $result = "$metric $m_unit";
14631         }
14632         elsif ($imperial && $weather_unit eq 'i' ){
14633                 $result = "$imperial $i_unit";
14634         }
14635         elsif ($primary){
14636                 $result = $primary;
14637         }
14638         else {
14639                 $result = 'N/A';
14640         }
14641         eval $end if $b_log;
14642         return $result;
14643 }
14644 sub wind_output {
14645         eval $start if $b_log;
14646         my ($primary,$direction,$mph,$ms,$gust_mph,$gust_ms) = @_;
14647         my ($result,$gust_kmh,$kmh,$i_unit,$m_unit,$km_unit) = ('','','','mph','m/s','km/h');
14648         # get rid of possible gust values if they are the same as wind values
14649         $gust_mph = undef if $gust_mph && $mph && $mph eq $gust_mph;
14650         $gust_ms = undef if $gust_ms && $ms && $ms eq $gust_ms;
14651         # calculate and round, order matters so that rounding only happens after math done
14652         $ms = 0.44704 * $mph if $mph && !$ms;
14653         $mph = $ms * 2.23694 if $ms && !$mph;
14654         $kmh = sprintf("%.0f",  18 * $ms / 5) if $ms;
14655         $ms = sprintf("%.1f", $ms ) if  $ms; # very low mph speeds yield 0, which is wrong
14656         $mph = sprintf("%.0f", $mph) if $mph;
14657         $gust_ms = 0.44704 * $gust_mph if $gust_mph && !$gust_ms;
14658         $gust_kmh = 18 * $gust_ms / 5 if $gust_ms;
14659         $gust_mph = $gust_ms * 2.23694 if $gust_ms && !$gust_mph;
14660         $gust_mph = sprintf("%.0f", $gust_mph) if $gust_mph;
14661         $gust_kmh = sprintf("%.0f", $gust_kmh) if $gust_kmh;
14662         $gust_ms = sprintf("%.0f", $gust_ms ) if  $gust_ms;
14663         if (!$mph && $primary){
14664                 $result = $primary;
14665         }
14666         elsif ($mph && $direction ){
14667                 if ( $weather_unit eq 'mi' ){
14668                         $result = "from $direction at $ms $m_unit ($kmh $km_unit, $mph $i_unit)";
14669                 }
14670                 elsif ( $weather_unit eq 'im' ){
14671                         $result = "from $direction at $mph $i_unit ($ms $m_unit, $kmh $km_unit)";
14672                 }
14673                 elsif ( $weather_unit eq 'm' ){
14674                         $result = "from $direction at $ms $m_unit ($kmh $km_unit)";
14675                 }
14676                 elsif ( $weather_unit eq 'i' ){
14677                         $result = "from $direction at $mph $i_unit";
14678                 }
14679                 if ($gust_mph){
14680                         if ( $weather_unit eq 'mi' ){
14681                                 $result .= ". Gusting to $ms $m_unit ($kmh $km_unit, $mph $i_unit)";
14682                         }
14683                         elsif ( $weather_unit eq 'im' ){
14684                                 $result .= ". Gusting to $mph $i_unit ($ms $m_unit, $kmh $km_unit)";
14685                         }
14686                         elsif ( $weather_unit eq 'm' ){
14687                                 $result .= ". Gusting to $ms $m_unit ($kmh $km_unit)";
14688                         }
14689                         elsif ( $weather_unit eq 'i' ){
14690                                 $result .= ". Gusting to $mph $i_unit";
14691                         }
14692                 }
14693         }
14694         elsif ($primary){
14695                 $result = $primary;
14696         }
14697         else {
14698                 $result = 'N/A';
14699         }
14700         eval $end if $b_log;
14701         return $result;
14702 }
14703 sub get_weather {
14704         eval $start if $b_log;
14705         my (@location) = @_;
14706         my $now = POSIX::strftime "%Y%m%d%H%M", localtime;
14707         my ($date_time,$freshness,$tz,@weather_data,%weather);
14708         my $loc_name = lc($location[0]);
14709         $loc_name =~ s/-\/|\s|,/-/g;
14710         $loc_name =~ s/--/-/g;
14711         my $file_cached = "$user_data_dir/weather-$loc_name.txt";
14712         if (-f $file_cached){
14713                 @weather_data = main::reader($file_cached);
14714                 $freshness = (split /\^\^/, $weather_data[0])[1];
14715                 #print "$now:$freshness\n";
14716         }
14717         if (!$freshness || $freshness < ($now - 90) ) {
14718                 @weather_data = (); # reset so we don't write the previous data to file!!
14719                 my $url = "http://api.wunderground.com/auto/wui/geo/WXCurrentObXML/index.xml?query=$location[0]";
14720                 my $temp;
14721 #               {
14722 #                       #my $file2 = "$ENV{'HOME'}/bin/scripts/inxi/data/weather/weather-1.xml";
14723 #                       # my $file2 = "$ENV{'HOME'}/bin/scripts/inxi/data/weather/feed-oslo-1.xml";
14724 #                       local $/;
14725 #                       my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/weather/weather-1.xml";
14726 #                       open my $fh, '<', $file or die "can't open $file: $!";
14727 #                       $temp = <$fh>;
14728 #               }
14729                 $temp = main::download_file('stdout',$url);
14730                 $temp =~ s/\r|\n\n/\n/g;
14731                 my @weather_temp = split /\n/, $temp;
14732                 foreach (@weather_temp){
14733                         chomp $_;
14734                         $_ =~ s/<\/[^>]+>//;
14735                         $_ =~ s/.*icon.*|\r//g;
14736                         $_ =~ s/\s\s/ /g;
14737                         $_ =~ s/^\s+|\s+$//g;
14738                         $_ =~ s/>/^^/;
14739                         $_ =~ s/^<|NA$//g;
14740                         $_ =~ s/^(current|credit|terms|image|title|link|.*_url).*//;
14741                         push @weather_data, $_ if $_ !~ /^\s*$/;
14742                 }
14743                 unshift (@weather_data,("timestamp^^$now"));
14744                 main::writer($file_cached,\@weather_data);
14745                 #print "$file_cached: download/cleaned\n";
14746         }
14747         #print join "\n", @weather_data, "\n";
14748         # NOTE: because temps can be 0, we can't do if value tests
14749         foreach (@weather_data){
14750                 my @working = split /\s*\^\^\s*/,$_;
14751                 next if ! defined $working[1] || $working[1] eq '';
14752                 if ( $working[0] eq 'dewpoint_string' ){
14753                         $weather{'dewpoint'} = $working[1];
14754                         $working[1] =~ /^([0-9\.]+)\sF\s\(([0-9\.]+)\sC\)/;
14755                         $weather{'dewpoint-c'} = $2;;
14756                         $weather{'dewpoint-f'} = $1;;
14757                 }
14758                 elsif ( $working[0] eq 'dewpoint_c' ){
14759                         $weather{'dewpoint-c'} = $working[1];
14760                 }
14761                 elsif ( $working[0] eq 'dewpoint_f' ){
14762                         $weather{'dewpoint-f'} = $working[1];
14763                 }
14764                 # there are two elevations, we want the first one
14765                 elsif (!$weather{'elevation-m'} && $working[0] eq 'elevation'){
14766                         # note: bug in source data uses ft for meters, not 100% of time, but usually
14767                         $weather{'elevation-m'} = $working[1];
14768                         $weather{'elevation-m'} =~ s/\s*(ft|m).*$//;
14769                 }
14770                 elsif ( $working[0] eq 'heat_index_string' ){
14771                         $weather{'heat-index'} = $working[1];
14772                         $working[1] =~ /^([0-9\.]+)\sF\s\(([0-9\.]+)\sC\)/;
14773                         $weather{'heat-index-c'} = $2;;
14774                         $weather{'heat-index-f'} = $1;
14775                 }
14776                 elsif ( $working[0] eq 'heat_index_c' ){
14777                         $weather{'heat-index-c'} = $working[1];
14778                 }
14779                 elsif ( $working[0] eq 'heat_index_f' ){
14780                         $weather{'heat-index-f'} = $working[1];
14781                 }
14782                 elsif ( $working[0] eq 'relative_humidity' ){
14783                         $weather{'humidity'} = $working[1];
14784                 }
14785                 elsif ( $working[0] eq 'local_time' ){
14786                         $weather{'local-time'} = $working[1];
14787                 }
14788                 elsif ( $working[0] eq 'local_epoch' ){
14789                         $weather{'local-epoch'} = $working[1];
14790                 }
14791                 elsif ( $working[0] eq 'observation_time_rfc822' ){
14792                         $weather{'observation-time-gmt'} = $working[1];
14793                 }
14794                 elsif ( $working[0] eq 'observation_epoch' ){
14795                         $weather{'observation-epoch'} = $working[1];
14796                 }
14797                 elsif ( $working[0] eq 'observation_time' ){
14798                         $weather{'observation-time-local'} = $working[1];
14799                         $weather{'observation-time-local'} =~ s/Last Updated on //;
14800                 }
14801                 elsif ( $working[0] eq 'pressure_string' ){
14802                         $weather{'pressure'} = $working[1];
14803                 }
14804                 elsif ( $working[0] eq 'pressure_mb' ){
14805                         $weather{'pressure-mb'} = $working[1];
14806                 }
14807                 elsif ( $working[0] eq 'pressure_in' ){
14808                         $weather{'pressure-in'} = $working[1];
14809                 }
14810                 elsif ( $working[0] eq 'temperature_string' ){
14811                         $weather{'temp'} = $working[1];
14812                         $working[1] =~ /^([0-9\.]+)\sF\s\(([0-9\.]+)\sC\)/;
14813                         $weather{'temp-c'} = $2;;
14814                         $weather{'temp-f'} = $1;
14815 #                       $weather{'temp'} =~ s/\sF/\xB0 F/; # B0
14816 #                       $weather{'temp'} =~ s/\sF/\x{2109}/;
14817 #                       $weather{'temp'} =~ s/\sC/\x{2103}/;
14818                 }
14819                 elsif ( $working[0] eq 'temp_f' ){
14820                         $weather{'temp-f'} = $working[1];
14821                 }
14822                 elsif ( $working[0] eq 'temp_c' ){
14823                         $weather{'temp-c'} = $working[1];
14824                 }
14825                 elsif ( $working[0] eq 'visibility' ){
14826                         $weather{'visibility'} = $working[1];
14827                 }
14828                 elsif ( $working[0] eq 'visibility_km' ){
14829                         $weather{'visibility-km'} = $working[1];
14830                 }
14831                 elsif ( $working[0] eq 'visibility_mi' ){
14832                         $weather{'visibility-mi'} = $working[1];
14833                 }
14834                 elsif ( $working[0] eq 'weather' ){
14835                         $weather{'weather'} = $working[1];
14836                 }
14837                 elsif ( $working[0] eq 'wind_degrees' ){
14838                         $weather{'wind-degrees'} = $working[1];
14839                 }
14840                 elsif ( $working[0] eq 'wind_dir' ){
14841                         $weather{'wind-direction'} = $working[1];
14842                 }
14843                 elsif ( $working[0] eq 'wind_mph' ){
14844                         $weather{'wind-mph'} = $working[1];
14845                 }
14846                 elsif ( $working[0] eq 'wind_gust_mph' ){
14847                         $weather{'wind-gust-mph'} = $working[1];
14848                 }
14849                 elsif ( $working[0] eq 'wind_gust_ms' ){
14850                         $weather{'wind-gust-ms'} = $working[1];
14851                 }
14852                 elsif ( $working[0] eq 'wind_ms' ){
14853                         $weather{'wind-ms'} = $working[1];
14854                 }
14855                 elsif ( $working[0] eq 'wind_string' ){
14856                         $weather{'wind'} = $working[1];
14857                 }
14858                 elsif ( $working[0] eq 'windchill_string' ){
14859                         $weather{'windchill'} = $working[1];
14860                         $working[1] =~ /^([0-9\.]+)\sF\s\(([0-9\.]+)\sC\)/;
14861                         $weather{'windchill-c'} = $2;
14862                         $weather{'windchill-f'} = $1;
14863                 }
14864                 elsif ( $working[0] eq 'windchill_c' ){
14865                         $weather{'windchill-c'} = $working[1];
14866                 }
14867                 elsif ( $working[0] eq 'windchill_f' ){
14868                         $weather{'windchill_f'} = $working[1];
14869                 }
14870         }
14871         if ($show{'weather-location'}){
14872                 $weather{'observation-time-local'} =~ /^(.*)\s([\S]+)$/;
14873                 $tz = $2;
14874                 # very clever trick, just make the system think it's in the
14875                 # remote timezone for this local block only
14876                 local $ENV{'TZ'} = $tz;
14877                 $date_time = POSIX::strftime "%c", localtime;
14878                 $weather{'date-time'} = $date_time;
14879         }
14880         else {
14881                 $date_time = POSIX::strftime "%c", localtime;
14882                 $tz = ( $location[2] ) ? " ($location[2])" : '';
14883                 $weather{'date-time'} = $date_time . $tz;
14884         }
14885         # we get the wrong time using epoch for remote -W location
14886         if ( !$show{'weather-location'} && $weather{'observation-epoch'}){
14887                 $weather{'observation-time-local'} = POSIX::strftime "%c", localtime($weather{'observation-epoch'});
14888         }
14889         return %weather;
14890         eval $end if $b_log;
14891 }
14892 sub get_location {
14893         eval $start if $b_log;
14894         my ($city,$country,$freshness,%loc,$loc_arg,$loc_string,@loc_data,$state);
14895         my $now = POSIX::strftime "%Y%m%d%H%M", localtime;
14896         my $file_cached = "$user_data_dir/location-main.txt";
14897         if (-f $file_cached){
14898                 @loc_data = main::reader($file_cached);
14899                 $freshness = (split /\^\^/, $loc_data[0])[1];
14900         }
14901         if (!$freshness || $freshness < $now - 90) {
14902                 my $temp;
14903                 my $url = "http://geoip.ubuntu.com/lookup";
14904 #               {
14905 #                       local $/;
14906 #                       my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/weather/location-1.xml";
14907 #                       open my $fh, '<', $file or die "can't open $file: $!";
14908 #                       $temp = <$fh>;
14909 #               }
14910                 $temp  = main::download_file('stdout',$url);
14911                 @loc_data = split /\n/, $temp;
14912                 @loc_data = map {
14913                 s/<\?.*<Response>//;
14914                 s/<\/[^>]+>/\n/g;
14915                 s/>/^^/g;
14916                 s/<//g;
14917                 $_;
14918                 } @loc_data;
14919                 @loc_data = split /\n/, $loc_data[0];
14920                 unshift (@loc_data,("timestamp^^$now"));
14921                 main::writer($file_cached,\@loc_data);
14922                 #print "$file_cached: download/cleaned\n";
14923         }
14924         foreach (@loc_data){
14925                 my @working = split /\s*\^\^\s*/,$_;
14926                 #print "$working[0]:$working[1]\n";
14927                 if ($working[0] eq 'CountryCode3' ) {
14928                         $loc{'country3'} = $working[1];
14929                 }
14930                 elsif ($working[0] eq 'CountryCode' ) {
14931                         $loc{'country'} = $working[1];
14932                 }
14933                 elsif ($working[0] eq 'CountryName' ) {
14934                         $loc{'country2'} = $working[1];
14935                 }
14936                 elsif ($working[0] eq 'RegionCode' ) {
14937                         $loc{'region-id'} = $working[1];
14938                 }
14939                 elsif ($working[0] eq 'RegionName' ) {
14940                         $loc{'region'} = $working[1];
14941                 }
14942                 elsif ($working[0] eq 'City' ) {
14943                         $loc{'city'} = $working[1];
14944                 }
14945                 elsif ($working[0] eq 'ZipPostalCode' ) {
14946                         $loc{'zip'} = $working[1];
14947                 }
14948                 elsif ($working[0] eq 'Latitude' ) {
14949                         $loc{'lat'} = $working[1];
14950                 }
14951                 elsif ($working[0] eq 'Longitude' ) {
14952                         $loc{'long'} = $working[1];
14953                 }
14954                 elsif ($working[0] eq 'TimeZone' ) {
14955                         $loc{'tz'} = $working[1];
14956                 }
14957         }
14958         #print Data::Dumper::Dumper \%loc;
14959         # assign location, cascade from most accurate
14960         # latitude,longitude first
14961         if ($loc{'lat'} && $loc{'long'}){
14962                 $loc_arg = "$loc{'lat'},$loc{'long'}";
14963         }
14964         # city,state next
14965         elsif ($loc{'city'} && $loc{'region-id'}){
14966                 $loc_arg = "$loc{'city'},$loc{'region-id'}";
14967         }
14968         # postal code last, that can be a very large region
14969         elsif ($loc{'zip'}){
14970                 $loc_arg = $loc{'zip'};
14971         }
14972         $country = ($loc{'country3'}) ? $loc{'country3'} : $loc{'country'};
14973         $city = ($loc{'city'}) ? $loc{'city'} : 'City N/A';
14974         $state = ($loc{'region-id'}) ? $loc{'region-id'} : 'Region N/A';
14975         $loc_string = main::apply_filter("$city, $state, $country");
14976         my @location = ($loc_arg,$loc_string,$loc{'tz'});
14977         #print ($loc_arg,"\n", join "\n", @loc_data, "\n",scalar @loc_data, "\n");
14978         eval $end if $b_log;
14979         return @location;
14980 }
14981 }
14982
14983 #### -------------------------------------------------------------------
14984 #### UTILITIES FOR DATA LINES
14985 #### -------------------------------------------------------------------
14986
14987 sub get_compiler_version {
14988         eval $start if $b_log;
14989         my (@compiler);
14990         if (my $file = system_files('version') ) {
14991                 @compiler = get_compiler_version_linux($file);
14992         }
14993         else {
14994                 @compiler = get_compiler_version_bsd();
14995         }
14996         eval $end if $b_log;
14997         return @compiler;
14998 }
14999
15000 sub get_compiler_version_bsd {
15001         eval $start if $b_log;
15002         my (@compiler,@working);
15003         if ($alerts{'sysctl'}{'action'} eq 'use'){
15004                 # for dragonfly, we will use free mem, not used because free is 0
15005                 my @working;
15006                 foreach (@sysctl){
15007                         # freebsd seems to use bytes here
15008                         # Not every line will have a : separator though the processor should make
15009                         # most have it. This appears to be 10.x late feature add, I don't see it
15010                         # on earlier BSDs
15011                         if (/^kern.compiler_version/){
15012                                 @working = split /:\s*/, $_;
15013                                 $working[1] =~ /.*(gcc|clang)\sversion\s([\S]+)\s.*/;
15014                                 @compiler = ($1,$2);
15015                                 last;
15016                         }
15017                 }
15018         }
15019         else {
15020                 @compiler = ('N/A','');
15021         }
15022         log_data('dump','@compiler',\@compiler) if $b_log;
15023         eval $end if $b_log;
15024         return @compiler;
15025 }
15026
15027 sub get_compiler_version_linux {
15028         eval $start if $b_log;
15029         my ($file) = @_;
15030         my (@compiler,$type);
15031         my @data = reader($file);
15032         my $result = $data[0] if @data;
15033         if ($result){
15034                 $result =~ /(gcc|clang).*version\s([\S]+)/;
15035                 # $result = $result =~ /\*(gcc|clang)\*eval\*/;
15036                 if ($1){
15037                         $type = $2;
15038                         $type ||= 'N/A'; # we don't really know what linux clang looks like!
15039                         @compiler = ($1,$type);
15040                 }
15041         }
15042         log_data('dump','@compiler',\@compiler) if $b_log;
15043
15044         eval $end if $b_log;
15045         return @compiler;
15046 }
15047
15048 ## Get DesktopEnvironment
15049 ## returns array:
15050 # 0 - desktop name
15051 # 1 - version
15052 # 2 - toolkit
15053 # 3 - toolkit version
15054 # 4 - info extra desktop data
15055 # 5 - wm
15056 # 6 - wm version
15057 {
15058 package DesktopEnvironment;
15059 my ($b_xprop,$desktop_session,$kde_session_version,$xdg_desktop,@desktop,@data,@xprop);
15060 sub get {
15061         # NOTE $XDG_CURRENT_DESKTOP envvar is not reliable, but it shows certain desktops better.
15062         # most desktops are not using it as of 2014-01-13 (KDE, UNITY, LXDE. Not Gnome)
15063         $desktop_session = ( $ENV{'DESKTOP_SESSION'} ) ? lc($ENV{'DESKTOP_SESSION'}) : '';
15064         $xdg_desktop = ( $ENV{'XDG_CURRENT_DESKTOP'} ) ? lc($ENV{'XDG_CURRENT_DESKTOP'}) : '';
15065         $kde_session_version = ($ENV{'KDE_SESSION_VERSION'}) ? $ENV{'KDE_SESSION_VERSION'} : '';
15066         get_kde_data();
15067         if (!@desktop){
15068                 get_env_de_data();
15069         }
15070         if (!@desktop){
15071                 get_env_xprop_de_data();
15072         }
15073         if (!@desktop && $b_xprop ){
15074                 get_xprop_de_data();
15075         }
15076         if (!@desktop){
15077                 get_ps_de_data();
15078         }
15079         if ($extra > 2 && @desktop){
15080                 set_info_data();
15081         }
15082         if ($b_display && !$b_force_display && $extra > 1){
15083                 get_wm();
15084         }
15085         main::log_data('dump','@desktop', \@desktop) if $b_log;
15086         # ($b_xprop,$kde_session_version,$xdg_desktop,@data,@xprop) = undef;
15087         return @desktop;
15088 }
15089 sub get_kde_data {
15090         eval $start if $b_log;
15091         my ($program,@version_data,@version_data2);
15092         my $kde_full_session = ($ENV{'KDE_FULL_SESSION'}) ? $ENV{'KDE_FULL_SESSION'} : '';
15093         return 1 if ($xdg_desktop ne 'kde' && !$kde_session_version && $kde_full_session ne 'true' );
15094         # works on 4, assume 5 will id the same, why not, no need to update in future
15095         # KDE_SESSION_VERSION is the integer version of the desktop
15096         # NOTE: as of plasma 5, the tool: about-distro MAY be available, that will show
15097         # actual desktop data, so once that's in debian/ubuntu, if it gets in, add that test
15098         if ($xdg_desktop eq 'kde' || $kde_session_version ){
15099                 if ($kde_session_version && $kde_session_version <= 4){
15100                         @data = main::program_values("kded$kde_session_version");
15101                         if (@data){
15102                                 $desktop[0] = $data[3];
15103                                 $desktop[1] = main::program_version("kded$kde_session_version",$data[0],$data[1],$data[2],$data[5],$data[6]);
15104                                 # kded exists, so we can now get the qt data string as well
15105                                 if ($desktop[1] && ($program = main::check_program("kded$kde_session_version")) ){
15106                                         @version_data = main::grabber("$program --version 2>/dev/null");
15107                                 }
15108                         }
15109                         $desktop[0] = 'KDE' if !$desktop[0];
15110                 }
15111                 else {
15112                         # NOTE: this command string is almost certain to change, and break, with next
15113                         # major plasma desktop, ie, 6.
15114                         # qdbus org.kde.plasmashell /MainApplication org.qtproject.Qt.QCoreApplication.applicationVersion
15115                         # Qt: 5.4.2
15116                         # KDE Frameworks: 5.11.0
15117                         # kf5-config: 1.0
15118                         # for QT, and Frameworks if we use it
15119                         if (!@version_data && ($program = main::check_program("kf$kde_session_version-config") )){
15120                                 @version_data = main::grabber("$program --version 2>/dev/null");
15121                         }
15122                         if (!@version_data && ($program = main::check_program("kded$kde_session_version"))){
15123                                 @version_data = main::grabber("$program --version 2>/dev/null");
15124                         }
15125                         if ($program = main::check_program("plasmashell")){
15126                                 @version_data2 = main::grabber("$program --version 2>/dev/null");
15127                                 $desktop[1] = main::awk(\@version_data2,'^plasmashell',-1,'\s+');
15128                         }
15129                         $desktop[0] = 'KDE Plasma';
15130                 }
15131                 if (!$desktop[1]){
15132                         $desktop[1] = ($kde_session_version) ? $kde_session_version: main::row_defaults('unknown-desktop-version');
15133                 }
15134                 # print Data::Dumper::Dumper \@version_data;
15135                 if ($extra > 1){
15136                         if (@version_data){
15137                                 $desktop[3] = main::awk(\@version_data,'^Qt:', 2,'\s+');
15138                         }
15139                         # qmake can have variants, qt4-qmake, qt5-qmake, also qt5-default but not tested
15140                         if (!$desktop[3] && ($program = main::check_program("qmake"))){
15141                                 # note: this program has issues, it may appear to be in /usr/bin, but it
15142                                 # often fails to execute, so the below will have null output, but use as a
15143                                 # fall back test anyway.
15144                                 @version_data = main::grabber("$program --version 2>/dev/null");
15145                                 $desktop[3] = main::awk(\@version_data,'^Using Qt version',4) if @version_data;
15146                         }
15147                         $desktop[2] = 'Qt';
15148                 }
15149         }
15150         # KDE_FULL_SESSION property is only available since KDE 3.5.5.
15151         elsif ($kde_full_session eq 'true'){
15152                 @version_data = main::grabber("kded --version 2>/dev/null");
15153                 $desktop[0] = 'KDE';
15154                 $desktop[1] = main::awk(\@version_data,'^KDE:',2,'\s+') if @version_data;
15155                 if (!$desktop[1]){
15156                         $desktop[1] = '3.5';
15157                 }
15158                 if ($extra > 1 && @version_data){
15159                         $desktop[2] = 'Qt';
15160                         $desktop[3] = main::awk(\@version_data,'^Qt:',2,'\s+') if @version_data;
15161                 }
15162         }
15163         eval $end if $b_log;
15164 }
15165 sub get_env_de_data {
15166         eval $start if $b_log;
15167         my ($program,@version_data);
15168         main::set_ps_gui() if ! $b_ps_gui;
15169         if ($desktop_session eq 'trinity' || $xdg_desktop eq 'trinity' || (grep {/^tde/} @ps_gui) ){
15170                 $desktop[0] = 'Trinity';
15171                 if ($program = main::check_program('kdesktop')){
15172                         @version_data = main::grabber("$program --version 2>/dev/null");
15173                         $desktop[1] = main::awk(\@version_data,'^TDE:',2,'\s+') if @version_data;
15174                 }
15175                 if ($extra > 1 && @version_data){
15176                         $desktop[2] = 'Qt';
15177                         $desktop[3] = main::awk(\@version_data,'^Qt:',2,'\s+') if @version_data;
15178                 }
15179         }
15180         elsif ($xdg_desktop eq 'unity'){
15181                 @data = main::program_values('unity');
15182                 $desktop[0] = $data[3];
15183                 $desktop[0] ||= 'Unity';
15184                 $desktop[1] = main::program_version('cinnamon',$data[0],$data[1],$data[2],$data[5],$data[6]);
15185                 #set_gtk_data() if $extra > 1;
15186         }
15187         elsif ( $xdg_desktop =~ /budgie/ ){
15188                 @data = main::program_values('budgie');
15189                 $desktop[0] = $data[3];
15190                 $desktop[1] = main::program_version('budgie-desktop',$data[0],$data[1],$data[2],$data[5],$data[6]);
15191         }
15192         # debian package: lxde-core.
15193         # NOTE: some distros fail to set XDG data for root
15194         elsif ( $xdg_desktop =~ /^(lxde|razor|lxqt)$/ || (grep {/^(razor-session|lxsession|lxqt-session)$/} @ps_gui)){
15195                 # note: openbox-lxde --version may be present, but returns openbox data
15196                 if ($xdg_desktop eq 'lxde' || (grep {/^lxsession$/} @ps_gui )){
15197                         @data = main::program_values('lxde');
15198                         $desktop[0] = $data[3];
15199                         $desktop[1] = main::program_version('lxpanel',$data[0],$data[1],$data[2],$data[5],$data[6]);
15200                 }
15201                 # NOTE: lxqt-about opens a gui dialog
15202                 elsif ($xdg_desktop eq 'razor' || $xdg_desktop eq 'lxqt' || (grep {/^(razor-desktop|lxqt-session)$/} @ps_gui)) {
15203                         if (grep {/^lxqt-session$/} @ps_gui){
15204                                 @data = main::program_values('lxqt');
15205                                 $desktop[0] = $data[3];
15206                                 # BAD: lxqt-about opens dialogue, sigh
15207                                 $desktop[1] = main::program_version('lxqt-panel',$data[0],$data[1],$data[2],$data[5],$data[6]);
15208                         }
15209                         elsif (grep {/^razor-session$/} @ps_gui){
15210                                 $desktop[0] = 'Razor-Qt';
15211                         }
15212                         else {
15213                                 $desktop[0] = 'LX-Qt-Variant';
15214                         }
15215                         set_qt_data() if $extra > 1;
15216                 }
15217         }
15218         # note, X-Cinnamon value strikes me as highly likely to change, so just
15219         # search for the last part
15220         elsif ( $xdg_desktop =~ /cinnamon/ ){
15221                 @data = main::program_values('cinnamon');
15222                 $desktop[0] = $data[3];
15223                 $desktop[1] = main::program_version('cinnamon',$data[0],$data[1],$data[2],$data[5],$data[6]);
15224                 #set_gtk_data() if $extra > 1;
15225         }
15226         elsif ($xdg_desktop eq 'pantheon' || $desktop_session eq 'pantheon'){
15227                 @data = main::program_values('pantheon');
15228                 $desktop[0] = $data[3];
15229                 #$desktop[1] = main::program_version('pantheon',$data[0],$data[1],$data[2],$data[5],$data[6]);
15230                 #set_gtk_data() if $extra > 1;
15231         }
15232         eval $end if $b_log;
15233 }
15234 sub get_env_xprop_de_data {
15235         eval $start if $b_log;
15236         my ($program,$value,@version_data);
15237         # NOTE: Always add to set_prop the search term if you add an item!!
15238         set_xprop();
15239         # note that cinnamon split from gnome, and and can now be id'ed via xprop,
15240         # but it will still trigger the next gnome true case, so this needs to go
15241         # before gnome test eventually this needs to be better organized so all the
15242         # xprop tests are in the same section, but this is good enough for now.
15243         # NOTE: was checking for 'muffinr' but that's not part of cinnom
15244         if ( (main::check_program('muffin') || main::check_program('cinnamon-session') ) &&
15245              ($b_xprop && main::awk(\@xprop,'_muffin') )){
15246                 @data = main::program_values('cinnamon');
15247                 $desktop[0] = $data[3];
15248                 $desktop[1] = main::program_version('cinnamon',$data[0],$data[1],$data[2],$data[5],$data[6]);
15249                 #set_gtk_data() if $extra > 1;
15250                 $desktop[0] ||= 'Cinnamon';
15251         }
15252         elsif ($xdg_desktop eq 'mate' || ( $b_xprop && main::awk(\@xprop,'_marco') )){
15253                 # NOTE: mate-about reported wrong version, 1.18.0 when actual was 1.18.2
15254                 if ($program = main::check_program('mate-session') ) {
15255                         $value = 'mate-session';
15256                 }
15257                 if ($value){
15258                         @data = main::program_values($value);
15259                         $desktop[0] = $data[3];
15260                         $desktop[1] = main::program_version($program,$data[0],$data[1],$data[2],$data[5],$data[6]);
15261                 }
15262                 #set_gtk_data() if $extra > 1;
15263                 $desktop[0] ||= 'MATE';
15264         }
15265         # note, GNOME_DESKTOP_SESSION_ID is deprecated so we'll see how that works out
15266         # https://bugzilla.gnome.org/show_bug.cgi?id=542880.
15267         # NOTE: manjaro is leaving XDG data null, which forces the manual check for gnome, sigh...
15268         elsif ($xdg_desktop eq 'gnome' || $ENV{'GNOME_DESKTOP_SESSION_ID'} ||
15269               (main::check_program('gnome-shell') && $b_xprop && main::awk(\@xprop,'^_gnome') ) ){
15270                 if ($program = main::check_program('gnome-about') ) {
15271                         @data = main::program_values('gnome-about');
15272                         $desktop[1] = main::program_version('gnome-about',$data[0],$data[1],$data[2],$data[5],$data[6]);
15273                 }
15274                 elsif ($program = main::check_program('gnome-shell') ) {
15275                         @data = main::program_values('gnome-shell');
15276                         $desktop[1] = main::program_version('gnome-shell',$data[0],$data[1],$data[2],$data[5],$data[6]);
15277                 }
15278                 # set_gtk_data() if $extra > 1;
15279                 $desktop[0] = ( $data[3] ) ? $data[3] : 'Gnome';
15280         }
15281         eval $end if $b_log;
15282 }
15283 sub get_xprop_de_data {
15284         eval $start if $b_log;
15285         my ($program,@version_data,$version);
15286         #print join "\n", @xprop, "\n";
15287         # String: "This is xfdesktop version 4.2.12"
15288         # alternate: xfce4-about --version > xfce4-about 4.10.0 (Xfce 4.10)
15289         # note: some distros/wm (e.g. bunsen) set xdg to xfce to solve some other
15290         # issues so don't test for that. $xdg_desktop eq 'xfce'
15291         # the sequence here matters, some desktops like icewm, razor, let you set different
15292         # wm, so we want to get the main controlling desktop first, then fall back to the wm
15293         # detections. get_wm() will handle alternate wm detections.
15294         if ((main::check_program('xfdesktop')) && main::awk(\@xprop,'^(xfdesktop|xfce)' )){
15295                 # this is a very expensive test that doesn't usually result in a find
15296                 # talk to xfce to see what id they will be using for xfce 5
15297 #               if (main::awk(\@xprop, 'xfce4')){
15298 #                       $version = '4';
15299 #               }
15300                 if (main::awk(\@xprop, 'xfce5')){
15301                         $version = '5';
15302                 }
15303                 else {
15304                         $version = '4';
15305                 }
15306                 @data = main::program_values('xfdesktop');
15307                 $desktop[0] = $data[3];
15308                 # xfdesktop --version out of x fails to get display, so no data
15309                 @version_data = main::grabber('xfdesktop --version 2>/dev/null');
15310                 # out of x, this error goes to stderr, so it's an empty result
15311                 $desktop[1] = main::awk(\@version_data,$data[0],$data[1],'\s+');
15312                 #$desktop[1] = main::program_version('xfdesktop',$data[0],$data[1],$data[2],$data[5],$data[6]);
15313                 if ( !$desktop[1] ){
15314                         @data = main::program_values("xfce${version}-panel");
15315                         # print Data::Dumper::Dumper \@data;
15316                         # this returns an error message to stdout in x, which breaks the version
15317                         # xfce4-panel --version out of x fails to get display, so no data
15318                         $desktop[1] = main::program_version("xfce${version}-panel",$data[0],$data[1],$data[2],$data[5],$data[6]);
15319                         # out of x this kicks out an error: xfce4-panel: Cannot open display
15320                         $desktop[1] = '' if $desktop[1] !~ /[0-9]\./;
15321                 }
15322                 $desktop[0] ||= 'Xfce';
15323                 $desktop[1] ||= ''; # xfce isn't going to be 4 forever
15324                 if ($extra > 1){
15325                         @data = main::program_values('xfdesktop-toolkit');
15326                         #$desktop[3] = main::program_version('xfdesktop',$data[0],$data[1],$data[2],$data[5],$data[6]);
15327                         $desktop[3] = main::awk(\@version_data,$data[0],$data[1],'\s+');
15328                         $desktop[2] = $data[3];
15329                 }
15330         }
15331         elsif (main::check_program('enlightenment') && main::awk(\@xprop,'enlightenment' )){
15332                 $desktop[0] = 'Enlightenment';
15333                 # no -v or --version but version is in xprop -root
15334                 # ENLIGHTENMENT_VERSION(STRING) = "Enlightenment 0.16.999.49898"
15335                 $desktop[1] = main::awk(\@xprop,'enlightenment_version',2,'\s+=\s+' );
15336                 $desktop[1] = (split /"/, $desktop[1])[1] if $desktop[1];
15337                 $desktop[1] = (split /\s+/, $desktop[1])[1] if $desktop[1];
15338         }
15339         # must come right after xfce
15340         elsif (main::check_program('icewm') && main::awk(\@xprop,'icewm' )){
15341                 @data = main::program_values('icewm');
15342                 $desktop[0] = $data[3];
15343                 $desktop[1] = main::program_version('icewm',$data[0],$data[1],$data[2],$data[5],$data[6]);
15344         }
15345         # debian package: i3-wm
15346         elsif (main::check_program('i3') && main::awk(\@xprop,'^i3_' )){
15347                 @data = main::program_values('i3');
15348                 $desktop[0] = $data[3];
15349                 $desktop[1] = main::program_version('i3',$data[0],$data[1],$data[2],$data[5],$data[6]);
15350         }
15351         elsif (main::check_program('mwm') && main::awk(\@xprop,'^_motif' )){
15352                 @data = main::program_values('mwm');
15353                 $desktop[0] = $data[3];
15354                 # $desktop[1] = main::program_version('mwm',$data[0],$data[1],$data[2],$data[5],$data[6]);
15355         }
15356         # debian package name: wmaker
15357         elsif (main::check_program('WindowMaker') && main::awk(\@xprop,'^_?windowmaker' )){
15358                 @data = main::program_values('wmaker');
15359                 $desktop[0] = $data[3];
15360                 $desktop[1] = main::program_version('wmaker',$data[0],$data[1],$data[2],$data[5],$data[6]);
15361         }
15362         elsif (main::check_program('wm2') && main::awk(\@xprop,'^_wm2' )){
15363                 @data = main::program_values('wm2');
15364                 $desktop[0] = $data[3];
15365                 $desktop[1] = main::program_version('wm2',$data[0],$data[1],$data[2],$data[5],$data[6]);
15366         }
15367         elsif (main::check_program('herbstluftwm') && main::awk(\@xprop,'herbstluftwm' )){
15368                 @data = main::program_values('herbstluftwm');
15369                 $desktop[0] = $data[3];
15370                 $desktop[1] = main::program_version('herbstluftwm',$data[0],$data[1],$data[2],$data[5],$data[6]);
15371         }
15372         elsif ( (main::check_program('blackbox') || main::check_program('fluxbox')) && main::awk(\@xprop,'blackbox_pid' )){
15373                 if (@ps_gui && (grep {/^fluxbox$/} @ps_gui )){
15374                         @data = main::program_values('fluxbox');
15375                         $desktop[0] = $data[3];
15376                         $desktop[1] = main::program_version('fluxbox',$data[0],$data[1],$data[2],$data[5],$data[6]);
15377                 }
15378                 else {
15379                         @data = main::program_values('blackbox');
15380                         $desktop[0] = $data[3];
15381                         $desktop[1] = main::program_version('blackbox',$data[0],$data[1],$data[2],$data[5],$data[6]);
15382                 }
15383         }
15384         elsif (main::check_program('openbox') && main::awk(\@xprop,'openbox_pid' )){
15385                 @data = main::program_values('openbox');
15386                 $desktop[0] = $data[3];
15387                 $desktop[1] = main::program_version('openbox',$data[0],$data[1],$data[2],$data[5],$data[6]);
15388         }
15389         elsif (main::check_program('amiwm') && main::awk(\@xprop,'amiwm' )){
15390                 @data = main::program_values('amiwm');
15391                 $desktop[0] = $data[3];
15392                 #$desktop[1] = main::program_version('openbox',$data[0],$data[1],$data[2],$data[5],$data[6]);
15393         }
15394         # need to check starts line because it's so short
15395         eval $end if $b_log;
15396 }
15397 sub get_ps_de_data {
15398         eval $start if $b_log;
15399         my ($program,@version_data);
15400         main::set_ps_gui() if !$b_ps_gui;
15401         if (@ps_gui){
15402                 # 1 check program; 2 search; 3 values; 4 version; 5 -optional: print value
15403                 my @desktops =(
15404                 ['fluxbox','fluxbox','fluxbox','fluxbox'],
15405                 ['fvwm-crystal','fvwm-crystal','fvwm-crystal','fvwm'],
15406                 ['fvwm2','fvwm2','fvwm2','fvwm2'],
15407                 ['fvwm','fvwm','fvwm','fvwm'],
15408                 ['pekwm','pekwm','pekwm','pekwm'],
15409                 ['awesome','awesome','awesome','awesome'],
15410                 ['blackbox','blackbox','blackbox','blackbox'],
15411                 ['openbox','openbox','openbox','openbox'],
15412                 # not in debian apt
15413                 ['scrotwm','scrotwm','scrotwm','scrotwm'],
15414                 ['spectrwm','spectrwm','spectrwm','spectrwm'],
15415                 ['twm','twm','twm','twm'],
15416                 # note: built from source, but I assume it will show: /usr/bin/dwm
15417                 ['dwm','dwm','dwm','dwm'],
15418                 # not in debian apt, current is wmii, version 3
15419                 ['wmii2','wmii2','wmii2','wmii2'],
15420                 ['wmii','wmii','wmii','wmii'],
15421                 ['9wm','9wm','9wm','9wm'],
15422                 ['amiwm','amiwm','amiwm','amiwm'],
15423                 ['flwm','flwm','flwm','flwm'],
15424                 ['jwm','jwm','jwm','jwm'],
15425                 ['mwm','mwm','mwm','mwm'],
15426                 ['notion','notion','notion','notion'],
15427                 ['ratpoison','ratpoison','ratpoison','ratpoison'],
15428                 ['sawfish','sawfish','sawfish','sawfish'],
15429                 ['matchbox-window-manager','matchbox-window-manager',
15430                   'matchbox-window-manager','matchbox-window-manager'],
15431                 ['afterstep','afterstep','afterstep','afterstep'],
15432                 ['WindowMaker','WindowMaker','wmaker','wmaker'],
15433                 ['windowlab','windowlab','windowlab','windowlab'],
15434                 ['xmonad','xmonad','xmonad','xmonad'],
15435                 );
15436                 foreach my $ref (@desktops){
15437                         my @item = @$ref;
15438                         # no need to use check program with short list of ps_gui
15439                         # if ( main::check_program($item[0]) && (grep {/^$item[1]$/} @ps_gui)){
15440                         if (grep {/^$item[1]$/} @ps_gui){
15441                                 @data = main::program_values($item[2]);
15442                                 $desktop[0] = $data[3];
15443                                 if ($data[1] && $data[2]){
15444                                         $desktop[1] = main::program_version($item[3],$data[0],$data[1],$data[2],$data[5],$data[6]);
15445                                 }
15446                                 last;
15447                         }
15448                 }
15449         }
15450         eval $end if $b_log;
15451 }
15452
15453 sub set_qt_data {
15454         eval $start if $b_log;
15455         my ($program,@data,@version_data);
15456         my $kde_version = $kde_session_version;
15457         $program = '';
15458         if (!$kde_version){
15459                 if ($program = main::check_program("kded6") ){$kde_version = 6;}
15460                 elsif ($program = main::check_program("kded5") ){$kde_version = 5;}
15461                 elsif ($program = main::check_program("kded4") ){$kde_version = 4;}
15462                 elsif ($program = main::check_program("kded") ){$kde_version = '';}
15463         }
15464         # alternate: qt4-default, qt4-qmake or qt5-default, qt5-qmake
15465         if (!$desktop[3] && ($program = main::check_program("qmake"))){
15466                 @version_data = main::grabber("$program --version 2>/dev/null");
15467                 $desktop[2] = 'Qt';
15468                 $desktop[3] = main::awk(\@version_data,'^Using Qt version',4) if @version_data;
15469         }
15470         if (!$desktop[3] && ($program = main::check_program("qtdiag") )){
15471                 @data = main::program_values('qtdiag');
15472                 $desktop[3] = main::program_version($program,$data[0],$data[1],$data[2],$data[5],$data[6]);
15473                 $desktop[2] = $data[3];
15474         }
15475         if (!$desktop[3] && ($program = main::check_program("kf$kde_version-config") )){
15476                 @version_data = main::grabber("$program --version 2>/dev/null");
15477                 $desktop[2] = 'Qt';
15478                 $desktop[3] = main::awk(\@version_data,'^Qt:',2) if @version_data;
15479         }
15480         # note: qt 5 does not show qt version in kded5, sigh
15481         if (!$desktop[3] && ($program = main::check_program("kded$kde_version"))){
15482                 @version_data = main::grabber("$program --version 2>/dev/null");
15483                 $desktop[2] = 'Qt';
15484                 $desktop[3] = main::awk(\@version_data,'^Qt:',2) if @version_data;
15485         }
15486         eval $end if $b_log;
15487 }
15488
15489 sub get_wm {
15490         eval $start if $b_log;
15491         if (!$b_wmctrl) {
15492                 get_wm_main();
15493         }
15494         if ( (!$desktop[5] || $b_wmctrl) && (my $program = main::check_program('wmctrl'))){
15495                 get_wm_wmctrl($program);
15496         }
15497         eval $end if $b_log;
15498 }
15499 sub get_wm_main {
15500         eval $start if $b_log;
15501         my ($wms,$working);
15502         # xprop is set only if not kde/gnome/cinnamon/mate/budgie/lx..
15503         if ($b_xprop){
15504                 #KWIN_RUNNING
15505                 $wms = 'blackbox|compiz|kwin_wayland|kwin_x11|kwin|marco|muffin|';
15506                 $wms .= 'openbox|herbstluftwm|twin|wm2|windowmaker|i3';
15507                 foreach (@xprop){
15508                         if (/\b($wms)\b/){
15509                                 $working = $1;
15510                                 $working = 'wmaker' if $working eq 'windowmaker';
15511                                 last;
15512                         }
15513                 }
15514         }
15515         if (!$desktop[5]){
15516                 main::set_ps_gui() if ! $b_ps_gui;
15517                 # order matters, see above logic
15518                 $wms = '9wm|afterstep|amiwm|awesome|budgie-wm|compiz|fluxbox|blackbox|dwm|';
15519                 $wms .= 'flwm|fvwm-crystal|fvwm2|fvwm|gala|gnome-shell|i3|jwm|';
15520                 $wms .= 'twin|kwin_wayland|kwin_x11|kwin|matchbox-window-manager|marco|';
15521                 $wms .= 'muffin|mutter|metacity|mwm|notion|openbox|ratpoison|sawfish|scrotwm|spectrwm|';
15522                 $wms .= 'twm|windowlab|WindowMaker|wm2|wmii2|wmii|xfwm4|xfwm5|xmonad';
15523                 foreach (@ps_gui){
15524                         if (/^($wms)$/){
15525                                 $working = $1;
15526                                 last;
15527                         }
15528                 }
15529         }
15530         get_wm_version('manual',$working) if $working;
15531         $desktop[5] = $working if !$desktop[5] && $working;
15532         eval $end if $b_log;
15533 }
15534 sub get_wm_wmctrl {
15535         eval $start if $b_log;
15536         my ($program) = @_;
15537         my $cmd = "$program -m 2>/dev/null";
15538         my @data = main::grabber($cmd,'','strip');
15539         main::log_data('dump','@data',\@data) if $b_log;
15540         $desktop[5] = main::awk(\@data,'^Name',2,'\s*:\s*');
15541         $desktop[5] = '' if $desktop[5] && $desktop[5] eq 'N/A';
15542         if ($desktop[5]){
15543                 # variants: gnome shell;
15544                 # IceWM 1.3.8 (Linux 3.2.0-4-amd64/i686) ; Metacity (Marco) ; Xfwm4
15545                 $desktop[5] =~ s/\d+\.\d\S+|[\[\(].*\d+\.\d.*[\)\]]//g;
15546                 $desktop[5] = main::trimmer($desktop[5]);
15547                 # change Metacity (Marco) to marco
15548                 if ($desktop[5] =~ /marco/i) {$desktop[5] = 'marco'}
15549                 elsif (lc($desktop[5]) eq 'gnome shell') {$desktop[5] = 'gnome-shell'}
15550                 elsif ($desktop_session eq 'trinity' && lc($desktop[5]) eq 'kwin') {$desktop[5] = 'Twin'}
15551                 get_wm_version('wmctrl',$desktop[5]);
15552         }
15553         eval $end if $b_log;
15554 }
15555 sub get_wm_version {
15556         eval $start if $b_log;
15557         my ($type,$wm) = @_;
15558         # we don't want the gnome-shell version, and the others have no --version
15559         # we also don't want to run --version again on stuff we already have tested
15560         return if ! $wm || $wm =~ /^(budgie-wm|gnome-shell)$/ || ($desktop[0] && lc($desktop[0]) eq lc($wm) );
15561         my $temp = (split /\s+/, $wm)[0];
15562         if ($temp){
15563                 $temp = (split /\s+/, $temp)[0];
15564                 $temp = lc($temp);
15565                 $temp = 'wmaker' if $temp eq 'windowmaker';
15566                 my @data = main::program_values($temp);
15567                 return if !@data;
15568                 # print Data::Dumper::Dumper \@data;
15569                 $desktop[5] = $data[3] if $type eq 'manual';
15570                 # note: if values returns 0 for 1 and 2, it doesn't support versioning
15571                 if ($extra > 2 && $data[1] && $data[2]){
15572                         my $version = main::program_version($temp,$data[0],$data[1],$data[2],$data[5],$data[6]);
15573                         $desktop[6] = $version if $version;
15574                 }
15575         }
15576         eval $end if $b_log;
15577 }
15578
15579 sub set_gtk_data {
15580         eval $start if $b_log;
15581         my ($version,$program,@data);
15582         # this is a hack, and has to be changed with every toolkit version change, and
15583         # only dev systems      # have this installed, but it's a cross distro command try it.
15584         if ($program = main::check_program('pkg-config')){
15585                 @data = main::grabber("$program --modversion gtk+-4.0 2>/dev/null");
15586                 $version = main::awk(\@data,'\S');
15587                 # note: opensuse gets null output here, we need the command to get version and output sample
15588                 if ( !$version ){
15589                         @data = main::grabber("$program --modversion gtk+-3.0 2>/dev/null");
15590                         $version = main::awk(\@data,'\S');
15591                 }
15592                 if ( !$version ){
15593                         @data = main::grabber("$program --modversion gtk+-2.0 2>/dev/null");
15594                         $version = main::awk(\@data,'\S');
15595                 }
15596         }
15597         # now let's go to more specific version tests, this will never cover everything and that's fine.
15598         if (!$version){
15599                 # we'll try some known package managers next. dpkg will handle a lot of distros
15600                 # this is the most likely order as of: 2014-01-13. Not going to try to support all
15601                 # package managers too much work, just the very biggest ones.
15602                 if ($program = main::check_program('dpkg')){
15603                         @data = main::grabber("$program -s libgtk-3-0 2>/dev/null");
15604                         $version = main::awk(\@data,'^\s*Version',2,'\s+');
15605                         # just guessing on gkt 4 package name
15606                         if (!$version){
15607                                 @data = main::grabber("$program -s libgtk-4-0 2>/dev/null");
15608                                 $version = main::awk(\@data,'^\s*Version',2,'\s+');
15609                         }
15610                         if (!$version){
15611                                 @data = main::grabber("$program -s libgtk2.0-0 2>/dev/null");
15612                                 $version = main::awk(\@data,'^\s*Version',2,'\s+');
15613                         }
15614                 }
15615                 elsif ($program = main::check_program('pacman')){
15616                         @data = main::grabber("$program -Qi gtk3 2>/dev/null");
15617                         $version = main::awk(\@data,'^\s*Version',2,'\s*:\s*');
15618                         # just guessing on gkt 4 package name
15619                         if (!$version){
15620                                 @data = main::grabber("$program -Qi gtk4 2>/dev/null");
15621                                 $version = main::awk(\@data,'^\s*Version',2,'\s*:\s*');
15622                         }
15623                         if (!$version){
15624                                 @data = main::grabber("$program -Qi gtk2 2>/dev/null");
15625                                 $version = main::awk(\@data,'^\s*Version',2,'\s*:\s*');
15626                         }
15627                 }
15628                 elsif ($program = main::check_program('rpm')){
15629                         @data = main::grabber("$program -qi libgtk-3-0 2>/dev/null");
15630                         $version = main::awk(\@data,'^\s*Version',2,'\s*:\s*');
15631                         # just guessing on gkt 4 package name
15632                         if (!$version){
15633                                 @data = main::grabber("$program -qi libgtk-4-0 2>/dev/null");
15634                                 $version = main::awk(\@data,'^\s*Version',2,'\s*:\s*');
15635                         }
15636                         if (!$version){
15637                                 @data = main::grabber("$program -qi libgtk-3-0 2>/dev/null");
15638                                 $version = main::awk(\@data,'^\s*Version',2,'\s*:\s*');
15639                         }
15640                 }
15641         }
15642         $desktop[2] = 'Gtk';
15643         eval $end if $b_log;
15644 }
15645 sub set_info_data {
15646         eval $start if $b_log;
15647         my (@data,@info,$item);
15648         my $pattern = 'gnome-panel|kicker|lxpanel|lxqt-panel|matchbox-panel|';
15649         $pattern .= 'mate-panel|plasma-desktop|plasma-netbook|razor-panel|razorqt-panel|';
15650         $pattern .= 'wingpanel|xfce4-panel|xfce5-panel';
15651         if (@data = grep {/^($pattern)$/} @ps_gui ) {
15652                 # only one entry per type, can be multiple
15653                 foreach $item (@data){
15654                         if (! grep {$item =~ /$_/} @info){
15655                                 $item = main::trimmer($item);
15656                                 $item =~ s/.*\///;
15657                                 push @info, (split /\s+/, $item)[0];
15658                         }
15659                 }
15660         }
15661         $desktop[4] = join (',', @info) if @info;
15662         eval $end if $b_log;
15663 }
15664
15665 sub set_xprop {
15666         eval $start if $b_log;
15667         if (my $program = main::check_program('xprop')){
15668                 @xprop = main::grabber("xprop -root $display_opt 2>/dev/null");
15669                 if (@xprop){
15670                         # add wm / de as required, but only add what is really tested for above
15671                         # XFDESKTOP_IMAGE_FILE; XFCE_DESKTOP
15672                         my $pattern = '^amiwm|blackbox_pid|compiz|enlightenment|^_gnome|herbstluftwm|';
15673                         $pattern .= '^kwin_|^i3_|icewm|_marco|^_motif|_muffin|openbox_pid|';
15674                         $pattern .= '^_?windowmaker|^_wm2|^(xfdesktop|xfce)';
15675                         # let's only do these searches once
15676                         @xprop = grep {/^\S/ && /($pattern)/i} @xprop;
15677                         $_ = lc for @xprop;
15678                         $b_xprop = 1 if scalar @xprop > 0;
15679                 }
15680         }
15681         # print "@xprop\n";
15682         eval $end if $b_log;
15683 }
15684
15685 }
15686
15687 sub get_display_manager {
15688         eval $start if $b_log;
15689         my (@data,@found,$temp,$working,$b_run,$b_vrun,$b_vrunrc);
15690         # ldm - LTSP display manager. Note that sddm does not appear to have a .pid
15691         # extension in Arch note: to avoid positives with directories, test for -f
15692         # explicitly, not -e
15693         my @dms = qw(entranced.pid gdm.pid gdm3.pid kdm.pid ldm.pid
15694         lightdm.pid lxdm.pid mdm.pid nodm.pid pcdm.pid  sddm.pid slim.lock
15695         tint2.pid wdm.pid xdm.pid xenodm.pid);
15696         # this is the only one I know of so far that has --version
15697         # lightdm outputs to stderr, so it has to be redirected
15698         my @dms_version = qw(lightdm);
15699         $b_run = 1 if -d "/run";
15700         # in most linux, /var/run is a sym link to /run, so no need to check it twice
15701         if ( -d "/var/run" ){
15702                 my $rdlink = readlink('/var/run');
15703                 $b_vrun = 1 if !$rdlink || ($rdlink && $rdlink ne '/run');
15704                 $b_vrunrc = 1 if -d "/var/run/rc.d";
15705         }
15706         foreach my $id (@dms){
15707                 # note: $working will create a dir name out of the dm $id, then
15708                 # test if pid is in that note: sddm, in an effort to be unique and special,
15709                 # do not use a pid/lock file, but rather a random string inside a directory
15710                 # called /run/sddm/ so assuming the existence of the pid inside a directory named
15711                 # from the dm. Hopefully this change will not have negative results.
15712                 $working = $id;
15713                 $working =~ s/\.\S+$//;
15714                 # note: there were issues with duplicated dm's in inxi, checking @found corrects it
15715                 if ( ( ( $b_run && ( -f "/run/$id" || -d "/run/$working" ) ) ||
15716                    ( $b_vrun && ( -f "/var/run/$id" || -d "/var/run/$working" ) ) ||
15717                    ( $b_vrunrc && ( -f "/var/run/rc.d/$working" || -d "/var/run/rc.d/$id" ) ) ) &&
15718                    ! grep {/$working/} @found ){
15719                         if ($extra > 2 && awk( \@dms_version, $working) && (my $path = main::check_program($working)) ){
15720                                 @data = main::grabber("$path --version 2>&1");
15721                                 $temp = awk(\@data,'\S',2,'\s+');
15722                                 $working .= ' ' . $temp if $temp;
15723                         }
15724                         push @found, $working;
15725                 }
15726         }
15727         if (!@found && grep {/\/usr.*\/x/ && !/\/xprt/} @ps_cmd){
15728                 if (awk (\@ps_cmd, 'startx') ){
15729                         $found[0] = 'startx';
15730                 }
15731                 elsif (awk (\@ps_cmd, 'xinit') ){
15732                         $found[0] = 'xinit';
15733                 }
15734         }
15735         # might add this in, but the rate of new dm's makes it more likely it's an
15736         # unknown dm, so we'll keep output to N/A
15737         log_data('dump','display manager: @found',\@found) if $b_log;
15738         eval $end if $b_log;
15739         return join ', ', @found if @found;
15740 }
15741
15742 ## Get DistroData
15743 {
15744 package DistroData;
15745 my (@distro_data,@osr);
15746 sub get {
15747         eval $start if $b_log;
15748         if ($bsd_type){
15749                 get_bsd_os();
15750         }
15751         else {
15752                 get_linux_distro();
15753         }
15754         eval $end if $b_log;
15755         return @distro_data;
15756 }
15757
15758 sub get_bsd_os {
15759         eval $start if $b_log;
15760         my ($distro) = ('');
15761         if ($bsd_type eq 'darwin'){
15762                 my $file = '/System/Library/CoreServices/SystemVersion.plist';
15763                 if (-f $file){
15764                         my @data = main::reader($file);
15765                         @data = grep {/(ProductName|ProductVersion)/} @data if @data;
15766                         @data = grep {/<string>/} @data if @data;
15767                         @data = map {s/<[\/]?string>//g; } @data if @data;
15768                         $distro = join (' ', @data);
15769                 }
15770         }
15771         else {
15772                 $distro = "$uname[0] $uname[2]";
15773         }
15774         @distro_data = ($distro,'');
15775         eval $end if $b_log;
15776 }
15777
15778 sub get_linux_distro {
15779         eval $start if $b_log;
15780         my ($distro,$distro_id,$distro_file,$system_base) = ('','','','');
15781         my ($b_issue,$b_osr,$b_use_issue,@working);
15782         # order matters!
15783         my @derived = qw(antix-version aptosid-version kanotix-version knoppix-version
15784         pclinuxos-release mandrake-release manjaro-release mx-version pardus-release
15785         porteus-version sabayon-release siduction-version sidux-version slitaz-release
15786         solusos-release turbolinux-release zenwalk-version);
15787         my $derived_s = join "|", @derived;
15788         my @primary = qw(altlinux-release arch-release gentoo-release redhat-release slackware-version
15789         SuSE-release);
15790         my $primary_s = join "|", @primary;
15791         my $exclude_s = 'debian_version|devuan_version|ubuntu_version';
15792         # note, pclinuxos has all these mandrake/mandriva files, careful!
15793         my $lsb_good_s = 'mandrake-release|mandriva-release|mandrakelinux-release|manjaro-release';
15794         my $os_release_good_s = 'altlinux-release|arch-release|pclinuxos-release|rpi-issue|SuSE-release';
15795         # note: always exceptions, so wild card after release/version:
15796         # /etc/lsb-release-crunchbang
15797         # wait to handle since crunchbang file is one of the few in the world that
15798         # uses this method
15799         my @distro_files = main::globber('/etc/*[-_]{[rR]elease,[vV]ersion,issue}*');
15800         my $lsb_release = '/etc/lsb-release';
15801         my $b_lsb = 1 if -f $lsb_release;
15802         my ($etc_issue,$issue,$lc_issue) = ('','/etc/issue','');
15803         $b_issue = 1 if -f $issue;
15804         # note: OpenSuse Tumbleweed 2018-05 has made /etc/issue created by sym link to /run/issue
15805         # and then made that resulting file 700 permissions, which is obviously a mistake
15806         $etc_issue = (main::reader($issue))[0] if -r $issue;
15807         $etc_issue = main::clean_characters($etc_issue);
15808         my $os_release = '/etc/os-release';
15809         @osr = main::reader($os_release) if -r $os_release;
15810         # debian issue can end with weird escapes like \n \l
15811         # antergos: Antergos Linux \r (\l)
15812         if ($etc_issue){
15813                 $lc_issue = lc($etc_issue) if $etc_issue;
15814                 if ($lc_issue =~ /(antergos|grml|linux lite)/){
15815                         $distro_id = $1;
15816                         $b_use_issue = 1;
15817                 }
15818                 elsif ($lc_issue =~ /(raspbian|peppermint)/){
15819                         $distro_id = $1;
15820                         $distro_file = $os_release if @osr;
15821                 }
15822         }
15823         # Note that antergos changed this around        # 2018-05, and now lists
15824         # antergos in os-release, sigh... We want these distros to use os-release
15825         # if it contains their names. Last check below
15826         if ( @osr && (grep {/manjaro|antergos|chakra|pclinuxos/i} @osr ) ){
15827                 $distro_file = $os_release;
15828                 #$system_base = 'Arch Linux';
15829         }
15830         $distro_id = 'armbian' if grep {/armbian/} @distro_files;
15831         main::log_data('dump','@distro_files',\@distro_files) if $b_log;
15832         main::log_data('data',"distro_file-1: $distro_file") if $b_log;
15833         if (!$distro_file){
15834                 if (scalar @distro_files == 1){
15835                         $distro_file = $distro_files[0];
15836                 }
15837                 elsif (scalar @distro_files > 1) {
15838                         # special case, to force manjaro/antergos which also have arch-release
15839                         # manjaro should use lsb, which has the full info, arch uses os release
15840                         # antergos should use /etc/issue. We've already checked os-release above
15841                         if ($distro_id eq 'antergos' || (grep {/antergos|chakra|manjaro/} @distro_files )){
15842                                 @distro_files = grep {!/arch-release/} @distro_files;
15843                                 #$system_base = 'Arch Linux';
15844                         }
15845                         my $distro_files_s = join "|", @distro_files;
15846                         @working = (@derived,@primary);
15847                         foreach my $file (@working){
15848                                 if ( "/etc/$file" =~ /($distro_files_s)$/){
15849                                         # Now lets see if the distro file is in the known-good working-lsb-list
15850                                         # if so, use lsb-release, if not, then just use the found file
15851                                         # this is for only those distro's with self named release/version files
15852                                         # because Mint does not use such, it must be done as below
15853                                         if (@osr && $file =~ /($os_release_good_s)$/){
15854                                                 $distro_file = $os_release;
15855                                         }
15856                                         elsif ($b_lsb && $file =~ /$lsb_good_s/){
15857                                                 $distro_file = $lsb_release;
15858                                         }
15859                                         else {
15860                                                 $distro_file = "/etc/$file";
15861                                         }
15862                                         last;
15863                                 }
15864                         }
15865                 }
15866         }
15867         main::log_data('data',"distro_file-2: $distro_file") if $b_log;
15868         # first test for the legacy antiX distro id file
15869         if ( -f '/etc/antiX'){
15870                 @working = main::reader('/etc/antiX');
15871                 $distro = main::awk(\@working,'antix.*\.iso') if @working;
15872                 $distro = main::clean_characters($distro) if $distro;
15873         }
15874         # this handles case where only one release/version file was found, and it's lsb-release.
15875         # This would never apply for ubuntu or debian, which will filter down to the following
15876         # conditions. In general if there's a specific distro release file available, that's to
15877         # be preferred, but this is a good backup.
15878         elsif ($distro_file && $b_lsb && ($distro_file =~ /\/etc\/($lsb_good_s)$/ || $distro_file eq $lsb_release) ){
15879                 $distro = get_lsb_release();
15880         }
15881         elsif ($distro_file && $distro_file eq $os_release){
15882                 $distro = get_os_release();
15883                 $b_osr = 1;
15884         }
15885         # if distro id file was found and it's not in the exluded primary distro file list, read it
15886         elsif ( $distro_file && -s $distro_file && $distro_file !~ /\/etc\/($exclude_s)$/){
15887                 # new opensuse uses os-release, but older ones may have a similar syntax, so just use
15888                 # the first line
15889                 if ($distro_file eq '/etc/SuSE-release'){
15890                         # leaving off extra data since all new suse have it, in os-release, this file has
15891                         # line breaks, like os-release  but in case we  want it, it's:
15892                         # CODENAME = Mantis  | VERSION = 12.2
15893                         # for now, just take first occurrence, which should be the first line, which does
15894                         # not use a variable type format
15895                         @working = main::reader($distro_file);
15896                         $distro = main::awk(\@working,'suse');
15897                 }
15898                 else {
15899                         $distro = (main::reader($distro_file))[0];
15900                 }
15901                 $distro = main::clean_characters($distro) if $distro;
15902         }
15903         # otherwise try  the default debian/ubuntu /etc/issue file
15904         elsif ($b_issue){
15905                 if ( !$distro_id && $etc_issue && $lc_issue =~ /(mint|lmde)/ ){
15906                         $distro_id = $1;
15907                         $b_use_issue = 1;
15908                 }
15909                 # os-release/lsb gives more manageable and accurate output than issue,
15910                 # but mint should use issue for now. Antergos uses arch os-release, but issue shows them
15911                 if (!$b_use_issue && @osr){
15912                         $distro = get_os_release();
15913                         $b_osr = 1;
15914                 }
15915                 elsif (!$b_use_issue && $b_lsb){
15916                         $distro = get_lsb_release();
15917                 }
15918                 elsif ($etc_issue) {
15919                         $distro =  $etc_issue;
15920                         # this handles an arch bug where /etc/arch-release is empty and /etc/issue
15921                         # is corrupted only older arch installs that have not been updated should
15922                         # have this fallback required, new ones use os-release
15923                         if ( $distro =~ /arch linux/i){
15924                                 $distro = 'Arch Linux';
15925                         }
15926                 }
15927         }
15928         # a final check. If a long value, before assigning the debugger output, if os-release
15929         # exists then let's use that if it wasn't tried already. Maybe that will be better.
15930         # not handling the corrupt data, maybe later if needed. 10 + distro: (8) + string
15931         if ($distro && length($distro) > 60 ){
15932                 if (!$b_osr && @osr){
15933                         $distro = get_os_release();
15934                         $b_osr = 1;
15935                 }
15936         }
15937         # test for /etc/lsb-release as a backup in case of failure, in cases
15938         # where > one version/release file were found but the above resulted
15939         # in null distro value.
15940         if (!$distro){
15941                 if (!$b_osr && @osr){
15942                         $distro = get_os_release();
15943                         $b_osr = 1;
15944                 }
15945                 elsif ($b_lsb){
15946                         $distro = get_lsb_release();
15947                 }
15948         }
15949         # now some final null tries
15950         if (!$distro ){
15951                 # if the file was null but present, which can happen in some cases, then use
15952                 # the file name itself to set the distro value. Why say unknown if we have
15953                 # a pretty good idea, after all?
15954                 if ($distro_file){
15955                         $distro_file =~ s/\/etc\/|[-_]|release|version//g;
15956                         $distro = $distro_file;
15957                 }
15958         }
15959         if ($extra > 0){
15960                 my $base_default = 'antix-version|mx-version'; # osr has base ids
15961                 my $base_issue = 'bunsen'; # base only found in issue
15962                 my $base_manual = 'kali'; # synthesize, no direct data available
15963                 my $base_osr = 'aptosid|grml|siduction'; # osr base, distro id in list of distro files
15964                 my $base_osr_issue = 'grml|linux lite'; # osr base, distro id in issue
15965                 my $base_upstream_lsb = '/etc/upstream-release/lsb-release';
15966                 my $base_upstream_osr = '/etc/upstream-release/os-release';
15967                 # first: try, some distros have upstream-release, elementary, new mint
15968                 # and anyone else who uses this method for fallback ID
15969                 if ( -r $base_upstream_osr){
15970                         my @osr_working = main::reader($base_upstream_osr);
15971                         if ( @osr_working){
15972                                 my (@osr_temp);
15973                                 @osr_temp = @osr;
15974                                 @osr = @osr_working;
15975                                 $system_base = get_os_release();
15976                                 @osr = @osr_temp if !$system_base;
15977                                 (@osr_temp,@osr_working) = (undef,undef);
15978                         }
15979                 }
15980                 elsif ( -r $base_upstream_lsb){
15981                         $system_base = get_lsb_release($base_upstream_lsb);
15982                 }
15983                 if (!$system_base && @osr){
15984                         my ($base_type) = ('');
15985                         if ($etc_issue && (grep {/($base_issue)/i} @osr)){
15986                                 $system_base = $etc_issue;
15987                         }
15988                         # more tests added here for other ubuntu derived distros
15989                         elsif ( @distro_files && (grep {/($base_default)/} @distro_files) ){
15990                                 $base_type = 'default';
15991                         }
15992                         elsif ($distro_id && $distro_id =~ /(mint)/){
15993                                 $base_type = 'ubuntu';
15994                         }
15995                         elsif ( ( ($distro_id && $distro_id =~ /($base_osr_issue)/ ) ||
15996                               (@distro_files && (grep {/($base_osr)/} @distro_files)) ) &&
15997                               !(grep {/($base_osr)/i} @osr)){
15998                                 $system_base = get_os_release();
15999                         }
16000                         if (!$system_base && $base_type){
16001                                 $system_base = get_os_release($base_type);
16002                         }
16003                 }
16004                 if (!$system_base && $lc_issue && $lc_issue =~ /($base_manual)/){
16005                         my $id = $1;
16006                         my %manual = (
16007                         'kali' => 'Debian testing',
16008                         );
16009                         $system_base = $manual{$id};
16010                 }
16011         }
16012         $distro =~ s/Debian/Armbian/ if ($distro && $distro_id eq 'armbian');
16013         ## finally, if all else has failed, give up
16014         $distro ||= 'unknown';
16015         @distro_data = ($distro,$system_base);
16016         eval $end if $b_log;
16017 }
16018
16019 sub get_lsb_release {
16020         eval $start if $b_log;
16021         my ($lsb_file) = @_;
16022         $lsb_file ||= '/etc/lsb-release';
16023         my ($distro,$id,$release,$codename,$description) = ('','','','','');
16024         my @content = main::reader($lsb_file);
16025         main::log_data('dump','@content',\@content) if $b_log;
16026         @content = map {s/,|\*|\\||\"|[:\47]|^\s+|\s+$|n\/a//ig; $_} @content if @content;
16027         foreach (@content){
16028                 next if /^\s*$/;
16029                 my @working = split /\s*=\s*/, $_;
16030                 next if !$working[0];
16031                 if ($working[0] eq 'DISTRIB_ID' && $working[1]){
16032                         if ($working[1] =~ /^Manjaro/i){
16033                                 $id = 'Manjaro Linux';
16034                         }
16035                         # in the old days, arch used lsb_release
16036 #                       elsif ($working[1] =~ /^Arch$/i){
16037 #                               $id = 'Arch Linux';
16038 #                       }
16039                         else {
16040                                 $id = $working[1];
16041                         }
16042                 }
16043                 elsif ($working[0] eq 'DISTRIB_RELEASE' && $working[1]){
16044                         $release = $working[1];
16045                 }
16046                 elsif ($working[0] eq 'DISTRIB_CODENAME' && $working[1]){
16047                         $codename = $working[1];
16048                 }
16049                 # sometimes some distros cannot do their lsb-release files correctly,
16050                 # so here is one last chance to get it right.
16051                 elsif ($working[0] eq 'DISTRIB_DESCRIPTION' && $working[1]){
16052                         $description = $working[1];
16053                 }
16054         }
16055         if (!$id && !$release && !$codename && $description){
16056                 $distro = $description;
16057         }
16058         else {
16059                 $distro = "$id $release $codename";
16060                 $distro =~ s/^\s+|\s\s+|\s+$//g; # get rid of double and trailing spaces
16061         }
16062         eval $end if $b_log;
16063         return $distro;
16064 }
16065 sub get_os_release {
16066         eval $start if $b_log;
16067         my ($base_type) = @_;
16068         my ($base_id,$base_name,$base_version,$distro,$distro_name,$pretty_name,
16069         $lc_name,$name,$version_name,$version_id) = ('','','','','','','','','','');
16070         my @content = @osr;
16071         main::log_data('dump','@content',\@content) if $b_log;
16072         @content = map {s/\\||\"|[:\47]|^\s+|\s+$|n\/a//ig; $_} @content if @content;
16073         foreach (@content){
16074                 next if /^\s*$/;
16075                 my @working = split /\s*=\s*/, $_;
16076                 next if !$working[0];
16077                 if ($working[0] eq 'PRETTY_NAME' && $working[1]){
16078                         $pretty_name = $working[1];
16079                 }
16080                 elsif ($working[0] eq 'NAME' && $working[1]){
16081                         $name = $working[1];
16082                         $lc_name = lc($name);
16083                 }
16084                 elsif ($working[0] eq 'VERSION' && $working[1]){
16085                         $version_name = $working[1];
16086                         $version_name =~ s/,//g;
16087                 }
16088                 elsif ($working[0] eq 'VERSION_ID' && $working[1]){
16089                         $version_id = $working[1];
16090                 }
16091                 # for mint system base
16092                 if ($base_type ){
16093                         if ($working[0] eq 'ID_LIKE' && $working[1]){
16094                                 if ($base_type eq 'ubuntu'){
16095                                         $working[1] =~ s/ubuntu\sdebian/ubuntu/;
16096                                         $working[1] = 'ubuntu' if $working[1] eq 'debian';
16097                                 }
16098                                 $base_name = ucfirst($working[1]);
16099                         }
16100                         elsif ($base_type eq 'ubuntu' && $working[0] eq 'UBUNTU_CODENAME' && $working[1]){
16101                                 $base_version = ucfirst($working[1]);
16102                         }
16103                 }
16104         }
16105         # NOTE: tumbleweed has pretty name but pretty name does not have version id
16106         # arco shows only the release name, like kirk, in pretty name. Too many distros
16107         # are doing pretty name wrong, and just putting in the NAME value there
16108         if (!$base_type){
16109                 if ($name && $version_name){
16110                         $distro = $name;
16111                         $distro = 'Arco Linux' if $lc_name =~ /^arco/;
16112                         if ($version_id && $version_name !~ /$version_id/){
16113                                 $distro .= ' ' . $version_id;
16114                         }
16115                         $distro .= " $version_name";
16116                 }
16117                 elsif ($pretty_name && ($pretty_name !~ /tumbleweed/i && $lc_name ne 'arcolinux') ){
16118                         $distro = $pretty_name;
16119                 }
16120                 elsif ($name){
16121                         $distro = $name;
16122                         if ($version_id){
16123                                 $distro .= ' ' . $version_id;
16124                         }
16125                 }
16126         }
16127         # note: mint has varying formats here, some have ubuntu as name, 17 and earlier
16128         else {
16129                 # mint 17 used ubuntu os-release,  so won't have $base_version
16130                 if ($base_name && $base_version){
16131                         $base_id = ubuntu_id($base_version) if $base_type eq 'ubuntu' && $base_version;
16132                         $base_id = '' if $base_id && "$base_name$base_version" =~ /$base_id/;
16133                         $base_id .= ' ' if $base_id;
16134                         $distro = "$base_name $base_id$base_version";
16135                 }
16136                 elsif ($base_type eq 'default' && ($pretty_name || ($name && $version_name) ) ){
16137                         $distro = ($name && $version_name) ? "$name $version_name" : $pretty_name;
16138                 }
16139                 # LMDE has only limited data in os-release, no _LIKE values
16140                 elsif ( $base_type eq 'ubuntu' && $lc_name =~ /^(debian|ubuntu)/ && ($pretty_name || ($name && $version_name))){
16141                         $distro = ($name && $version_name) ? "$name $version_name": $pretty_name;
16142                 }
16143         }
16144         eval $end if $b_log;
16145         return $distro;
16146 }
16147 # note, these are only for matching derived names, no need to go
16148 # all the way back here, update as new names are known. This is because
16149 # Mint is using UBUNTU_CODENAME without ID data.
16150 sub ubuntu_id {
16151         eval $start if $b_log;
16152         my ($codename) = @_;
16153         $codename = lc($codename);
16154         my ($id) = ('');
16155         my %codenames = (
16156         'cosmic' => '18.10',
16157         'bionic' => '18.04 LTS',
16158         'artful' => '17.10',
16159         'zesty' => '17.04',
16160         'yakkety' => '16.10',
16161         'xenial' => '16.04 LTS',
16162         'wily' => '15.10',
16163         'vivid' => '15.04',
16164         'utopic' => '14.10',
16165         'trusty' => '14.04 LTS ',
16166         'saucy' => '13.10',
16167         'raring' => '13.04',
16168         'quantal' => '12.10',
16169         'precise' => '12.04 LTS ',
16170         );
16171         $id = $codenames{$codename} if defined $codenames{$codename};
16172         eval $end if $b_log;
16173         return $id;
16174 }
16175 }
16176 sub get_gcc_data {
16177         eval $start if $b_log;
16178         my ($gcc,@data,@gccs,@temp);
16179         # NOTE: We can't use program_version because we don't yet know where
16180         # the version number is
16181         if (my $program = check_program('gcc') ){
16182                 @data = grabber("$program --version 2>/dev/null");
16183                 $gcc = awk(\@data,'^gcc');
16184         }
16185         if ($gcc){
16186                 # strip out: gcc (Debian 6.3.0-18) 6.3.0 20170516
16187                 # gcc (GCC) 4.2.2 20070831 prerelease [FreeBSD]
16188                 $gcc =~ s/\([^\)]*\)//g;
16189                 $gcc = get_piece($gcc,2);
16190         }
16191         if ($extra > 1){
16192                 # glob /usr/bin for gccs, strip out all non numeric values
16193                 @temp = globber('/usr/bin/gcc-*');
16194                 foreach (@temp){
16195                         if (/\/gcc-([0-9.]+)$/){
16196                                 push @gccs, $1;
16197                         }
16198                 }
16199         }
16200         unshift @gccs, $gcc;
16201         log_data('dump','@gccs',\@gccs) if $b_log;
16202         eval $end if $b_log;
16203         return @gccs;
16204 }
16205 # rasberry pi only
16206 sub get_gpu_ram_arm {
16207         eval $start if $b_log;
16208         my ($gpu_ram) = (0);
16209         if (my $program = check_program('vcgencmd')){
16210                 # gpu=128M
16211                 # "VCHI initialization failed" - you need to add video group to your user
16212                 my $working = (grabber("$program get_mem gpu 2>/dev/null"))[0];
16213                 $working = (split /\s*=\s*/, $working)[1] if $working;
16214                 $gpu_ram = translate_size($working) if $working;
16215         }
16216         log_data('data',"gpu ram: $gpu_ram") if $b_log;
16217         eval $end if $b_log;
16218         return $gpu_ram;
16219 }
16220 # standard systems
16221 sub get_gpu_ram {
16222         eval $start if $b_log;
16223         my ($gpu_ram) = (0);
16224         eval $end if $b_log;
16225         return $gpu_ram;
16226 }
16227
16228 sub get_hostname {
16229         eval $start if $b_log;
16230         my $hostname = '';
16231         if ( $ENV{'HOSTNAME'} ){
16232                 $hostname = $ENV{'HOSTNAME'};
16233         }
16234         elsif ( !$bsd_type && -f "/proc/sys/kernel/hostname" ){
16235                 $hostname = (reader('/proc/sys/kernel/hostname'))[0];
16236         }
16237         # puppy removed this from core modules, sigh
16238         # this is faster than subshell of hostname
16239         elsif (check_module('Sys::Hostname')){
16240                 import Sys::Hostname;
16241                 $hostname = Sys::Hostname::hostname();
16242         }
16243         elsif (my $program = check_program('hostname')) {
16244                 $hostname = (grabber("$program 2>/dev/null"))[0];
16245         }
16246         $hostname ||= 'N/A';
16247         eval $end if $b_log;
16248         return $hostname;
16249 }
16250
16251 sub get_init_data {
16252         eval $start if $b_log;
16253         my $runlevel = get_runlevel_data();
16254         my $default = ($extra > 1) ? get_runlevel_default() : '';
16255         my ($init,$init_version,$rc,$rc_version,$program) = ('','','','','');
16256         my $comm = ( -e '/proc/1/comm' ) ? (reader('/proc/1/comm'))[0] : '';
16257         my (@data);
16258         # this test is pretty solid, if pid 1 is owned by systemd, it is systemd
16259         # otherwise that is 'init', which covers the rest of the init systems.
16260         # more data may be needed for other init systems.
16261         if ( $comm ){
16262                 if ( $comm =~ /systemd/ ){
16263                         $init = 'systemd';
16264                         if ( $program = check_program('systemd')){
16265                                 $init_version = program_version($program,'^systemd','2','--version');
16266                         }
16267                         if (!$init_version && ($program = check_program('systemctl') ) ){
16268                                 $init_version = program_version($program,'^systemd','2','--version');
16269                         }
16270                 }
16271                 # epoch version == Epoch Init System 1.0.1 "Sage"
16272                 elsif ($comm =~ /epoch/){
16273                         $init = 'Epoch';
16274                         $init_version = program_version('epoch', '^Epoch', '4','version');
16275                 }
16276                 # missing data: note, runit can install as a dependency without being the
16277                 # init system: http://smarden.org/runit/sv.8.html
16278                 # NOTE: the proc test won't work on bsds, so if runit is used on bsds we
16279                 # will need more data
16280                 elsif ($comm =~ /runit/){
16281                         $init = 'runit';
16282                 }
16283         }
16284         if (!$init){
16285                 # output: /sbin/init --version:  init (upstart 1.1)
16286                 # init (upstart 0.6.3)
16287                 if ($init_version = program_version('init', 'upstart', '3','--version')){
16288                         $init = 'Upstart';
16289                 }
16290                 elsif (check_program('launchctl')){
16291                         $init = 'launchd';
16292                 }
16293                 elsif ( -f '/etc/inittab' ){
16294                         $init = 'SysVinit';
16295                         if (check_program('strings')){
16296                                 @data = grabber('strings /sbin/init');
16297                                 $init_version = awk(\@data,'version\s+[0-9]');
16298                                 $init_version = get_piece($init_version,2) if $init_version;
16299                         }
16300                 }
16301                 elsif ( -f '/etc/ttys' ){
16302                         $init = 'init (BSD)';
16303                 }
16304         }
16305         if ( grep { /openrc/ } globber('/run/*openrc*') ){
16306                 $rc = 'OpenRC';
16307                 # /sbin/openrc --version == openrc (OpenRC) 0.13
16308                 if ($program = check_program('openrc')){
16309                         $rc_version = program_version($program, '^openrc', '3','--version');
16310                 }
16311                 # /sbin/rc --version == rc (OpenRC) 0.11.8 (Gentoo Linux)
16312                 elsif ($program = check_program('rc')){
16313                         $rc_version = program_version($program, '^rc', '3','--version');
16314                 }
16315                 if ( -e '/run/openrc/softlevel' ){
16316                         $runlevel = (reader('/run/openrc/softlevel'))[0];
16317                 }
16318                 elsif ( -e '/var/run/openrc/softlevel'){
16319                         $runlevel = (reader('/var/run/openrc/softlevel'))[0];
16320                 }
16321                 elsif ( $program = check_program('rc-status')){
16322                         $runlevel = (grabber("$program -r 2>/dev/null"))[0];
16323                 }
16324         }
16325         my %init = (
16326         'init-type' => $init,
16327         'init-version' => $init_version,
16328         'rc-type' => $rc,
16329         'rc-version' => $rc_version,
16330         'runlevel' => $runlevel,
16331         'default' => $default,
16332         );
16333         eval $end if $b_log;
16334         return %init;
16335 }
16336
16337 sub get_kernel_data {
16338         eval $start if $b_log;
16339         my ($kernel,$ksplice) = ('','');
16340         # Linux; yawn; 4.9.0-3.1-liquorix-686-pae; #1 ZEN SMP PREEMPT liquorix 4.9-4 (2017-01-14); i686
16341         # FreeBSD; siwi.pair.com; 8.2-STABLE; FreeBSD 8.2-STABLE #0: Tue May 31 14:36:14 EDT 2016     erik5@iddhi.pair.com:/usr/obj/usr/src/sys/82PAIRx-AMD64; amd64
16342         if (@uname){
16343                 $kernel = $uname[2];
16344                 if (check_program('uptrack-uname') && $kernel){
16345                         $ksplice = qx(uptrack-uname -rm);
16346                         $ksplice = trimmer($ksplice);
16347                         $kernel = ($ksplice) ? $ksplice . ' (ksplice)' : $kernel;
16348                 }
16349                 $kernel .= ' ' . $uname[-1];
16350                 $kernel = ($bsd_type) ? $uname[0] . ' ' . $kernel : $kernel;
16351         }
16352         $kernel ||= 'N/A';
16353         log_data('data',"kernel: $kernel ksplice: $ksplice") if $b_log;
16354         eval $end if $b_log;
16355         return $kernel;
16356 }
16357
16358 sub get_kernel_bits {
16359         eval $start if $b_log;
16360         my $bits = '';
16361         if (@uname){
16362                 $bits = $uname[-1];
16363                 $bits = ($bits =~ /64/ ) ? 64 : 32;
16364         }
16365         $bits ||= 'N/A';
16366         eval $end if $b_log;
16367         return $bits;
16368 }
16369
16370 sub get_memory_data {
16371         eval $start if $b_log;
16372         my ($type) = @_;
16373         my ($memory);
16374         if (my $file = system_files('meminfo') ) {
16375                 $memory = get_memory_data_linux($type,$file);
16376         }
16377         else {
16378                 $memory = get_memory_data_bsd($type);
16379         }
16380         eval $end if $b_log;
16381         return $memory;
16382 }
16383
16384 sub get_memory_data_linux {
16385         eval $start if $b_log;
16386         my ($type,$file) = @_;
16387         my ($gpu,$memory,$not_used,$total) = (0,'',0,0);
16388         my @data = reader($file);
16389         foreach (@data){
16390                 if ($_ =~ /^MemTotal:/){
16391                         $total = get_piece($_,2);
16392                 }
16393                 elsif ($_ =~ /^(MemFree|Buffers|Cached):/){
16394                         $not_used +=  get_piece($_,2);
16395                 }
16396         }
16397         $gpu = get_gpu_ram_arm() if $b_arm;
16398         #$gpu = translate_size('128M');
16399         $total += $gpu;
16400         my $used = $total - ($not_used);
16401         my $percent = ($used && $total) ? sprintf("%.1f", ($used/$total)*100) : '';
16402         if ($type eq 'string'){
16403                 $percent = " ($percent%)" if $percent;
16404                 $memory = sprintf("%.1f/%.1f MiB", $used/1024, $total/1024) . $percent;
16405         }
16406         else {
16407                 $memory = "$total:$used:$percent:$gpu";
16408         }
16409         log_data('data',"memory: $memory") if $b_log;
16410         eval $end if $b_log;
16411         return $memory;
16412 }
16413
16414 # openbsd/linux
16415 # procs    memory       page                    disks    traps          cpu
16416 # r b w    avm     fre  flt  re  pi  po  fr  sr wd0 wd1  int   sys   cs us sy id
16417 # 0 0 0  55256 1484092  171   0   0   0   0   0   2   0   12   460   39  3  1 96
16418 # freebsd:
16419 # procs      memory      page                    disks     faults         cpu
16420 # r b w     avm    fre   flt  re  pi  po    fr  sr ad0 ad1   in   sy   cs us sy id
16421 # 0 0 0  21880M  6444M   924  32  11   0   822 827   0   0  853  832  463  8  3 88
16422 # with -H
16423 # 2 0 0 14925812  936448    36  13  10   0    84  35   0   0   84   30   42 11  3 86
16424 # dragonfly
16425 #  procs      memory      page                    disks     faults      cpu
16426 #  r b w     avm    fre  flt  re  pi  po  fr  sr ad0 ad1   in   sy  cs us sy id
16427 #  0 0 0       0  84060 30273993 2845 12742 1164 407498171 320960902   0   0 ....
16428 sub get_memory_data_bsd {
16429         eval $start if $b_log;
16430         my ($type) = @_;
16431         my $memory = '';
16432         my ($avail,$total,$free_mem,$real_mem) = (0,0,0,0);
16433         my (@data,$message);
16434         my $arg = ($bsd_type ne 'openbsd') ? '-H' : '';
16435         if (my $program = check_program('vmstat')){
16436                 # see above, it's the last line. -H makes it hopefully all in kB so no need
16437                 # for K/M/G tests
16438                 my $row = (grabber("vmstat $arg 2>/dev/null",'\n','strip'))[-1];
16439                 if ( $row ){
16440                         @data = split /\s+/, $row;
16441                         # dragonfly can have 0 avg, but they may fix that so make test dynamic
16442                         if ($data[3] != 0){
16443                                 $avail = ($bsd_type ne 'openbsd') ? sprintf ('%.1f',$data[3]/1024) : $data[3];
16444                         }
16445                         elsif ($data[4] != 0){
16446                                 $free_mem = sprintf ('%.1f',$data[4]);
16447                         }
16448                 }
16449         }
16450         ## code to get total goes here:
16451         my $ref = $alerts{'sysctl'};
16452         if ($$ref{'action'} eq 'use'){
16453                 # for dragonfly, we will use free mem, not used because free is 0
16454                 my @working;
16455                 foreach (@sysctl){
16456                         # freebsd seems to use bytes here
16457                         if (!$real_mem && /^hw.physmem:/){
16458                                 @working = split /:\s*/,$_;
16459                                 #if ($working[1]){
16460                                         $working[1] =~ s/^[^0-9]+|[^0-9]+$//g;
16461                                         $real_mem = sprintf("%.1f", $working[1]/1024);
16462                                 #}
16463                                 last if $free_mem;
16464                         }
16465                         # But, it uses K here. Openbsd/Dragonfly do not seem to have this item
16466                         # this can be either: Free Memory OR Free Memory Pages
16467                         elsif (/^Free Memory:/){
16468                                 @working = split /:\s*/,$_;
16469                                 $working[1] =~ s/[^0-9]+//g;
16470                                 $free_mem = sprintf("%.1f", $working[1]);
16471                                 last if $real_mem;
16472                         }
16473                 }
16474         }
16475         else {
16476                 $message = "sysctl $$ref{'action'}"
16477         }
16478         # not using, but leave in place for a bit in case we want it
16479         # my $type = ($free_mem) ? ' free':'' ;
16480         # hack: temp fix for openbsd/darwin: in case no free mem was detected but we have physmem
16481         if (($avail || $free_mem) && !$real_mem){
16482                 my $error = ($message) ? $message: 'total N/A';
16483                 my $used = (!$free_mem) ? $avail : $real_mem - $free_mem;
16484                 if ($type eq 'string'){
16485                         $used = sprintf("%.1f",$used/1024);
16486                         $memory = "$used/($error) MB";
16487                 }
16488                 else {
16489                         $memory = "$error:$used:";
16490                 }
16491         }
16492         # use openbsd/dragonfly avail mem data if available
16493         elsif (($avail || $free_mem) && $real_mem) {
16494                 my $used = (!$free_mem) ? $avail : $real_mem - $free_mem;
16495                 my $percent = ($used && $real_mem) ? sprintf("%.1f", ($used/$real_mem)*100) : '';
16496                 if ($type eq 'string'){
16497                         $used = sprintf("%.1f",$used/1024);
16498                         $real_mem = sprintf("%.1f",$real_mem/1024);
16499                         $percent = " ($percent)" if $percent;
16500                         $memory = "$used/$real_mem MB" . $percent;
16501                 }
16502                 else {
16503                         $memory = "$real_mem:$used:$percent:0";
16504                 }
16505         }
16506         eval $end if $b_log;
16507         return $memory;
16508 }
16509
16510 sub get_module_version {
16511         eval $start if $b_log;
16512         my ($module) = @_;
16513         return if ! $module;
16514         my ($version);
16515         my $path = "/sys/module/$module/version";
16516         if (-f $path){
16517                 $version = (reader($path))[0];
16518         }
16519         elsif (-f "/sys/module/$module/uevent"){
16520                 $version = 'kernel';
16521         }
16522         #print "version:$version\n";
16523         if (!$version) {
16524                 if (my $path = check_program('modinfo')){
16525                         my @data = grabber("$path $module 2>/dev/null");
16526                         $version = awk(\@data,'^version',2,':\s+') if @data;
16527                 }
16528         }
16529         $version ||= '';
16530         eval $end if $b_log;
16531         return $version;
16532 }
16533
16534 # args: 1 - pci device string; 2 - pci cleaned subsystem string
16535 sub get_pci_vendor {
16536         eval $start if $b_log;
16537         my ($device, $subsystem) = @_;
16538         return if !$subsystem;
16539         my ($vendor,$sep) = ('','');
16540         my @data = split /\s+/, $subsystem;
16541         foreach (@data){
16542                 if ($device !~ !/\b$_\b/){
16543                         $vendor .= $sep . $_;
16544                         $sep = ' ';
16545                 }
16546                 else {
16547                         last;
16548                 }
16549         }
16550         eval $end if $b_log;
16551         return $vendor;
16552 }
16553
16554 # # check? /var/run/nologin for bsds?
16555 sub get_runlevel_data {
16556         eval $start if $b_log;
16557         my $runlevel = '';
16558         if ( my $program = check_program('runlevel')){
16559                 $runlevel = (grabber("$program 2>/dev/null"))[0];
16560                 $runlevel =~ s/[^\d]//g if $runlevel;
16561                 #print_line($runlevel . ";;");
16562         }
16563         eval $end if $b_log;
16564         return $runlevel;
16565 }
16566
16567 # note: it appears that at least as of 2014-01-13, /etc/inittab is going
16568 # to be used for default runlevel in upstart/sysvinit. systemd default is
16569 # not always set so check to see if it's linked.
16570 sub get_runlevel_default {
16571         eval $start if $b_log;
16572         my @data;
16573         my $default = '';
16574         my $b_systemd = 0;
16575         my $inittab = '/etc/inittab';
16576         my $systemd = '/etc/systemd/system/default.target';
16577         my $upstart = '/etc/init/rc-sysinit.conf';
16578         # note: systemd systems do not necessarily have this link created
16579         if ( -e $systemd){
16580                 $default = readlink($systemd);
16581                 $default =~ s/.*\/// if $default;
16582                 $b_systemd = 1;
16583         }
16584         # http://askubuntu.com/questions/86483/how-can-i-see-or-change-default-run-level
16585         # note that technically default can be changed at boot but for inxi purposes
16586         # that does not matter, we just want to know the system default
16587         elsif ( -e $upstart){
16588                 # env DEFAULT_RUNLEVEL=2
16589                 @data = reader($upstart);
16590                 $default = awk(\@data,'^env\s+DEFAULT_RUNLEVEL',2,'=');
16591         }
16592         # handle weird cases where null but inittab exists
16593         if (!$default && -e $inittab ){
16594                 @data = reader($inittab);
16595                 $default = awk(\@data,'^id.*initdefault',2,':');
16596         }
16597         eval $end if $b_log;
16598         return $default;
16599 }
16600
16601 sub get_self_version {
16602         eval $start if $b_log;
16603         my $patch = $self_patch;
16604         if ( $patch ne '' ){
16605                 # for cases where it was for example: 00-b1 clean to -b1
16606                 $patch =~ s/^[0]+-?//;
16607                 $patch = "-$patch" if $patch;
16608         }
16609         eval $end if $b_log;
16610         return $self_version . $patch;
16611 }
16612
16613 sub get_shell_data {
16614         eval $start if $b_log;
16615         my ($ppid) = @_;
16616         my $cmd = "ps -p $ppid -o comm= 2>/dev/null";
16617         my $shell = qx($cmd);
16618         log_data('cmd',$cmd) if $b_log;
16619         chomp($shell);
16620         if ($shell){
16621                 #print "shell pre: $shell\n";
16622                 # when run in debugger subshell, would return sh as shell,
16623                 # and parent as perl, that is, pinxi itself, which is actually right.
16624                 # trim leading /.../ off just in case. ps -p should return the name, not path
16625                 # but at least one user dataset suggests otherwise so just do it for all.
16626                 $shell =~ s/^.*\///;
16627                 my $working = $ENV{'SHELL'};
16628                 $working =~ s/^.*\///;
16629                 # NOTE: su -c "inxi -F" results in shell being su
16630                 if (($shell eq 'sh' || $shell eq 'sudo' || $shell eq 'su' ) && $shell ne $working){
16631                         $client{'su-start'} = $shell if ($shell eq 'sudo' || $shell eq 'su');
16632                         $shell = $working;
16633                 }
16634                 #print "shell post: $shell\n";
16635                 # sh because -v/--version doesn't work on it
16636                 if ( $shell ne 'sh' ) {
16637                         @app = main::program_values(lc($shell));
16638                         if ($app[0]){
16639                                 $client{'version'} = main::program_version($shell,$app[0],$app[1],$app[2],$app[5],$app[6]);
16640                         }
16641                         # guess that it's two and --version
16642                         else {
16643                                 # we're just guessing at the search phrase and position
16644                                 if ($shell){
16645                                         $client{'version'} = main::program_version($shell,$shell,2,'');
16646                                 }
16647                                 else {
16648                                         $client{'version'} = row_defaults('unknown-shell');
16649                                 }
16650                         }
16651                         $client{'version'} =~ s/(\(.*|-release|-version)//;
16652                 }
16653                 $client{'name'} = lc($shell);
16654                 $client{'name-print'} = $shell;
16655         }
16656         else {
16657                 $client{'name'} = 'shell';
16658                 $client{'name-print'} = 'Unknown Shell';
16659         }
16660         $client{'su-start'} = 'sudo' if (!$client{'su-start'} && $ENV{'SUDO_USER'});
16661         eval $end if $b_log;
16662 }
16663
16664 sub get_shell_source {
16665         eval $start if $b_log;
16666         my (@data);
16667         my ($msg,$self_parent,$shell_parent) = ('','','');
16668         my $ppid = getppid();
16669         $self_parent = get_start_parent($ppid);
16670         if ($b_log){
16671                 $msg = ($ppid) ? "self parent: $self_parent ppid: $ppid": "self parent: undefined";
16672                 log_data('data',$msg);
16673         }
16674         #print "self parent: $self_parent ppid: $ppid\n";
16675         if ($self_parent){
16676                 $shell_parent = get_shell_parent($self_parent);
16677                 $client{'su-start'} = $shell_parent if ($shell_parent eq 'su' && !$client{'su-start'});
16678                 #print "shell parent 1: $shell_parent\n";
16679                 if ($b_log){
16680                         $msg = ($shell_parent) ? "shell parent 1: $shell_parent": "shell parent 1: undefined";
16681                         log_data('data',$msg);
16682                 }
16683                 # in case sudo starts inxi, parent is shell (or perl inxi if run by debugger)
16684                 # so: perl (2) started pinxi with sudo (3) in sh (4) in terminal
16685                 for my $i (2..4){
16686                         if ( $shell_parent &&
16687                      $shell_parent =~ /^(bash|csh|dash|ksh|lksh|loksh|mksh|pdksh|perl|sh|su|sudo|tcsh|zsh)$/ ){
16688                                 # no idea why have to do script_parent action twice in su case, but you do.
16689                                 $self_parent = get_start_parent($self_parent);
16690                                 $shell_parent = get_shell_parent($self_parent);
16691                                 #print "shell parent 2: $shell_parent\n";
16692                                 if ($b_log){
16693                                         $msg = ($shell_parent) ? "shell parent $i: $shell_parent": "shell parent $i: undefined";
16694                                         log_data('data',$msg);
16695                                 }
16696                         }
16697                         else {
16698                                 last;
16699                         }
16700                 }
16701                 # to work around a ps -p or gnome-terminal bug, which returns
16702                 # gnome-terminal- trim - off end
16703                 $shell_parent =~ s/-$// if $shell_parent;
16704         }
16705         if ($b_log){
16706                 $self_parent ||= '';
16707                 $shell_parent ||= '';
16708                 log_data('data',"parents: self: $self_parent shell: $shell_parent");
16709         }
16710         eval $end if $b_log;
16711         return $shell_parent;
16712 }
16713
16714 # utilities for get_shell_source
16715 # arg: 1 - parent id
16716 sub get_start_parent {
16717         eval $start if $b_log;
16718         my ($parent) = @_;
16719         # ps -j -fp : bsds ps do not have -f for PPID, so we can't get the ppid
16720         my $cmd = "ps -j -fp $parent";
16721         log_data('cmd',$cmd) if $b_log;
16722         my @data = grabber($cmd);
16723         #shift @data if @data;
16724         my $self_parent = awk(\@data,"$parent",3,'\s+');
16725         eval $end if $b_log;
16726         return $self_parent;
16727 }
16728
16729 # arg: 1 - parent id
16730 sub get_shell_parent {
16731         eval $start if $b_log;
16732         my ($parent) = @_;
16733         my $cmd = "ps -j -p $parent";
16734         log_data('cmd',$cmd) if $b_log;
16735         my @data = grabber($cmd,'strip');
16736         #shift @data if @data;
16737         my $shell_parent = awk(\@data, "$parent",-1,'\s+');
16738         eval $end if $b_log;
16739         return $shell_parent;
16740 }
16741
16742 # this will test against default IP like: (:0) vs full IP to determine
16743 # ssh status. Surprisingly easy test? Cross platform
16744 sub get_ssh_status {
16745         eval $start if $b_log;
16746         my ($b_ssh,$ssh);
16747         # fred   pts/10       2018-03-24 16:20 (:0.0)
16748         # fred-remote pts/1        2018-03-27 17:13 (43.43.43.43)
16749         if (my $program = check_program('who')){
16750                 $ssh = (grabber("$program am i 2>/dev/null"))[0];
16751                 # crude IP validation
16752                 if ($ssh && $ssh =~ /\(([:0-9a-f]{8,}|[1-9][\.0-9]{6,})\)$/){
16753                         $b_ssh = 1;
16754                 }
16755         }
16756         eval $end if $b_log;
16757         return $b_ssh;
16758 }
16759
16760 sub get_tty_console_irc {
16761         eval $start if $b_log;
16762         my ($type) = @_;
16763         return $tty_session if defined $tty_session;
16764         if ( $type eq 'vtrn' && defined $ENV{'XDG_VTNR'} ){
16765                 $tty_session = $ENV{'XDG_VTNR'};
16766         }
16767         else {
16768                 my $ppid = getppid();
16769                 $tty_session = awk(\@ps_aux,".*$ppid.*$client{'name'}",7,'\s+');
16770                 $tty_session =~ s/^[^[0-9]+// if $tty_session;
16771         }
16772         $tty_session = '' if ! defined $tty_session;
16773         log_data('data',"conole-irc-tty:$tty_session") if $b_log;
16774         eval $end if $b_log;
16775         return $tty_session;
16776 }
16777
16778 sub get_tty_number {
16779         eval $start if $b_log;
16780         my ($tty);
16781         if ( defined $ENV{'XDG_VTNR'} ){
16782                 $tty = $ENV{'XDG_VTNR'};
16783         }
16784         else {
16785                 $tty = POSIX::ttyname(1);
16786                 #variants: /dev/pts/1 /dev/tty1 /dev/ttyp2 /dev/ttyra [hex number a]
16787                 $tty =~ s/.*\/[^0-9]*//g if defined $tty;
16788         }
16789         $tty = '' if ! defined $tty;
16790         log_data('data',"tty:$tty") if $b_log;
16791         eval $end if $b_log;
16792         return $tty;
16793 }
16794
16795 # 2:58PM  up 437 days,  8:18, 3 users, load averages: 2.03, 1.72, 1.77
16796 # 04:29:08 up  3:18,  3 users,  load average: 0,00, 0,00, 0,00
16797 # 10:23PM  up 5 days, 16:17, 1 user, load averages: 0.85, 0.90, 1.00
16798 # 05:36:47 up 1 day,  3:28,  4 users,  load average: 1,88, 0,98, 0,62
16799 # 05:36:47 up 1 day,  3 min,  4 users,  load average: 1,88, 0,98, 0,62
16800 sub get_uptime {
16801         eval $start if $b_log;
16802         my ($days,$hours,$minutes,$uptime) = ('','','','');
16803         if (check_program('uptime')){
16804                 $uptime = qx(uptime);
16805                 $uptime = trimmer($uptime);
16806                 #$uptime = '05:36:47 up 3 min,  4 users,  load average: 1,88, 0,98, 0,62';
16807                 if ($uptime &&
16808                  $uptime =~ /[\S]+\s+up\s+(([0-9]+)\s+day[s]?,\s+)?(([0-9]{1,2}):([0-9]{1,2})|([0-9]+)\smin[s]?),\s+[0-9]+\s+user/){
16809                         $days = $2 . 'd' if $2;
16810                         $days .= ' ' if ($days && ($4 || $6));
16811                         if ($4 && $5){
16812                                 $hours = $4 . 'h ';
16813                                 $minutes = $5 . 'm';
16814                         }
16815                         elsif ($6){
16816                                 $minutes = $6 . 'm';
16817
16818                         }
16819                         $uptime = $days . $hours . $minutes;
16820                 }
16821         }
16822         $uptime ||= 'N/A';
16823         eval $end if $b_log;
16824         return $uptime;
16825 }
16826
16827 # NOTE: annoyingly, /sys does NOT actually use the id, it uses
16828 # the count of physical devices, starting at 0 for hub, on the bus.
16829 # args: $1 - $bus number; $2 - vendor:chip id
16830 sub get_usb_drivers {
16831         eval $start if $b_log;
16832         my ($bus,$id) = @_;
16833         return if !$bus || !$id;# these will be > 0
16834         my ($chip,$driver,$file,$path,$vendor,$working,$working2,@drivers,@temp);
16835         @temp = split /:/, $id;
16836         $vendor = $temp[0];
16837         $chip = $temp[1];
16838         # some have it one level deeper than others
16839         my @globs = ("/sys/bus/usb/devices/usb$bus/$bus-*/","/sys/bus/usb/devices/usb$bus/$bus-*/$bus-*/");
16840         foreach (@globs){
16841                 $path = get_usb_path($vendor,$chip,$_);
16842                 last if $path;
16843         }
16844         if ($path){
16845                 if ( -e "${path}driver"){
16846                         if ($working = Cwd::abs_path("${path}driver")){
16847                                 $working =~ s/^.*\///;
16848                                 if ($working && $working ne 'usb' && $working ne 'usbhid'){
16849                                         push @drivers, $working;
16850                                 }
16851                         }
16852                 }
16853                 # test 2
16854                 @temp = main::globber("$path$bus-*/");
16855                 #print "@temp\n";
16856                 foreach (@temp){
16857                         #print "p2:". $_ . "driver\n";
16858                         $file = $_ . 'driver';
16859                         #print "f:$file\n";
16860                         if (-e $file){
16861                                 #print "here\n";
16862                                 #print (Cwd::abs_path($file), "\n");
16863                                 if ($working = Cwd::abs_path($file)){
16864                                         #print "w:$working\n";
16865                                         $working =~ s/^.*\///;
16866                                         if ($working && $working ne 'usb' && $working ne 'usbhid' && ! grep {/$working/} @drivers){
16867                                                 push @drivers, $working;
16868                                         }
16869                                 }
16870                         }
16871                 }
16872                 #print join "\n", @drivers, "\n";
16873                 $driver = join ',', @drivers if @drivers;
16874         }
16875         @temp = ($driver,$path);
16876         eval $end if $b_log;
16877         return @temp;
16878 }
16879
16880 sub get_usb_path {
16881         eval $start if $b_log;
16882         my ($vendor,$chip,$glob) = @_;
16883         my ($path,$working,$working2);
16884         #print "$vendor,$chip,$glob\n";
16885         my @temp = main::globber($glob);
16886         #print join "\n", @temp, "\n";
16887         # first we need to get the device path, since it's not predictable
16888         foreach (@temp){
16889                 #print "$_\n";
16890                 $working = $_ . 'idVendor';
16891                 $working2 = $_ . 'idProduct';
16892                 if (-e $working && (main::reader($working))[0] eq $vendor &&
16893                     -e $working2 && (main::reader($working2))[0] eq $chip){
16894                         $path = $_;
16895                         #print "$_\n";
16896                         last;
16897                 }
16898         }
16899         eval $end if $b_log;
16900         return $path
16901 }
16902
16903
16904 #### -------------------------------------------------------------------
16905 #### SET DATA VALUES
16906 #### -------------------------------------------------------------------
16907
16908 sub set_dmesg_boot_data {
16909         eval $start if $b_log;
16910         my ($file,@temp);
16911         my ($counter) = (0);
16912         $b_dmesg_boot_check = 1;
16913         if (!$b_fake_dboot){
16914                 $file = system_files('dmesg-boot');
16915         }
16916         else {
16917                 #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/dmesg-boot/bsd-disks-diabolus.txt";
16918                 #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/dmesg-boot/freebsd-disks-solestar.txt";
16919                 #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/dmesg-boot/freebsd-enceladus-1.txt";
16920                 ## matches: toshiba: openbsd-5.6-sysctl-2.txt
16921                 #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/dmesg-boot/openbsd-5.6-dmesg.boot-1.txt";
16922                 ## matches: compaq: openbsd-5.6-sysctl-1.txt"
16923                 $file = "$ENV{'HOME'}/bin/scripts/inxi/data/dmesg-boot/openbsd-dmesg.boot-1.txt";
16924         }
16925         if ($file){
16926                 return if ! -r $file;
16927                 @dmesg_boot = reader($file);
16928                 # some dmesg repeats, so we need to dump the second and > iterations
16929                 # replace all indented items with ~ so we can id them easily while
16930                 # processing note that if user, may get error of read permissions
16931                 # for some weird reason, real mem and avail mem are use a '=' separator,
16932                 # who knows why, the others are ':'
16933                 foreach (@dmesg_boot){
16934                         $counter++ if /^(OpenBSD|DragonFly|FreeBSD is a registered trademark)/;
16935                         last if $counter > 1;
16936                         $_ =~ s/\s*=\s*|:\s*/:/;
16937                         $_ =~ s/\"//g;
16938                         $_ =~ s/^\s+/~/;
16939                         $_ =~ s/\s\s/ /g;
16940                         $_ =~ s/^(\S+)\sat\s/$1:at /; # ada0 at ahcich0
16941                         push @temp, $_;
16942                         if (/^bios[0-9]:(at|vendor)/){
16943                                 push @sysctl_machine, $_;
16944                         }
16945                 }
16946                 @dmesg_boot = @temp;
16947                 # FreeBSD: 'da*' is a USB device 'ada*' is a SATA device 'mmcsd*' is an SD card
16948                 if ($b_dm_boot_disk && @dmesg_boot){
16949                         @dm_boot_disk = grep {/^(ad|ada|da|mmcblk|mmcsd|nvme[0-9]+n|sd|wd)[0-9]+(:|\sat\s)/} @dmesg_boot;
16950                         log_data('dump','@dm_boot_disk',\@dm_boot_disk) if $b_log;
16951                         print Dumper \@dm_boot_disk if $test[9];
16952                 }
16953                 if ($b_dm_boot_optical && @dmesg_boot){
16954                         @dm_boot_optical = grep {/^(cd)[0-9]+(\([^)]+\))?(:|\sat\s)/} @dmesg_boot;
16955                         log_data('dump','@dm_boot_optical',\@dm_boot_optical) if $b_log;
16956                         print Dumper \@dm_boot_optical if $test[9];
16957                 }
16958         }
16959         log_data('dump','@dmesg_boot',\@dmesg_boot) if $b_log;
16960         #print Dumper \@dmesg_boot if $test[9];
16961         eval $end if $b_log;
16962 }
16963
16964 # note, all actual tests have already been run in check_tools so if we
16965 # got here, we're good.
16966 sub set_dmi_data {
16967         eval $start if $b_log;
16968         if ($alerts{'dmidecode'}{'action'} eq 'use' ){
16969                 set_dmidecode_data();
16970         }
16971         eval $end if $b_log;
16972 }
16973
16974 sub set_dmidecode_data {
16975         eval $start if $b_log;
16976         my ($content,@data,@working,$type,$handle);
16977         #my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/dmidecode/pci-freebsd-8.2-2";
16978         #open my $fh, '<', $file or die "can't open $file: $!";
16979         #chomp(@data = <$fh>);
16980         my $path = check_program('dmidecode');
16981         $content = qx($path 2>/dev/null) if $path;
16982         @data = split /\n/, $content;
16983         # we don't need the opener lines of dmidecode output
16984         # but we do want to preserve the indentation. Empty lines
16985         # won't matter, they will be skipped, so no need to handle them.
16986         # some dmidecodes do not use empty line separators
16987         splice @data, 0, 5 if @data;
16988         my $j = 0;
16989         my $b_skip = 1;
16990         foreach (@data){
16991                 if (!/^Hand/){
16992                         next if $b_skip;
16993                         if (/^[^\s]/){
16994                                 $_ = lc($_);
16995                                 $_ =~ s/\s(information)//;
16996                                 push @working, $_;
16997                         }
16998                         elsif (/^\t/){
16999                                 $_ =~ s/^\t\t/~/;
17000                                 $_ =~ s/^\t|\s+$//g;
17001                                 push @working, $_;
17002                         }
17003                 }
17004                 elsif (/^Handle\s(0x[0-9A-Fa-f]+).*DMI\stype\s([0-9]+),.*/){
17005                         $j = scalar @dmi;
17006                         $handle = hex($1);
17007                         $type = $2;
17008                         $b_slot_tool = 1 if $type && $type == 9;
17009                         $b_skip = ( $type > 126 )? 1 : 0;
17010                         next if $b_skip;
17011                         # we don't need 32, system boot, or 127, end of table
17012                         if (@working){
17013                                 if ($working[0] != 32 && $working[0] < 127){
17014                                         $dmi[$j] = (
17015                                         [@working],
17016                                         );
17017                                 }
17018                         }
17019                         @working = ($type,$handle);
17020                 }
17021         }
17022         if (@working && $working[0] != 32 && $working[0] != 127){
17023                 $j = scalar @dmi;
17024                 $dmi[$j] = (
17025                 [@working],
17026                 );
17027         }
17028         # last by not least, sort it by dmi type, now we don't have to worry
17029         # about random dmi type ordering in the data, which happens. Also sort
17030         # by handle, as secondary sort.
17031         @dmi = sort { $a->[0] <=> $b->[0] || $a->[1] <=> $b->[1] } @dmi;
17032         main::log_data('dump','@dmi',\@dmi) if $b_log;
17033         print Dumper \@dmi if $test[2];
17034         eval $end if $b_log;
17035 }
17036
17037 sub set_ip_data {
17038         eval $start if $b_log;
17039         if ($alerts{'ip'}{'action'} eq 'use' ){
17040                 set_ip_addr();
17041         }
17042         elsif ($alerts{'ifconfig'}{'action'} eq 'use'){
17043                 set_ifconfig();
17044         }
17045         eval $end if $b_log;
17046 }
17047
17048 sub set_ip_addr {
17049         eval $start if $b_log;
17050         my $program = check_program('ip');
17051         my @data = grabber("$program addr 2>/dev/null",'\n','strip') if $program;
17052         #my @data = reader("$ENV{'HOME'}/bin/scripts/inxi/data/if/scope-ipaddr-1.txt",'strip') or die $!;
17053         my ($b_skip,$broadcast,$if,$ip,@ips,$scope,$if_id,$type,@temp,@temp2);
17054         foreach (@data){
17055                 if (/^[0-9]/){
17056                         #print "$_\n";
17057                         if (@ips){
17058                         #print "$if\n";
17059                                 @temp = ($if,[@ips]);
17060                                 @ifs = (@ifs,@temp);
17061                                 @ips = ();
17062                         }
17063                         @temp = split /:\s+/,$_;
17064                         $if = $temp[1];
17065                         if ($if eq 'lo'){
17066                                 $b_skip = 1;
17067                                 $if = '';
17068                                 next;
17069                         }
17070                         $b_skip = 0;
17071                         @temp = ();
17072                 }
17073                 elsif (!$b_skip && /^inet/){
17074                         #print "$_\n";
17075                         @temp = split /\s+/, $_;
17076                         ($broadcast,$ip,$scope,$if_id,$type) = ('','','','','');
17077                         $ip = $temp[1];
17078                         $type = ($temp[0] eq 'inet') ? 4 : 6 ;
17079                         if ($temp[2] eq 'brd'){
17080                                 $broadcast = $temp[3];
17081                         }
17082                         if (/scope\s([^\s]+)(\s(.+))?/){
17083                                 $scope = $1;
17084                                 $if_id = $3;
17085                         }
17086                         @temp = ($type,$ip,$broadcast,$scope,$if_id);
17087                         @ips = (@ips,[@temp]);
17088                         #print Dumper \@ips;
17089                 }
17090         }
17091         #print Dumper \@ips if $test[4];
17092         if (@ips){
17093                 @temp = ($if,[@ips]);
17094                 @ifs = (@ifs,@temp);
17095         }
17096         main::log_data('dump','@ifs',\@ifs) if $b_log;
17097         print Dumper \@ifs if $test[3];
17098         eval $end if $b_log;
17099 }
17100
17101 sub set_ifconfig {
17102         eval $start if $b_log;
17103         my $program = check_program('ifconfig'); # not in user path, sbin
17104         my @data = grabber("$program 2>/dev/null",'\n','') if $program;
17105         #my @data = reader("$ENV{'HOME'}/bin/scripts/inxi/data/if/vps-ifconfig-1.txt",'') or die $!;
17106         my ($b_skip,$broadcast,$if,@ips_bsd,$ip,@ips,$scope,$if_id,$type,@temp,@temp2);
17107         my ($state,$speed,$duplex,$mac);
17108         foreach (@data){
17109                 if (/^[\S]/i){
17110                         #print "$_\n";
17111                         if (@ips){
17112                         #print "here\n";
17113                                 @temp = ($if,[@ips]);
17114                                 @ifs = (@ifs,@temp);
17115                                 @ips = ();
17116                         }
17117                         if ($mac){
17118                                 @temp = ($if,[($state,$speed,$duplex,$mac)]);
17119                                 @ifs_bsd = (@ifs_bsd,@temp);
17120                                 ($state,$speed,$duplex,$mac,$if_id) = ('','','','','');
17121                         }
17122                         $if = (split /\s+/,$_)[0];
17123                         $if =~ s/:$//; # em0: flags=8843
17124                         $if_id = $if;
17125                         $if = (split /:/, $if)[0] if $if;
17126                         if ($if =~ /^lo/){
17127                                 $b_skip = 1;
17128                                 $if = '';
17129                                 $if_id = '';
17130                                 next;
17131                         }
17132                         $b_skip = 0;
17133                 }
17134                 # lladdr openbsd
17135                 elsif (!$b_skip && $bsd_type && /^\s+(ether|media|status|lladdr)/){
17136                         $_ =~ s/^\s+//;
17137                         # media: Ethernet 100baseTX <full-duplex> freebsd 7.3
17138                         # media: Ethernet autoselect (1000baseT <full-duplex>) Freebsd 8.2
17139                         #
17140                         if (/^media/){
17141                                 # openbsd: media: Ethernet autoselect (1000baseT full-duplex)
17142                                 if ($bsd_type && $bsd_type eq 'openbsd'){
17143                                         $_ =~ /\s\([\S]+\s([\S]+)\)/;
17144                                         $duplex = $1;
17145                                 }
17146                                 else {
17147                                         $_ =~ /<([^>]+)>/;
17148                                         $duplex = $1;
17149                                 }
17150                                 $_ =~ /\s\(([1-9][\S]+\s)/;
17151                                 $speed = $1;
17152                                 $speed =~ s/\s+$// if $speed;
17153                         }
17154                         elsif (!$mac && /^ether|lladdr/){
17155                                 $mac = (split /\s+/, $_)[1];
17156                         }
17157                         elsif (/^status/){
17158                                 $state = (split /\s+/, $_)[1];
17159                         }
17160                 }
17161                 elsif (!$b_skip && /^\s+inet/){
17162                         #print "$_\n";
17163                         $_ =~ s/^\s+//;
17164                         $_ =~ s/addr:\s/addr:/;
17165                         @temp = split /\s+/, $_;
17166                         ($broadcast,$ip,$scope,$type) = ('','','','');
17167                         $ip = $temp[1];
17168                         # fe80::225:90ff:fe13:77ce%em0
17169 #                       $ip =~ s/^addr:|%([\S]+)//;
17170                         if ($1 && $1 ne $if_id){
17171                                 $if_id = $1;
17172                         }
17173                         $type = ($temp[0] eq 'inet') ? 4 : 6 ;
17174                         if (/(Bcast:|broadcast\s)([\S]+)/){
17175                                 $broadcast = $2;
17176                         }
17177                         if (/(scopeid\s[^<]+<|Scope:|scopeid\s)([^>]+)[>]?/){
17178                                 $scope = $2;
17179                         }
17180                         $scope = 'link' if $ip =~ /^fe80/;
17181                         @temp = ($type,$ip,$broadcast,$scope,$if_id);
17182                         @ips = (@ips,[@temp]);
17183                         #print Dumper \@ips;
17184                 }
17185         }
17186         if (@ips){
17187                 @temp = ($if,[@ips]);
17188                 @ifs = (@ifs,@temp);
17189         }
17190         if ($mac){
17191                 @temp = ($if,[($state,$speed,$duplex,$mac)]);
17192                 @ifs_bsd = (@ifs_bsd,@temp);
17193                 ($state,$speed,$duplex,$mac) = ('','','','');
17194         }
17195         print Dumper \@ifs if $test[3];
17196         print Dumper \@ifs_bsd if $test[3];
17197         main::log_data('dump','@ifs',\@ifs) if $b_log;
17198         main::log_data('dump','@ifs_bsd',\@ifs_bsd) if $b_log;
17199         eval $end if $b_log;
17200 }
17201
17202 sub set_pci_data {
17203         eval $start if $b_log;
17204         if ( $b_pci ){
17205                 if (!$bsd_type){
17206                         if ($alerts{'lspci'}{'action'} eq 'use' ){
17207                                 set_lspci_data();
17208                         }
17209                         # ! -d '/proc/bus/pci'
17210                         # this is sketchy, a sbc won't have pci, but a non sbc arm may have it, so
17211                         # build up both and see what happens
17212                         if ($b_arm || $b_mips){
17213                                 set_soc_data();
17214                         }
17215                 }
17216                 else {
17217                         #if (1 == 1){
17218                         if ($alerts{'pciconf'}{'action'} eq 'use'){
17219                                 set_pciconf_data();
17220                         }
17221                 }
17222         }
17223         eval $end if $b_log;
17224 }
17225
17226 # 0 type
17227 # 1 type_id
17228 # 2 bus_id
17229 # 3 sub_id
17230 # 4 device
17231 # 5 vendor_id
17232 # 6 chip_id
17233 # 7 rev
17234 # 8 port
17235 # 9 driver
17236 # 10 modules
17237 # 11 driver_nu [bsd, like: em0 - driver em; nu 0. Used to match IF in -n
17238 # 12 subsystem/vendor
17239 # 13 subsystem vendor:chip id
17240 sub set_lspci_data {
17241         eval $start if $b_log;
17242         my ($busid,$busid_nu,$content,$port,$driver,$modules,$device,$vendor_id,$chip_id,$rev,
17243         $subsystem,$subsystem_id,$type,$type_id,@pcis,@temp,@working);
17244         # my @pcis = grabber('lspci -nnv','\n','strip');
17245         my $path = check_program('lspci');
17246         $content = qx($path -nnv 2>/dev/null) if $path;
17247         @pcis = split /\n/, $content if $content;
17248         #my $file = "$ENV{HOME}/bin/scripts/inxi/data/lspci/racermach-1-knnv.txt";
17249         #my $file = "$ENV{HOME}/bin/scripts/inxi/data/lspci/rk016013-knnv.txt";
17250         #@pcis = reader($file);
17251         #print scalar @pcis;
17252         @pcis = map {$_ =~ s/^\s+//; $_} @pcis if @pcis;
17253         $b_pci_tool = 1 if @pcis && scalar @pcis > 10;
17254         foreach (@pcis){
17255                 #print "$_\n";
17256                 if ($device){
17257                         if ($_ =~ /^\s*$/) {
17258                                 @temp = ($type,$type_id,$busid,$busid_nu,$device,$vendor_id,$chip_id,
17259                                 $rev,$port,$driver,$modules,$subsystem,$subsystem_id);
17260                                 @pci = (@pci,[@temp]);
17261                                 $device = '';
17262                                 #print "$busid $device_id r:$rev p: $port\n$type\n$device\n";
17263                         }
17264                         elsif ($_ =~ /^Subsystem.*\[([a-f0-9]{4}:[a-f0-9]{4})\]/){
17265                                 $subsystem_id = $1;
17266                                 $subsystem = (split /^Subsystem:\s*/,$_)[1];
17267                                 $subsystem =~ s/(\s?\[[^\]]+\])+$//g;
17268                                 $subsystem = cleaner($subsystem);
17269                                 $subsystem = pci_cleaner($subsystem,'pci');
17270                                 $subsystem = pci_cleaner_subsystem($subsystem);
17271                                 #print "ss:$subsystem\n";
17272                         }
17273                         elsif ($_ =~ /^I\/O\sports/){
17274                                 $port = (split /\s+/,$_)[3];
17275                                 #print "p:$port\n";
17276                         }
17277                         elsif ($_ =~ /^Kernel\sdriver\sin\suse/){
17278                                 $driver = (split /:\s*/,$_)[1];
17279                         }
17280                         elsif ($_ =~ /^Kernel\smodules/i){
17281                                 $modules = (split /:\s*/,$_)[1];
17282                         }
17283                 }
17284                 # note: arm servers can have more complicated patterns
17285                 # 0002:01:02.0 Ethernet controller [0200]: Cavium, Inc. THUNDERX Network Interface Controller virtual function [177d:a034] (rev 08)
17286                 elsif ($_ =~ /^(([0-9a-f]{2,4}:)?[0-9a-f]{2}:[0-9a-f]{2})[.:]([0-9a-f]+)\s(.*)\s\[([0-9a-f]{4}):([0-9a-f]{4})\](\s\(rev\s([^\)]+)\))?/){
17287                         $busid = $1;
17288                         $busid_nu = hex($3);
17289                         @working = split /:\s+/, $4;
17290                         $device = $working[1];
17291                         $type = $working[0];
17292                         $vendor_id = $5;
17293                         $chip_id = $6;
17294                         $rev = ($8)? $8 : '';
17295                         $device = cleaner($device);
17296                         $working[0] =~ /\[([^\]]+)\]$/;
17297                         $type_id = $1;
17298                         $b_hardware_raid = 1 if $type_id eq '0104';
17299                         $type = lc($type);
17300                         $type = pci_cleaner($type,'pci');
17301                         $type =~ s/\s+$//;
17302                         $port = '';
17303                         $driver = '';
17304                         $modules = '';
17305                         $subsystem = '';
17306                         $subsystem_id = '';
17307                 }
17308         }
17309         if ($device && $busid){
17310                 @temp = ($type,$type_id,$busid,$busid_nu,$device,$vendor_id,$chip_id,
17311                 $rev,$port,$driver,$modules,$subsystem,$subsystem_id);
17312                 @pci = (@pci,[@temp]);
17313                 $device = '';
17314         }
17315         print Dumper \@pci if $test[4];
17316         main::log_data('dump','@pci',\@pci) if $b_log;
17317         eval $end if $b_log;
17318 }
17319
17320 # em0@pci0:6:0:0:       class=0x020000 card=0x10d315d9 chip=0x10d38086 rev=0x00 hdr=0x00
17321 #     vendor     = 'Intel Corporation'
17322 #     device     = 'Intel 82574L Gigabit Ethernet Controller (82574L)'
17323 #     class      = network
17324 #     subclass   = ethernet
17325 sub set_pciconf_data {
17326         eval $start if $b_log;
17327         my ($busid,$busid_nu,$content,$port,$driver,$driver_nu,$modules,$device,$vendor,
17328         $vendor_id,$chip_id,$rev,$type,$type_id,@data,@temp,@working);
17329 #       my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/pciconf/pci-freebsd-8.2-2";
17330 #       open my $fh, '<', $file or die "can't open $file: $!";
17331 #       chomp(@data = <$fh>);
17332         my $path = check_program('pciconf');
17333         $content = qx($path -lv 2>/dev/null) if $path;
17334         @data = split /\n/, $content if $content;
17335         $b_pci_tool = 1 if @data && scalar @data > 10;
17336         foreach (@data){
17337                 if ($_ =~ /^[^@]+\@pci/){
17338                         push @working, '';
17339                 }
17340                 $_ =~ s/^\s+//;
17341                 push @working, $_;
17342         }
17343         foreach (@working){
17344                 if ($driver){
17345                         if ($_ =~ /^\s*$/) {
17346                                 $vendor = cleaner($vendor);
17347                                 $device = cleaner($device);
17348                                 if ($vendor && $device){
17349                                         if ($vendor !~ /$device/i){
17350                                                 $device = "$vendor $device";
17351                                         }
17352                                 }
17353                                 elsif (!$device){
17354                                         $device = $vendor;
17355                                 }
17356                                 @temp = ($type,$type_id,$busid,$busid_nu,$device,$vendor_id,$chip_id,
17357                                 $rev,$port,$driver,$modules,$driver_nu);
17358                                 @pci = (@pci,[@temp]);
17359                                 $driver = '';
17360                                 #print "$busid $device_id r:$rev p: $port\n$type\n$device\n";
17361                         }
17362                         elsif ($_ =~ /^vendor/){
17363                                 $vendor = (split /\s+=\s+/,$_)[1];
17364                                 #print "p:$port\n";
17365                         }
17366                         elsif ($_ =~ /^device/){
17367                                 $device = (split /\s+=\s+/,$_)[1];
17368                         }
17369                         elsif ($_ =~ /^class/i){
17370                                 $type = (split /\s+=\s+/,$_)[1];
17371                         }
17372                 }
17373                 elsif (/^([^@]+)\@pci([0-9]{1,3}:[0-9]{1,3}:[0-9]{1,3}):([0-9]{1,3}).*class=([^\s]+)\scard=([^\s]+)\schip=([^\s]+)\srev=([^\s]+)/){
17374                         $driver = $1;
17375                         $busid = $2;
17376                         $busid_nu = $3;
17377                         $type_id = $4;
17378                         #$vendor_id = $5;
17379                         $vendor_id = substr($6,6,4);
17380                         $chip_id = substr($6,2,4);
17381                         $rev = $7;
17382                         $vendor = '';
17383                         $device = '';
17384                         $type = '';
17385                         $driver =~ /(^[a-z]+)([0-9]+$)/;
17386                         $driver = $1;
17387                         $driver_nu = $2;
17388                 }
17389         }
17390         if ($driver && $busid){
17391                 $vendor = cleaner($vendor);
17392                 $device = cleaner($device);
17393                 $device = ( $vendor && $device !~ /$vendor/) ? "$vendor $device" : $device;
17394                 @temp = ($type,$type_id,$busid,$busid_nu,$device,$vendor_id,$chip_id,$rev,$port,$driver,$modules,$driver_nu);
17395                 @pci = (@pci,[@temp]);
17396                 $device = '';
17397         }
17398         print Dumper \@pci if $test[4];
17399         main::log_data('dump','@pci',\@pci) if $b_log;
17400         eval $end if $b_log;
17401 }
17402
17403 ## 1
17404 # /soc/1c30000.ethernet/uevent:["DRIVER=dwmac-sun8i", "OF_NAME=ethernet",
17405 # "OF_FULLNAME=/soc/ethernet@1c30000", "OF_COMPATIBLE_0=allwinner,sun8i-h3-emac",
17406 # "OF_COMPATIBLE_N=1", "OF_ALIAS_0=ethernet0", # "MODALIAS=of:NethernetT<NULL>Callwinner,sun8i-h3-emac"]
17407 ## 2
17408 # /soc:audio/uevent:["DRIVER=bcm2835_audio", "OF_NAME=audio", "OF_FULLNAME=/soc/audio",
17409 # "OF_COMPATIBLE_0=brcm,bcm2835-audio", "OF_COMPATIBLE_N=1", "MODALIAS=of:NaudioT<NULL>Cbrcm,bcm2835-audio"]
17410 ## 3
17411 # /soc:fb/uevent:["DRIVER=bcm2708_fb", "OF_NAME=fb", "OF_FULLNAME=/soc/fb",
17412 # "OF_COMPATIBLE_0=brcm,bcm2708-fb", "OF_COMPATIBLE_N=1", "MODALIAS=of:NfbT<NULL>Cbrcm,bcm2708-fb"]
17413 ## 4
17414 # /soc/1c40000.gpu/uevent:["OF_NAME=gpu", "OF_FULLNAME=/soc/gpu@1c40000",
17415 # "OF_COMPATIBLE_0=allwinner,sun8i-h3-mali", "OF_COMPATIBLE_1=allwinner,sun7i-a20-mali",
17416 # "OF_COMPATIBLE_2=arm,mali-400", "OF_COMPATIBLE_N=3",
17417 # "MODALIAS=of:NgpuT<NULL>Callwinner,sun8i-h3-maliCallwinner,sun7i-a20-maliCarm,mali-400"]
17418 ## 5
17419 # /sys/devices/platform/soc/soc:internal-regs/d0018180.gpio/uevent
17420 ## 6
17421 # /sys/devices/soc.0/1180000001800.mdio/8001180000001800:05/uevent
17422 #  ["DRIVER=AR8035", "OF_NAME=ethernet-phy"
17423 ## 7
17424 # /sys/devices/soc.0/1c30000.eth/uevent
17425 ## 8
17426 # /sys/devices/wlan.26/uevent [from pine64]
17427 sub set_soc_data {
17428         eval $start if $b_log;
17429         my ($content,@files,@temp2,@temp3,@working);
17430         if (-d '/sys/devices/platform/'){
17431                 @files = globber('/sys/devices/platform/soc*/*/uevent');
17432                 @temp2 = globber('/sys/devices/platform/soc*/*/*/uevent');
17433                 @files = (@files,@temp2) if @temp2;
17434         }
17435         if (globber('/sys/devices/soc*')){
17436                 @temp2 = globber('/sys/devices/soc*/*/uevent');
17437                 @files = (@files,@temp2) if @temp2;
17438                 @temp2 = globber('/sys/devices/soc*/*/*/uevent');
17439                 @files = (@files,@temp2) if @temp2;
17440         }
17441         @temp2 = globber('/sys/devices/*/uevent'); # see case 8
17442         @files = (@files,@temp2) if @temp2;
17443         @temp2 = undef;
17444         # not sure why, but even as root/sudo, /subsystem/uevent is unreadable with -r test true
17445         @files = grep {!/subsystem/} @files if @files;
17446         foreach my $file (@files){
17447                 next if -z $file;
17448                 my ($busid,$busid_nu,$chip_id,$device,$driver,$modules,$port,$rev,
17449                 $temp,$type,$type_id,$vendor_id,@working);
17450                 $chip_id = $file;
17451                 # variants: /soc/20100000.ethernet /soc/soc:audio /soc:/ /soc@0/
17452                 # mips: /sys/devices/soc.0/1180000001800.mdio/8001180000001800:07/
17453                 $chip_id =~ /\/sys\/devices\/(platform\/)?(soc[^\/]*\/)?([^\/]+\/)?([^\/]+\/)?([^\/]+)[\.:]([^\/]+)\/uevent$/;
17454                 $chip_id = $5;
17455                 $temp = $6;
17456                 @working = reader($file, 'strip') if -r $file;
17457                 foreach my $data (@working){
17458                         @temp2 = split /=/, $data;
17459                         if ($temp2[0] eq 'DRIVER'){
17460                                 $driver = $temp2[1];
17461                                 $driver =~ s/-/_/g if $driver; # kernel uses _, not - in module names
17462                         }
17463                         elsif ($temp2[0] eq 'OF_NAME'){
17464                                 $type = $temp2[1];
17465                         }
17466                         elsif ($temp2[0] eq 'OF_COMPATIBLE_0'){
17467                                 @temp3 = split /,/, $temp2[1];
17468                                 $device = $temp3[-1];
17469                                 $vendor_id = $temp3[0];
17470                         }
17471                 }
17472                 # it's worthless, we can't use it
17473                 next if ! defined $type;
17474                 $driver = '' if ! defined $driver;
17475                 $busid = (defined $temp && $temp =~ /^[0-9]+$/) ? $temp: 0;
17476                 $busid_nu =  0;
17477                 $type_id =  '';
17478                 $port = '';
17479                 $rev = '';
17480                 $modules = '';
17481                 # note: use these for main Card match for -AGN
17482                 $b_soc_audio = 1 if $type =~ /^(audio|daudio|hdmi|multimedia)$/;
17483                 $b_soc_gfx = 1 if $type =~ /^(vga|disp|display|3d|fb|gpu|hdmi)$/;
17484                 $b_soc_net = 1 if $type =~ /^(eth|ethernet|ethernet-phy|network|wifi|wlan)$/;
17485                 @temp3 = ($type,$type_id,$busid,$busid_nu,$device,$vendor_id,$chip_id,$rev,$port,$driver,$modules);
17486                 @pci = (@pci,[@temp3]);
17487         }
17488         print Dumper \@pci if $test[4];
17489         main::log_data('dump','@pci',\@pci) if $b_log;
17490         eval $end if $b_log;
17491 }
17492 sub set_ps_aux {
17493         eval $start if $b_log;
17494         @ps_aux = split "\n",qx(ps aux);;
17495         shift @ps_aux; # get rid of header row
17496         $_=lc for @ps_aux; # this is a super fast way to set to lower
17497         # note: regular perl /.../inxi but sudo /.../inxi is added for sudo start
17498         # for pinxi, we want to see the useage data for cpu/ram
17499         @ps_aux = grep {!/\/$self_name\b/} @ps_aux if $self_name eq 'inxi';
17500         # this is for testing for the presence of the command
17501         @ps_cmd = grep {!/^\[/} map {
17502                 my @split = split /\s+/, $_;
17503                 # slice out 10th to last elements of ps aux rows
17504                 my $final = $#split;
17505                 # some stuff has a lot of data, chrome for example
17506                 $final = ($final > 12) ? 12 : $final;
17507                 @split = @split[10 .. $final ];
17508                 join " ", @split;
17509         } @ps_aux;
17510         #@ps_cmd = grep {!/^\[/} @ps_cmd;
17511         # never, because ps loaded before option handler
17512         print Dumper \@ps_cmd if $test[5];
17513         eval $end if $b_log;
17514 }
17515 sub set_ps_gui {
17516         eval $start if $b_log;
17517         $b_ps_gui = 1;
17518         my ($working,@match,@temp);
17519         # desktops
17520         if ($show{'system'}){
17521                 @temp=qw(razor-desktop razor-session lxsession lxqt-session tdelauncher tdeinit_phase1);
17522                 @match = (@match,@temp);
17523                 @temp=qw(afterstep awesome blackbox 3dwm dwm fluxbox flwm
17524                 fvwm-crystal fvwm2 fvwm i3 jwm matchbox-panel openbox sawfish
17525                 scrotwm spectrwm twm WindowMaker wm2 wmii2 wmii);
17526                 @match = (@match,@temp);
17527         }
17528         # wm:
17529         if ($show{'system'} && $extra > 1){
17530                 @temp=qw(9wm 3dwm afterstep amiwm awesome blackbox budgie-wm compiz
17531                 dwm fluxbox flwm fvwm-crystal fvwm2 fvwm gala gnome-shell i3 jwm
17532                 twin kwin_wayland kwin_x11 kwin marco matchbox-window-manager metacity
17533                 metisse mir muffin mutter mwm notion openbox ratpoison sawfish
17534                 scrotwm spectrwm twm windowlab WindowMaker wm2 wmii2 wmii xfwm4
17535                 xfwm5 xmonad);
17536                 @match = (@match,@temp);
17537         }
17538         # info:
17539         if ($show{'system'} && $extra > 2){
17540                 @temp=qw(budgie-panel gnome-panel kicker lxpanel lxqt-panel
17541                 matchbox-panel mate-panel plasma-desktop plasma-netbook razor-panel
17542                 razorqt-panel wingpanel xfce4-panel xfce5-panel);
17543                 @match = (@match,@temp);
17544         }
17545         # compositors (for wayland these are also the server, note
17546         if ($show{'graphic'} && $extra > 1){
17547                 @temp=qw(budgie-wm compiz compton dwc dcompmgr enlightenment
17548                 grefson ireplace kmscon kwin_wayland kwin_x11 metisse mir moblin
17549                 rustland sway swc unagi wayhouse westford weston xcompmgr);
17550                 @match = (@match,@temp);
17551         }
17552         @match = uniq(@match);
17553         my $matches = join '|', @match;
17554         foreach (@ps_cmd){
17555                 if (/^[\S]*\b($matches)(\s|$)/){
17556                         $working = $1;
17557                         push @ps_gui, $working; # deal with duplicates with uniq
17558                 }
17559         }
17560         @ps_gui = uniq(@ps_gui) if @ps_gui;
17561         print Dumper \@ps_gui if $test[5];
17562         log_data('dump','@ps_gui',\@ps_gui) if $b_log;
17563         eval $end if $b_log;
17564 }
17565
17566 sub set_sysctl_data {
17567         eval $start if $b_log;
17568         return if $alerts{'sysctl'}{'action'} ne 'use';
17569         my (@temp);
17570         # darwin sysctl has BOTH = and : separators, and repeats data. Why?
17571         if (!$b_fake_sysctl){
17572                 my $program = check_program('sysctl');
17573                 @temp = grabber("$program -a 2>/dev/null");
17574         }
17575         else {
17576                 #my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/sysctl/obsd_6.1_sysctl_soekris6501_root.txt";
17577                 #my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/sysctl/obsd_6.1sysctl_lenovot500_user.txt";
17578                 ## matches: compaq: openbsd-dmesg.boot-1.txt
17579                 my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/sysctl/openbsd-5.6-sysctl-1.txt";
17580                 ## matches: toshiba: openbsd-5.6-dmesg.boot-1.txt
17581                 #my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/sysctl/openbsd-5.6-sysctl-2.txt";
17582                 @temp = reader($file);
17583         }
17584         foreach (@temp){
17585                 $_ =~ s/\s*=\s*|:\s+/:/;
17586                 $_ =~ s/\"//g;
17587                 push @sysctl, $_;
17588                 # we're building these here so we can use these arrays to test
17589                 # in each feature if we will try to build the feature for bsds
17590                 if (/^hw\.sensors/ && !/^hw\.sensors\.acpi(bat|cmb)/ && !/^hw.sensors.softraid/){
17591                         push @sysctl_sensors, $_;
17592                 }
17593                 elsif (/^hw\.(vendor|product|version|serialno|uuid)/){
17594                         push @sysctl_machine, $_;
17595                 }
17596                 elsif (/^hw\.sensors\.acpi(bat|cmb)/){
17597                         push @sysctl_battery, $_;
17598                 }
17599         }
17600         print Dumper \@sysctl if $test[7];
17601         # this thing can get really long.
17602         if ($b_log){
17603                 #main::log_data('dump','@sysctl',\@sysctl);
17604         }
17605         eval $end if $b_log;
17606 }
17607
17608 # http://www.usb.org/developers/defined_class
17609 sub set_usb_data {
17610         eval $start if $b_log;
17611         if ($alerts{'lsusb'}{'action'} eq 'use' ){
17612                 #$usb_level = 2;
17613                 # NOTE: we can't get reliable usb network device with short
17614                 if ($usb_level == 2){
17615                         set_lsusb_data_long();
17616                 }
17617                 else {
17618                         set_lsusb_data_short();
17619                 }
17620         }
17621         elsif ( $alerts{'usbdevs'}{'action'} eq 'use'){
17622                 set_usbdevs_data();
17623         }
17624         eval $end if $b_log;
17625 }
17626
17627 sub set_lsusb_data_short {
17628         eval $start if $b_log;
17629         my ($content,@data);
17630         my $b_live = 1;
17631         if ($b_live){
17632                 my $path = check_program('lsusb');
17633                 $content = qx($path 2>/dev/null) if $path;
17634                 @data = split /\n/, $content if $content;
17635         }
17636         else {
17637                 open my $fh, '<', "$ENV{'HOME'}/bin/scripts/inxi/data/lsusb/mdmarmer-lsusb.txt" or die $!;
17638                 chomp(@data = <$fh>);
17639         }
17640         foreach (@data){
17641                 next if /^\s*$|^Couldn't/; # expensive second call: || /UNAVAIL/
17642                 my @working = split /\s+/, $_;
17643                 $working[3] =~ s/:$//;
17644                 my $id = int($working[3]);
17645                 if ($id > 1){
17646                         my $bus = int($working[1]);
17647                         my $chip = $working[5];
17648                         my @temp = @working[6..$#working];
17649                         my $name = join ' ', @temp;
17650                         if ($name !~ /hub/i){
17651                                 @usb = (@usb,[$bus,$id,$chip,$name]);
17652                         }
17653                 }
17654         }
17655         print Dumper \@usb if $test[6];
17656         main::log_data('dump','@usb: short',\@usb) if $b_log;
17657         eval $end if $b_log;
17658 }
17659
17660 sub set_lsusb_data_long {
17661         eval $start if $b_log;
17662         my ($content,@data,@working,$bus_id,$device_id,$id,$b_skip);
17663         my $j = 0;
17664         my $b_live = 1;
17665         if ($b_live){
17666                 my $path = check_program('lsusb');
17667                 $content = qx($path -v 2>/dev/null) if $path;
17668                 @data = split /\n/, $content if $content;
17669         }
17670         else {
17671                 my $file;
17672                 #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/lsusb/mdmarmer-lsusb-v.txt";
17673                 $file = "$ENV{'HOME'}/bin/scripts/inxi/data/lsusb/lsusb-v-dz64.txt";
17674                 open my $fh, '<', $file or die $!;
17675                 chomp(@data = <$fh>);
17676         }
17677         foreach (@data){
17678                 # we won't need all the lsusb data, so set it to skip
17679                 # after the last item we might want
17680                 # Couldn't open device, some information will be missing
17681                 next if /^\s*$|^Couldn't/; # expensive second call: || /UNAVAIL/
17682                 if (!$b_skip && $bus_id && /^\s\s/){
17683                         #if ($_ =~ /\bDescriptor\b:/){
17684                         if ($_ =~ /^\s+([\S]+)\sDescriptor:/){
17685                                 #$_ =~ /^\s+([\S]+)\sDescriptor:/;
17686                                 $_ = "Descriptor_$1";
17687                         }
17688                         else {
17689                                 $_ =~ s/^\s\s|[\s]+$//g;
17690                                 $_ =~ s/^[\s]+/~/g;
17691                                 #$_ =~ s/[\s]+$//g;
17692                                 $_ =~ s/\sType/_Type/g;
17693                                 $_ =~ s/^([\S]+)[\s]+(.*)//;
17694                                 my $one = ($1) ? $1: '';
17695                                 my $two = ($2) ? $2: '';
17696                                 $_ = "$one:$two";
17697                                 $b_skip = 1 if $one eq '~bInterfaceProtocol';
17698                                 #$_ = cleaner($_);
17699                                 if (/([\S]+):([0-9]+|0x[0-9a-f]+)\s(.*)/){
17700                                         $_ = "$1:$2:$3";
17701                                         #$b_skip = 1 if $1 eq '~bInterfaceProtocol';
17702                                 }
17703                                 #print "$1\n";
17704                         }
17705                         push @working, $_;
17706                 }
17707                 elsif (/^Bus\s([0-9]+)\sDevice\s([0-9]+):\sID\s(([0-9a-f]{4}):([0-9a-f]{4})).*/){
17708                 #elsif (/^Bus\s/){
17709                         #if (/^Bus\s([0-9]+)\sDevice\s([0-9]+):\sID\s(([0-9a-f]{4}):([0-9a-f]{4})).*/){
17710                                 $j = scalar @usb;
17711                                 $bus_id = int($1);
17712                                 $device_id = int($2);
17713                                 $id = $3;
17714                                 $b_skip = 0;
17715                                 # we don't need 32, system boot, or 127, end of table
17716                                 if (@working){
17717                                         if ($working[0] != 32 && $working[0] != 127){
17718                                                 $usb[$j] = (
17719                                                 [@working],
17720                                                 );
17721                                         }
17722                                 }
17723                                 @working = ($bus_id,$device_id,$id);
17724                         #}
17725                 }
17726         }
17727         if (@working){
17728                 $j = scalar @usb;
17729                 $usb[$j] = (
17730                 [@working],
17731                 );
17732         }
17733         # last by not least, sort it by dmi type, now we don't have to worry
17734         # about random dmi type ordering in the data, which happens
17735         @usb = sort { $a->[0] <=> $b->[0] || $a->[1] <=> $b->[1] } @usb;
17736         print Dumper \@usb if $test[6];
17737         main::log_data('dump','@usb: long',\@usb) if $b_log;
17738         eval $end if $b_log;
17739 }
17740
17741 # Controller /dev/usb2:
17742 # addr 1: full speed, self powered, config 1, UHCI root hub(0x0000), Intel(0x8086), rev 1.00
17743 #  port 1 addr 2: full speed, power 98 mA, config 1, USB Receiver(0xc52b), Logitech(0x046d), rev 12.01
17744 #  port 2 powered
17745 sub set_usbdevs_data {
17746         eval $start if $b_log;
17747         my (@data,@working,$class,$bus_id,$addr_id,$id,$speed,$protocol);
17748         my $j = 0;
17749         my $ports = 0;
17750         if (!$b_fake_usbdevs){
17751                 my $program = check_program('usbdevs');
17752                 my $content = qx($program -v 2>/dev/null);
17753                 @data = split /\n/, $content;
17754         }
17755         else {
17756                 open my $fh, '<', "$ENV{'HOME'}/bin/scripts/inxi/data/lsusb/bsd-usbdevs-v-1.txt" or die $!;
17757                 chomp(@data = <$fh>);
17758         }
17759         foreach (@data){
17760                 if (/^Controller\s\/dev\/usb([0-9]+)/){
17761                         $j = scalar @usb;
17762                         $ports = 0;
17763                         $bus_id = $1;
17764                         @working = ();
17765                 }
17766                 elsif (/^addr\s([0-9]+):\s([^,]+),[^,]+,[^,]+,\s?([^,]+)\(0x([0-9a-f]{4})\),\s?([^,]+)\s?\(0x([0-9a-f]{4})\)/){
17767                         $j = scalar @usb;
17768                         $addr_id = $1;
17769                         $speed = "bcdUSB:$2";
17770                         $id = "$4:$6";
17771                         $protocol="~bInterfaceProtocol:0:$5 $3";
17772                         #print "p1:$protocol\n";
17773                         $class='bDeviceClass:9:Hub';
17774                         @working = ($bus_id,$addr_id,$id,$speed,$class,$protocol);
17775                         if (@working){
17776                                 $usb[$j] = (
17777                                 [@working],
17778                                 );
17779                         }
17780                         @working = ();
17781                 }
17782                 elsif (/^\s+port\s([0-9]+)\saddr\s([0-9]+):\s([^,]+),[^,]+,[^,]+,\s?([^,]+)\(0x([0-9a-f]{4})\),\s?([^,]+)\s?\(0x([0-9a-f]{4})\)/){
17783                         $j = scalar @usb;
17784                         $addr_id = "$2";
17785                         $speed = "bcdUSB:$3";
17786                         $id = "$5:$7";
17787                         $protocol="~bInterfaceProtocol:0:$6 $4";
17788                         #print "p2:$protocol\n";
17789                         $ports++;
17790                         @working = ($bus_id,$addr_id,$id,$speed,$protocol);
17791                         if (@working){
17792                                 $usb[$j] = (
17793                                 [@working],
17794                                 );
17795                         }
17796                         @working = ();
17797                 }
17798                 elsif (/^\s+port\s([0-9]+)\spowered/){
17799                         $ports++;
17800                 }
17801         }
17802         if (@working){
17803                 $j = scalar @usb;
17804                 $usb[$j] = (
17805                 [@working],
17806                 );
17807         }
17808         main::log_data('dump','@usb: usbdevs',\@usb) if $b_log;
17809         print Dumper \@usb if $test[6];
17810         eval $end if $b_log;
17811 }
17812
17813 ########################################################################
17814 #### GENERATE LINES
17815 ########################################################################
17816
17817 #### -------------------------------------------------------------------
17818 #### LINE CONTROLLERS
17819 #### -------------------------------------------------------------------
17820
17821 sub assign_data {
17822         my (%row) = @_;
17823         return if ! %row;
17824         if ($output_type eq 'screen'){
17825                 print_data(%row);
17826         }
17827         else {
17828                 %rows = (%rows,%row);
17829         }
17830 }
17831
17832 sub generate_lines {
17833         eval $start if $b_log;
17834         my (%row,$b_pci_check,$b_dmi_check);
17835         set_ps_aux() if ! @ps_aux;
17836         set_sysctl_data() if $b_sysctl;
17837         # note: ps aux loads before logging starts, so create debugger data here
17838         if ($b_log){
17839                 # I don't think we need to see this, it's long, but leave in case we do
17840                 #main::log_data('dump','@ps_aux',\@ps_aux);
17841                 main::log_data('dump','@ps_cmd',\@ps_cmd);
17842         }
17843         if ( $show{'short'} ){
17844                 set_dmesg_boot_data() if ($bsd_type && !$b_dmesg_boot_check);
17845                 %row = generate_short_data();
17846                 assign_data(%row);
17847         }
17848         else {
17849                 if ( $show{'system'} ){
17850                         %row = generate_system_data();
17851                         assign_data(%row);
17852                 }
17853                 if ( $show{'machine'} ){
17854                         if ($b_dmi && !$b_dmi_check ){
17855                                 set_dmi_data() ;
17856                                 $b_dmi_check = 1;
17857                         }
17858                         set_dmesg_boot_data() if ($bsd_type && !$b_dmesg_boot_check);
17859                         %row = line_handler('Machine','machine');
17860                         assign_data(%row);
17861                 }
17862                 if ( $show{'battery'} ){
17863                         set_dmi_data() if $b_dmi && !$b_dmi_check;
17864                         $b_dmi_check = 1;
17865                         %row = line_handler('Battery','battery');
17866                         if (%row || $show{'battery-forced'}){
17867                                 assign_data(%row);
17868                         }
17869                 }
17870                 if ( $show{'ram'} ){
17871                         set_dmi_data() if $b_dmi && !$b_dmi_check;
17872                         $b_dmi_check = 1;
17873                         %row = line_handler('Memory','ram');
17874                         assign_data(%row);
17875                 }
17876                 if ( $show{'slot'} ){
17877                         set_dmi_data() if $b_dmi && !$b_dmi_check;
17878                         $b_dmi_check = 1;
17879                         %row = line_handler('PCI Slots','slot');
17880                         assign_data(%row);
17881                 }
17882                 if ( $show{'cpu'} || $show{'cpu-basic'} ){
17883                         set_dmesg_boot_data() if ($bsd_type && !$b_dmesg_boot_check);
17884                         my $arg = ($show{'cpu-basic'}) ? 'basic' : 'full' ;
17885                         %row = line_handler('CPU','cpu',$arg);
17886                         assign_data(%row);
17887                 }
17888                 if ( $show{'graphic'} ){
17889                         set_pci_data() if !$b_pci_check;
17890                         $b_pci_check = 1;
17891                         %row = line_handler('Graphics','graphic');
17892                         assign_data(%row);
17893                 }
17894                 if ( $show{'audio'} ){
17895                         set_pci_data() if !$b_pci_check;
17896                         $b_pci_check = 1;
17897                         %row = line_handler('Audio','audio');
17898                         assign_data(%row);
17899                 }
17900                 if ( $show{'network'} ){
17901                         set_usb_data() if !$b_usb_check;
17902                         set_pci_data() if !$b_pci_check;
17903                         set_ip_data() if ($show{'ip'} || ($bsd_type && $show{'network-advanced'}));
17904                         $b_pci_check = 1;
17905                         $b_usb_check = 1;
17906                         %row = line_handler('Network','network');
17907                         assign_data(%row);
17908                 }
17909                 if ( $show{'disk'} || $show{'disk-basic'} || $show{'disk-total'} || $show{'optical'} ){
17910                         set_dmesg_boot_data() if ($bsd_type && !$b_dmesg_boot_check);
17911                         %row = line_handler('Drives','disk');
17912                         assign_data(%row);
17913                 }
17914                 if ( $show{'raid'} ){
17915                         set_pci_data() if !$b_pci_check;
17916                         %row = line_handler('RAID','raid');
17917                         assign_data(%row);
17918                 }
17919                 if ( $show{'partition'} || $show{'partition-full'}){
17920                         %row = line_handler('Partition','partition');
17921                         assign_data(%row);
17922                 }
17923                 if ( $show{'unmounted'} ){
17924                         %row = line_handler('Unmounted','unmounted');
17925                         assign_data(%row);
17926                 }
17927                 if ( $show{'usb'} ){
17928                         set_usb_data() if !$b_usb_check;
17929                         %row = line_handler('USB','usb');
17930                         assign_data(%row);
17931                         $b_usb_check = 1;
17932                 }
17933                 if ( $show{'sensor'} ){
17934                         %row = line_handler('Sensors','sensor');
17935                         assign_data(%row);
17936                 }
17937                 if ( $show{'repo'} ){
17938                         %row = line_handler('Repos','repo');
17939                         assign_data(%row);
17940                 }
17941                 if ( $show{'process'} ){
17942                         %row = line_handler('Processes','process');
17943                         assign_data(%row);
17944                 }
17945                 if ( $show{'weather'} ){
17946                         %row = line_handler('Weather','weather');
17947                         assign_data(%row);
17948                 }
17949                 if ( $show{'info'} ){
17950                         %row = generate_info_data();
17951                         assign_data(%row);
17952                 }
17953         }
17954         if ( $output_type ne 'screen' ){
17955                 output_handler(%rows);
17956         }
17957         eval $end if $b_log;
17958 }
17959
17960 sub line_handler {
17961         eval $start if $b_log;
17962         my ($key,$sub,$arg) = @_;
17963         my %subs = (
17964         'audio' => \&AudioData::get,
17965         'battery' => \&BatteryData::get,
17966         'cpu' => \&CpuData::get,
17967         'disk' => \&DiskData::get,
17968         'graphic' => \&GraphicData::get,
17969         'machine' => \&MachineData::get,
17970         'network' => \&NetworkData::get,
17971         'partition' => \&PartitionData::get,
17972         'raid' => \&RaidData::get,
17973         'ram' => \&RamData::get,
17974         'repo' => \&RepoData::get,
17975         'process' => \&ProcessData::get,
17976         'sensor' => \&SensorData::get,
17977         'slot' => \&SlotData::get,
17978         'unmounted' => \&UnmountedData::get,
17979         'usb' => \&UsbData::get,
17980         'weather' => \&WeatherData::get,
17981         );
17982         my (%data);
17983         my $data_name = main::key($prefix++,$key);
17984         my @rows = $subs{$sub}->($arg);
17985         if (@rows){
17986                 %data = ($data_name => \@rows,);
17987         }
17988         eval $end if $b_log;
17989         return %data;
17990 }
17991
17992 #### -------------------------------------------------------------------
17993 #### SHORT, DEBUG
17994 #### -------------------------------------------------------------------
17995
17996 sub generate_short_data {
17997         eval $start if $b_log;
17998         my $num = 0;
17999         my $kernel_os = ($bsd_type) ? 'OS' : 'Kernel';
18000         my $client = $client{'name-print'};
18001         my $client_shell = ($b_irc) ? 'Client' : 'Shell';
18002         if ($client{'version'}){
18003                 $client .= ' ' . $client{'version'};
18004         }
18005         my ($cpu_string,$speed,$speed_key,$type) = ('','','speed','');
18006         my $memory = get_memory_data('string');
18007         my @cpu = CpuData::get('short');
18008         if (scalar @cpu > 1){
18009                 $type = ($cpu[2]) ? " (-$cpu[2]-)" : '';
18010                 ($speed,$speed_key) = ('','');
18011                 if ($cpu[6]){
18012                         $speed_key = "$cpu[3]/$cpu[5]";
18013                         $cpu[4] =~ s/ MHz//;
18014                         $speed = "$cpu[4]/$cpu[6]";
18015                 }
18016                 else {
18017                         $speed_key = $cpu[3];
18018                         $speed = $cpu[4];
18019                 }
18020                 $cpu[1] ||= row_defaults('cpu-model-null');
18021                 $cpu_string = $cpu[0] . ' ' . $cpu[1] . $type;
18022         }
18023         elsif ($bsd_type) {
18024                 if ($alerts{'sysctl'}{'action'}){
18025                         if ($alerts{'sysctl'}{'action'} ne 'use'){
18026                                 $cpu_string = "sysctl $alerts{'sysctl'}{'action'}";
18027                                 $speed = "sysctl $alerts{'sysctl'}{'action'}";
18028                         }
18029                         else {
18030                                 $cpu_string = 'bsd support coming';
18031                                 $speed = 'bsd support coming';
18032                         }
18033                 }
18034         }
18035         my @disk = DiskData::get('short');
18036         # print Dumper \@disk;
18037         my $disk_string = 'N/A';
18038         my ($size,$used,$size_type,$used_type) = ('','','','');
18039         my (@temp,$size_holder,$used_holder);
18040         if (@disk){
18041                 $size = $disk[0]{'size'};
18042                 if ($disk[0]{'size'} && $disk[0]{'size'} =~ /^[0-9\.]+$/){
18043                         $size_holder = $disk[0]{'size'};
18044                         @temp = get_size($size);
18045                         $size = $temp[0];
18046                         $size_type = " $temp[1]";
18047                 }
18048                 $used = $disk[0]{'used'};
18049                 if (defined $disk[0]{'used'} && $disk[0]{'used'} =~ /^[0-9\.]+$/){
18050                         $used_holder = $disk[0]{'used'};
18051                         @temp = get_size($used);
18052                         $used = $temp[0];
18053                         $used_type = " $temp[1]";
18054                 }
18055                 # in some fringe cases size can be 0 so only assign 'N/A' if no percents etc
18056                 if ($size_holder && $used_holder){
18057                         my $percent = ' (' . sprintf("%.1f", $used_holder/$size_holder*100) . '% used)';
18058                         $disk_string = "$size$size_type$percent";
18059                 }
18060                 else {
18061                         $size ||= row_defaults('disk-size-0');
18062                         $disk_string = "$used$used_type/$size$size_type";
18063                 }
18064         }
18065         #print join '; ', @cpu, " sleep: $cpu_sleep\n";
18066         $memory ||= 'N/A';
18067         my @data = ({
18068                 main::key($num++,'CPU') => $cpu_string,
18069                 main::key($num++,$speed_key) => $speed,
18070                 main::key($num++,$kernel_os) => &get_kernel_data(),
18071                 main::key($num++,'Up') => &get_uptime(),
18072                 main::key($num++,'Mem') => $memory,
18073                 main::key($num++,'Storage') => $disk_string,
18074                 # could make -1 for ps aux itself, -2 for ps aux and self
18075                 main::key($num++,'Procs') => scalar @ps_aux,
18076                 main::key($num++,$client_shell) => $client,
18077                 main::key($num++,$self_name) => &get_self_version(),
18078         },);
18079         my %row = (
18080         main::key($prefix,'SHORT') => [(@data),],
18081         );
18082         eval $end if $b_log;
18083         return %row;
18084 }
18085
18086 #### -------------------------------------------------------------------
18087 #### CONSTRUCTED LINES
18088 #### -------------------------------------------------------------------
18089
18090 sub generate_info_data {
18091         eval $start if $b_log;
18092         my $num = 0;
18093         my $gcc_alt = '';
18094         my $running_in = '';
18095         my $data_name = main::key($prefix++,'Info');
18096         my ($b_gcc,%row,$gcc,$index,$ref);
18097         my ($gpu_ram,$parent,$percent,$total,$used) = (0,'','','','');
18098         my $client_shell = ($b_irc) ? 'Client' : 'Shell';
18099         my $client = $client{'name-print'};
18100         my @gccs = get_gcc_data();
18101         if (@gccs){
18102                 $gcc = shift @gccs;
18103                 if ($extra > 1 && @gccs){
18104                         $gcc_alt = join '/', @gccs;
18105                 }
18106                 $b_gcc = 1;
18107         }
18108         $gcc ||= 'N/A';
18109         if (!$b_irc && $extra > 1 ){
18110                 # bsds don't support -f option to get PPID
18111                 if (($b_display && !$b_force_display) && !$bsd_type){
18112                         $parent = get_shell_source();
18113                 }
18114                 else {
18115                         $parent = get_tty_number();
18116                         $parent = "tty $parent" if $parent ne '';
18117                 }
18118                 if ($parent eq 'login'){
18119                         $client{'su-start'} = $parent if !$client{'su-start'};
18120                         $parent = undef;
18121                 }
18122                 # can be tty 0 so test for defined
18123                 $running_in = $parent if defined $parent;
18124                 if ($extra > 2 && $running_in && get_ssh_status() ){
18125                         $running_in .= ' (SSH)';
18126                 }
18127         }
18128         my $memory = get_memory_data('splits');
18129         if ($memory){
18130                 my @temp = split /:/, $memory;
18131                 my @temp2 = get_size($temp[0]);
18132                 $gpu_ram = $temp[3] if $temp[3];
18133                 $total = ($temp2[1]) ? $temp2[0] . ' ' . $temp2[1] : $temp2[0];
18134                 @temp2 = get_size($temp[1]);
18135                 $used = ($temp2[1]) ? $temp2[0] . ' ' . $temp2[1] : $temp2[0];
18136                 $used .= " ($temp[2]%)" if $temp[2];
18137                 if ($gpu_ram){
18138                         @temp2 = get_size($gpu_ram);
18139                         $gpu_ram = $temp2[0] . ' ' . $temp2[1] if $temp2[1];
18140                 }
18141         }
18142         $memory ||= 'N/A';
18143         my %data = (
18144         $data_name => [{
18145                 main::key($num++,'Processes') => scalar @ps_aux,
18146                 main::key($num++,'Uptime') => &get_uptime(),
18147                 main::key($num++,'Memory') => $total,
18148                 },],
18149         );
18150         $index = scalar(@{ $data{$data_name} } ) - 1;
18151         $data{$data_name}[$index]{main::key($num++,'used')} = $used;
18152         if ($gpu_ram){
18153                 $data{$data_name}[$index]{main::key($num++,'gpu')} = $gpu_ram;
18154         }
18155         if ( (!$b_display || $b_force_display) || $extra > 0 ){
18156                 my %init = get_init_data();
18157                 my $init_type = ($init{'init-type'}) ? $init{'init-type'}: 'N/A';
18158                 $data{$data_name}[$index]{main::key($num++,'Init')} = $init_type;
18159                 if ($extra > 1 ){
18160                         my $init_version = ($init{'init-version'}) ? $init{'init-version'}: 'N/A';
18161                         $data{$data_name}[$index]{main::key($num++,'v')} = $init_version;
18162                 }
18163                 if ($init{'rc-type'}){
18164                         $data{$data_name}[$index]{main::key($num++,'rc')} = $init{'rc-type'};
18165                         if ($init{'rc-version'}){
18166                                 $data{$data_name}[$index]{main::key($num++,'v')} = $init{'rc-version'};
18167                         }
18168                 }
18169                 if ($init{'runlevel'}){
18170                         $data{$data_name}[$index]{main::key($num++,'runlevel')} = $init{'runlevel'};
18171                 }
18172                 if ($extra > 1 ){
18173                         if ($init{'default'}){
18174                                 my $default = ($init{'init-type'} eq 'systemd' && $init{'default'} =~ /[^0-9]$/ ) ? 'target' : 'default';
18175                                 $data{$data_name}[$index]{main::key($num++,$default)} = $init{'default'};
18176                         }
18177                 }
18178         }
18179         if ($extra > 0 ){
18180                 my $b_clang;
18181                 my $clang_version = '';
18182                 if (my $path = check_program('clang')){
18183                         $clang_version = program_version($path,'clang',3,'--version');
18184                         $clang_version ||= 'N/A';
18185                         $b_clang = 1;
18186                 }
18187                 my $compiler = ($b_gcc || $b_clang) ? '': 'N/A';
18188                 $data{$data_name}[$index]{main::key($num++,'Compilers')} = $compiler;
18189                 if ($b_gcc){
18190                         $data{$data_name}[$index]{main::key($num++,'gcc')} = $gcc;
18191                         if ( $extra > 1 && $gcc_alt){
18192                                 $data{$data_name}[$index]{main::key($num++,'alt')} = $gcc_alt;
18193                         }
18194                 }
18195                 if ($b_clang){
18196                         $data{$data_name}[$index]{main::key($num++,'clang')} = $clang_version;
18197                 }
18198         }
18199         if ($extra > 2 && $client{'su-start'}){
18200                 $client .= " ($client{'su-start'})";
18201         }
18202         $data{$data_name}[$index]{main::key($num++,$client_shell)} =  $client;
18203         if ($extra > 0 && $client{'version'}){
18204                 $data{$data_name}[$index]{main::key($num++,'v')} = $client{'version'};
18205         }
18206         if ( $running_in ){
18207                 $data{$data_name}[$index]{main::key($num++,'running in')} = $running_in;
18208         }
18209         $data{$data_name}[$index]{main::key($num++,$self_name)} = &get_self_version();
18210
18211         eval $end if $b_log;
18212         return %data;
18213 }
18214
18215 sub generate_system_data {
18216         eval $start if $b_log;
18217         my $num = 0;
18218         my (%row,$ref,$index,$val1);
18219         my $data_name = main::key($prefix++,'System');
18220         my ($desktop,$desktop_info,$desktop_key,$toolkit,$wm) = ('','','Desktop','','');
18221         my (@desktop_data,$desktop_version);
18222
18223         my %data = (
18224         $data_name => [{}],
18225         );
18226         $index = scalar(@{ $data{$data_name} } ) - 1;
18227         if ($show{'host'}){
18228                 $data{$data_name}[$index]{main::key($num++,'Host')} = &get_hostname();
18229         }
18230         $data{$data_name}[$index]{main::key($num++,'Kernel')} = &get_kernel_data();
18231         $data{$data_name}[$index]{main::key($num++,'bits')} = &get_kernel_bits;
18232         if ($extra > 0){
18233                 my @compiler = get_compiler_version(); # get compiler data
18234                 if (scalar @compiler != 2){
18235                         @compiler = ('N/A', '');
18236                 }
18237                 $data{$data_name}[$index]{main::key($num++,'compiler')} = $compiler[0];
18238                 # if no compiler, obviously no version, so don't waste space showing.
18239                 if ($compiler[0] ne 'N/A'){
18240                         $compiler[1] ||= 'N/A';
18241                         $data{$data_name}[$index]{main::key($num++,'v')} = $compiler[1];
18242                 }
18243         }
18244         # note: tty can have the value of 0 but the two tools
18245         # return '' if undefined, so we test for explicit ''
18246         if ($b_display){
18247                 my @desktop_data = DesktopEnvironment::get();
18248                 $desktop = $desktop_data[0] if $desktop_data[0];
18249                 $desktop_version = $desktop_data[1] if $desktop_data[1];
18250                 $desktop .= ' ' . $desktop_version if $desktop_version;
18251                 if ($extra > 0 && $desktop_data[3]){
18252                         #$desktop .= ' (' . $desktop_data[2];
18253                         #$desktop .= ( $desktop_data[3] ) ? ' ' . $desktop_data[3] . ')' : ')';
18254                         $toolkit = "$desktop_data[2] $desktop_data[3]";
18255                 }
18256                 if ($extra > 2 && $desktop_data[4]){
18257                         $desktop_info = $desktop_data[4];
18258                 }
18259                 # don't print the desktop if it's a wm and the same
18260                 if ($extra > 1 && $desktop_data[5] &&
18261                     (!$desktop_data[0] || $desktop_data[5] =~ /^(gnome[\s\-_]shell|budgie-wm)$/i ||
18262                     index(lc($desktop_data[5]),lc($desktop_data[0])) == -1 )){
18263                         $wm = $desktop_data[5];
18264                         $wm .= ' ' . $desktop_data[6] if $extra > 2 && $desktop_data[6];
18265                 }
18266         }
18267         if (!$b_display || ( !$desktop && $b_root)) {
18268                 my $tty = get_tty_number();
18269                 if (!$desktop){
18270                         $desktop_info = '';
18271                 }
18272                 # it is defined, as ''
18273                 if ( $tty eq '' && $client{'console-irc'}){
18274                         $tty = get_tty_console_irc('vtnr');
18275                 }
18276                 $desktop = "tty $tty" if $tty ne '';
18277                 $desktop_key = 'Console';
18278         }
18279         $desktop ||= 'N/A';
18280         $data{$data_name}[$index]{main::key($num++,$desktop_key)} = $desktop;
18281         if ($toolkit){
18282                 $data{$data_name}[$index]{main::key($num++,'tk')} = $toolkit;
18283         }
18284         if ($extra > 2){
18285                 if ($desktop_info){
18286                         $data{$data_name}[$index]{main::key($num++,'info')} = $desktop_info;
18287                 }
18288         }
18289         if ($extra > 1){
18290                 $data{$data_name}[$index]{main::key($num++,'wm')} = $wm if $wm;
18291                 my $dms = get_display_manager();
18292                 $dms ||= 'N/A';
18293                 $data{$data_name}[$index]{main::key($num++,'dm')} = $dms;
18294         }
18295         #if ($extra > 2 && $desktop_key ne 'Console'){
18296         #       my $tty = get_tty_number();
18297         #       $data{$data_name}[$index]{main::key($num++,'vc')} = $tty if $tty ne '';
18298         #}
18299         my $distro_key = ($bsd_type) ? 'OS': 'Distro';
18300         my @distro_data = DistroData::get();
18301         my $distro = $distro_data[0];
18302         $distro ||= 'N/A';
18303         $data{$data_name}[$index]{main::key($num++,$distro_key)} = $distro;
18304         if ($extra > 0 && $distro_data[1]){
18305                 $data{$data_name}[$index]{main::key($num++,'base')} = $distro_data[1];
18306         }
18307         eval $end if $b_log;
18308         return %data;
18309 }
18310
18311 #######################################################################
18312 #### LAUNCH
18313 ########################################################################
18314
18315 main(); ## From the End comes the Beginning
18316
18317 ## note: this EOF is needed for smxi handling, this is what triggers the full download ok
18318 ###**EOF**###