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 17use strict; 18use warnings; 19# use diagnostics; 20use 5.008; 21 22use Cwd qw(abs_path); # qw(abs_path);#abs_path realpath getcwd 23use Data::Dumper qw(Dumper); # print_r 24use File::Find; 25use Getopt::Long qw(GetOptions); 26# Note: default auto_abbrev is enabled, that's fine 27Getopt::Long::Configure ('bundling', 'no_ignore_case', 28'no_getopt_compat', 'no_auto_abbrev','pass_through'); 29use POSIX qw(uname strftime ttyname); 30# use feature qw(state); 31 32## INXI INFO ## 33my $self_name='inxi'; 34my $self_version='3.0.18'; 35my $self_date='2018-07-16'; 36my $self_patch='00'; 37## END INXI INFO ## 38 39### INITIALIZE VARIABLES ### 40 41## Self data 42my ($self_path, $user_config_dir, $user_config_file,$user_data_dir); 43 44## Debuggers 45my $debug=0; 46my (@t0,$end,$start,$fh_l,$log_file); # log file handle, file 47my ($b_hires,$t1,$t2,$t3) = (0,0,0,0); 48# NOTE: redhat removed HiRes from Perl Core Modules. 49if (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 55my ( %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 59my (@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 63my (@dm_boot_disk,@dm_boot_optical,@glabel,@gpart,@hardware_raid,@labels, 64@lsblk,@partitions,@raid,@sysctl_disks,@uuids); 65my @test = (0,0,0,0,0); 66 67## Booleans 68my ($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 76my ($b_dm_boot_disk,$b_dm_boot_optical,$b_glabel,$b_hardware_raid, 77$b_label_uuid,$b_lsblk,$b_partitions,$b_raid); 78my ($b_sysctl_disk,$b_update,$b_weather) = (1,1,1); 79 80## System 81my ($bsd_type,$language,$os) = ('','',''); 82my ($bits_sys,$cpu_arch); 83my ($cpu_sleep,$dl_timeout,$limit,$ps_count,$usb_level) = (0.35,4,10,5,0); 84my $sensors_cpu_nu = 0; 85my $weather_unit='mi'; 86 87## Tools 88my ($display,$ftp_alt,$tty_session); 89my ($display_opt,$sudo) = ('',''); 90 91## Output 92my $extra = 0;# supported values: 0-3 93my $filter_string = '<filter>'; 94my $line1 = "----------------------------------------------------------------------\n"; 95my $line2 = "======================================================================\n"; 96my $line3 = "----------------------------------------\n"; 97my ($output_file,$output_type) = ('','screen'); 98my $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. 103my %sep = ( 104's1-irc' => ':', 105's1-console' => ':', 106's2-irc' => '', 107's2-console' => ':', 108); 109 110my %show = ('host' => 1); 111 112my %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 137sub 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 166sub 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 177sub 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 322sub 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. 351sub 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 397sub 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 411sub 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. 443sub 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 458sub 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 476sub 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 527sub 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 574sub 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 639sub 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 676sub 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{ 727package SelectColors; 728 729# use warnings; 730# use strict; 731# use diagnostics; 732# use 5.008; 733 734my (@data,@rows,%configs,%status); 735my ($type,$w_fh); 736my $safe_color_count = 12; # null/normal + default color group 737my $count = 0; 738 739# args: 1 - type 740sub new { 741 my $class = shift; 742 ($type) = @_; 743 my $self = {}; 744 return bless $self, $class; 745} 746sub 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 763sub 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 772sub 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} 798sub 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} 831sub 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} 852sub 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} 893sub 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} 938sub 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} 948sub 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 966sub 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 989sub 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 996sub 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 1030sub 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 1087sub 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]] 1131sub 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 1212sub 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{ 1247package 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 1255my $option = 'main'; 1256my ($data_dir,$debug_dir,$debug_gz,$parse_src,$upload) = ('','','','',''); 1257my @content = (); 1258my $b_debug = 0; 1259my $b_delete_dir = 1; 1260# args: 1 - type 1261# args: 2 - upload 1262sub 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 1271sub 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 1316sub 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} 1352sub 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 1368sub 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 1396sub 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} 1481sub 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} 1561sub 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} 1571sub 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} 1613sub 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} 1714sub 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 1751sub 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 1762sub 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} 1791sub 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} 1822sub 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 1847sub 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] 1882sub 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} 1931sub 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} 1940sub 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 1952sub 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} 1961sub 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} 1992sub 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 2027sub 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 2076sub 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 2127sub 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 2170sub 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 2232sub set_perl_downloader { 2233 my ($downloader) = @_; 2234 $downloader =~ s/perl/tiny/; 2235 return $downloader; 2236} 2237 2238#### ------------------------------------------------------------------- 2239#### ERROR HANDLER 2240#### ------------------------------------------------------------------- 2241 2242sub 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 2325sub 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{ 2340package CheckRecommends; 2341sub 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 2375sub 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} 2403sub 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 2545sub 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} 2906sub 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 2921sub 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} 2930sub 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 2950sub 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 2974sub 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 2984sub check_program { 2985 (grep { return "$_/$_[0]" if -e "$_/$_[0]"} @paths)[0]; 2986} 2987 2988sub 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 2998sub 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 ' ' 3008sub 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 3026sub 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 3040sub 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 3051sub 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 3072sub 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 3195sub 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> 3287sub 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 3302sub 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 3312sub 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. 3322sub 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. 3330sub 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 3351sub 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 3376sub 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 3439sub 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 3498sub 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! 3528sub 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 3556sub 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 4104sub 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 4448sub 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{ 4515package StartClient; 4516 4517# use warnings; 4518# use strict; 4519 4520my $ppid = ''; 4521my $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 4534sub 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 4551sub 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} 4604sub 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} 4690sub 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} 4717sub 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 4769sub 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 4813sub 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 4858sub 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} 4868sub 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 4876sub 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} 4887sub 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 4898sub 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 4908sub 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 4923sub 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 4940sub 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 4977sub 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 4987sub 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 5019sub 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} 5032sub 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 5044sub 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 5052sub 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 5110sub 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 5142sub 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 5153sub 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 5168sub 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. 5207sub 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 5235sub key { 5236 return sprintf("%03d#%s", $_[0],$_[1]); 5237} 5238 5239sub 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. 5325sub 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 5525sub 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{ 5569package AudioData; 5570 5571sub 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 5606sub 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. 5655sub 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} 5691sub 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 5789sub 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{ 5824package BatteryData; 5825my (@upower_items,$b_upower,$upower); 5826sub 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 5897sub 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 6029sub 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 6139sub 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} 6187sub 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{ 6220package CpuData; 6221 6222sub 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} 6236sub 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} 6398sub 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} 6419sub 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 6464sub 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 6490sub 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 6747sub 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 6880sub 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} 7139sub 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} 7163sub 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 7223sub 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} 7237sub 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 7274sub 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} 7292sub 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} 7305sub 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 7324sub 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 7470sub 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} 7482sub 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 7508sub 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} 7516sub 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} 7527sub 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{ 7541package DiskData; 7542my ($b_hddtemp,$b_nvme); 7543my ($hddtemp,$nvme) = ('',''); 7544my (@by_id,@by_path); 7545 7546sub 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} 7600sub 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} 7698sub 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} 7732sub 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} 7790sub 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; 7948sub 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] 8041sub 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} 8077sub 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} 8138sub 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 8169sub 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 8198sub 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 8321sub 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} 8361sub 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 8425sub 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} 8445sub 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{ 8460package GraphicData; 8461my $driver = ''; # we need this as a fallback in case no xorg.0.log 8462sub 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 8507sub 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} 8555sub 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} 8741sub 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} 8861sub 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} 8881sub 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} 8972sub 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 9001sub 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{ 9057package MachineData; 9058 9059sub 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 9117sub 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} 9242sub 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 9279sub 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. 9342sub 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: 9416sub 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 9522sub 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 9568sub 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 9610sub 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{ 9688package NetworkData; 9689my ($b_ip_run,@ifs_found); 9690sub 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) 9743sub 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} 9829sub 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} 9924sub 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} 10027sub 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 10096sub 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 10185sub 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 10232sub 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} 10257sub 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{ 10266package OpticalData; 10267 10268sub 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} 10307sub 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} 10397sub 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} 10503sub 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{ 10602package PartitionData; 10603 10604sub 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} 10622sub 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 10684sub 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 10852sub 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} 10915sub 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 10942sub 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} 10969sub 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} 10989sub 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} 11018sub 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} 11035sub 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 11055sub 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} 11070sub 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 11096sub 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{ 11115package ProcessData; 11116 11117sub 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} 11131sub 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} 11179sub 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} 11228sub 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} 11245sub 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{ 11260package RaidData; 11261# debugger switches 11262my ($b_md,$b_zfs); 11263 11264sub 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} 11286sub 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} 11514sub 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 11544sub 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} 11574sub 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 11671sub 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} 11793sub 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} 11844sub 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{ 11863package RamData; 11864 11865sub 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 11898sub 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 11976sub 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} 12190sub 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} 12348sub 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} 12373sub 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{ 12401package RepoData; 12402 12403# easier to keep these package global, but undef after done 12404my (@dbg_files,$debugger_dir); 12405my $num = 0; 12406sub 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} 12433sub 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} 12891sub 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} 13002sub 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} 13076sub 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 13083sub url_cleaner { 13084 my (@content) = @_; 13085 @content = map { $_ =~ s/:\//: \//; $_} @content if $b_irc; 13086 return @content; 13087} 13088sub 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{ 13101package SensorData; 13102my (@sensors_data); 13103my ($b_ipmi) = (0); 13104sub 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} 13158sub 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} 13301sub 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} 13465sub 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! 13657sub 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} 13676sub 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 13689sub 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} 13935sub 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{ 14061package SlotData; 14062 14063sub 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} 14085sub 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{ 14154package UnmountedData; 14155 14156sub 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} 14186sub 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} 14220sub 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} 14271sub 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} 14298sub 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{ 14334package UsbData; 14335 14336sub 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} 14367sub 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} 14493sub 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{ 14505package WeatherData; 14506 14507sub 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} 14515sub 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} 14594sub 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} 14619sub 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} 14644sub 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} 14703sub 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} 14892sub 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 14987sub 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 15000sub 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 15027sub 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{ 15058package DesktopEnvironment; 15059my ($b_xprop,$desktop_session,$kde_session_version,$xdg_desktop,@desktop,@data,@xprop); 15060sub 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} 15089sub 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} 15165sub 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} 15234sub 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} 15283sub 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} 15397sub 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 15453sub 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 15489sub 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} 15499sub 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} 15534sub 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} 15555sub 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 15579sub 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} 15645sub 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 15665sub 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 15687sub 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{ 15744package DistroData; 15745my (@distro_data,@osr); 15746sub 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 15758sub 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 15778sub 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 16019sub 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} 16065sub 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. 16150sub 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} 16176sub 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 16206sub 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 16221sub 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 16228sub 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 16251sub 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 16337sub 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 16358sub 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 16370sub 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 16384sub 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 .... 16428sub 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 16510sub 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 16535sub 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? 16555sub 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. 16570sub 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 16601sub 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 16613sub 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 16664sub 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 16716sub 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 16730sub 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 16744sub 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 16760sub 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 16778sub 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 16800sub 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 16830sub 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 16880sub 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 16908sub 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. 16966sub 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 16974sub 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 17037sub 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 17048sub 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 17101sub 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 17202sub 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 17240sub 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 17325sub 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] 17427sub 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} 17492sub 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} 17515sub 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 17566sub 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 17609sub 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 17627sub 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 17660sub 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 17745sub 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 17821sub 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 17832sub 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 17960sub 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 17996sub 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 18090sub 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 18215sub 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 18315main(); ## 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**### 18319