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
9 ## License: GNU GPL v3 or greater
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/>.
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
22 use Cwd qw(abs_path); # qw(abs_path);#abs_path realpath getcwd
23 use Data::Dumper qw(Dumper); # print_r
25 use Getopt::Long qw(GetOptions);
26 # Note: default auto_abbrev is enabled, that's fine
27 Getopt::Long::Configure ('bundling', 'no_ignore_case',
28 'no_getopt_compat', 'no_auto_abbrev','pass_through');
29 use POSIX qw(uname strftime ttyname);
30 # use feature qw(state);
34 my $self_version='3.0.18';
35 my $self_date='2018-07-16';
39 ### INITIALIZE VARIABLES ###
42 my ($self_path, $user_config_dir, $user_config_file,$user_data_dir);
46 my (@t0,$end,$start,$fh_l,$log_file); # log file handle, file
47 my ($b_hires,$t1,$t2,$t3) = (0,0,0,0);
48 # NOTE: redhat removed HiRes from Perl Core Modules.
49 if (eval {require Time::HiRes}){
50 Time::HiRes->import('gettimeofday','tv_interval','usleep');
53 @t0 = eval 'Time::HiRes::gettimeofday()' if $b_hires; # let's start it right away
55 my ( %alerts,%client,%colors,%dl,%files,%rows,%system_files,%use );
58 # ps_aux is full output, ps_cmd is only the last 10 columns to last
59 my (@app,@dmesg_boot,@dmi,@gpudata,@ifs,@ifs_bsd,@paths,@pci,@ps_aux,
60 @ps_cmd,@ps_gui,@sysctl,@sysctl_battery,@sysctl_sensors,@sysctl_machine,
63 my (@dm_boot_disk,@dm_boot_optical,@glabel,@gpart,@hardware_raid,@labels,
64 @lsblk,@partitions,@raid,@sysctl_disks,@uuids);
65 my @test = (0,0,0,0,0);
68 my ($b_admin,$b_arm,$b_console_irc,$b_debug_gz,$b_debug_timers,
69 $b_display,$b_dmesg_boot_check,
70 $b_dmi,$b_dmidecode_force,$b_fake_bsd,$b_fake_dboot,$b_fake_pciconf,
71 $b_fake_sysctl,$b_fake_usbdevs,$b_force_display,$b_gpudata,$b_irc,
72 $b_log,$b_log_colors,$b_log_full,$b_man,$b_mem,$b_mips,$b_pci,$b_pci_tool,
73 $b_proc_debug,$b_ps_gui,$b_root,$b_running_in_display,$b_slot_tool,
74 $b_soc_audio,$b_soc_gfx,$b_soc_net,$b_sudo,$b_sysctl,$b_usb_check,$b_wmctrl);
76 my ($b_dm_boot_disk,$b_dm_boot_optical,$b_glabel,$b_hardware_raid,
77 $b_label_uuid,$b_lsblk,$b_partitions,$b_raid);
78 my ($b_sysctl_disk,$b_update,$b_weather) = (1,1,1);
81 my ($bsd_type,$language,$os) = ('','','');
82 my ($bits_sys,$cpu_arch);
83 my ($cpu_sleep,$dl_timeout,$limit,$ps_count,$usb_level) = (0.35,4,10,5,0);
84 my $sensors_cpu_nu = 0;
85 my $weather_unit='mi';
88 my ($display,$ftp_alt,$tty_session);
89 my ($display_opt,$sudo) = ('','');
92 my $extra = 0;# supported values: 0-3
93 my $filter_string = '<filter>';
94 my $line1 = "----------------------------------------------------------------------\n";
95 my $line2 = "======================================================================\n";
96 my $line3 = "----------------------------------------\n";
97 my ($output_file,$output_type) = ('','screen');
98 my $prefix = 0; # for the primiary row hash key prefix
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.
110 my %show = ('host' => 1);
114 # Default indentation level. NOTE: actual indent is 1 greater to allow for
118 'irc' => 100, # shorter because IRC clients have nick lists etc
121 # these will be set dynamically in set_display_width()
127 $client{'test-konvi'} = 0;
129 ########################################################################
131 ########################################################################
133 #### -------------------------------------------------------------------
135 #### -------------------------------------------------------------------
138 # print Dumper \@ARGV;
139 eval $start if $b_log;
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);
149 set_debugger(); # right after so it's set
153 # print download_file('stdout','https://') . "\n";
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..
162 #### -------------------------------------------------------------------
164 #### -------------------------------------------------------------------
174 set_display_width('live');
178 my ($action,$program,$message,@data,%commands,%hash);
181 if ($program = check_program('dmidecode')) {
182 @data = grabber("$program -t chassis -t baseboard -t processor 2>&1");
183 if (scalar @data < 15){
186 if ($_ =~ /No SMBIOS/i){
190 elsif ($_ =~ /^\/dev\/mem: Operation/i){
195 $action = 'unknown-error';
201 if (grep { $_ =~ /^\/dev\/mem: Permission/i } @data){
202 $action = 'permissions';
205 $action = 'unknown-error';
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',
223 %alerts = (%alerts, %hash);
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){
230 %hash = ('lspci' => '-n',);
231 %commands = (%commands,%hash);
236 %hash = ('pciconf' => '-l',);
237 %commands = (%commands,%hash);
240 # note: there is a case of kernel.osrelease but it's a linux distro
241 %hash = ('sysctl' => 'kern.osrelease',);
242 %commands = (%commands,%hash);
245 foreach ( keys %commands ){
247 if ($program = check_program($_)) {
248 # > 0 means error in shell
249 #my $cmd = "$program $commands{$_} >/dev/null";
251 $action = 'permissions' if system("$program $commands{$_} >/dev/null 2>&1");
259 'missing' => "Missing system tool: $_. Output will be incomplete",
260 'permissions' => "Unable to run $_. Root required?",
263 %alerts = (%alerts, %hash);
267 if ( $show{'sensor'} ){
268 %commands = ('sensors' => 'linux',);
270 # note: lsusb ships in FreeBSD ports sysutils/usbutils
272 %hash = ('lsusb' => 'all',);
273 %commands = (%commands,%hash);
274 %hash = ('usbdevs' => 'bsd',);
275 %commands = (%commands,%hash);
277 if ($show{'ip'} || ($bsd_type && $show{'network-advanced'})){
282 %commands = (%commands,%hash);
284 foreach ( keys %commands ){
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';
291 elsif (!check_program($_)){
292 $message = "Required tool $_ not installed. Check --recommends";
298 'missing' => $message,
299 'platform' => $message,
302 %alerts = (%alerts, %hash);
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;
316 set_fake_tools() if $b_fake_bsd;
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
323 ### LOCALIZATION - DO NOT CHANGE! ###
324 # set to default LANG to avoid locales errors with , or .
325 # Make sure every program speaks English.
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;
335 $dl{'tiny'} = 1; # note: two modules needed, tested for in set_downloader
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;
349 # args: $1 - default OR override default cols max integer count. $_[0]
350 # is the display width override.
351 sub set_display_width {
353 if ( $width eq 'live' ){
354 ## sometimes tput will trigger an error (mageia) if irc client
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'};
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/ ){
366 # we'll be using this for terminal dimensions later so don't set default.
367 # $size{'term-lines'}=100;
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'};
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'};
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
384 $size{'max'}=$size{'console'};
387 $size{'max'}=$size{'irc'};
393 # print "tc: $size{'term'} cmc: $size{'console'} cm: $size{'max'}\n";
396 # only for dev/debugging BSD
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',
410 # NOTE: most tests internally are against !$bsd_type
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)/){
421 elsif ($cpu_arch =~ /(alpha|64)/){
424 if ( $os =~ /(bsd|dragonfly|darwin)/ ){
425 if ( $os =~ /openbsd/ ){
428 elsif ($os =~ /darwin/){
431 if ($os =~ /kfreebsd/){
432 $bsd_type = 'debian-bsd';
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.
444 # Extra path variable to make execute failures less likely, merged below
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)/ ){
455 # print "paths: @paths\n";
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'};
466 $sep{'s1'} = $sep{'s1-irc'};
467 $sep{'s2'} = $sep{'s2-irc'};
471 $sep{'s1'} = $sep{'s1-console'};
472 $sep{'s2'} = $sep{'s2-console'};
477 my ( $b_conf, $b_data );
478 # this needs to be set here because various options call the parent
479 # initialize function directly.
481 $self_path =~ s/[^\/]+$//;
482 # print "0: $0 sp: $self_path\n";
484 if ( defined $ENV{'XDG_CONFIG_HOME'} && $ENV{'XDG_CONFIG_HOME'} ){
485 $user_config_dir=$ENV{'XDG_CONFIG_HOME'};
488 elsif ( -d "$ENV{'HOME'}/.config" ){
489 $user_config_dir="$ENV{'HOME'}/.config";
493 $user_config_dir="$ENV{'HOME'}/.$self_name";
495 if ( defined $ENV{'XDG_DATA_HOME'} && $ENV{'XDG_DATA_HOME'} ){
496 $user_data_dir="$ENV{'XDG_DATA_HOME'}/$self_name";
499 elsif ( -d "$ENV{'HOME'}/.local/share" ){
500 $user_data_dir="$ENV{'HOME'}/.local/share/$self_name";
504 $user_data_dir="$ENV{'HOME'}/.$self_name";
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";
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";
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";
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";
526 # args: 1: set|hash key to return either null or path
529 if ( $file eq 'set'){
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'
547 foreach ( keys %files ){
548 $system_files{$_} = ( -e $files{$_} ) ? $files{$_} : '';
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);
561 return $system_files{$file};
565 ########################################################################
567 ########################################################################
569 #### -------------------------------------------------------------------
571 #### -------------------------------------------------------------------
573 ## arg: 1 - the type of action, either integer, count, or full
574 sub get_color_scheme {
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)],
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)],
626 if ($type eq 'count' ){
627 return scalar @color_schemes;
629 if ($type eq 'full' ){
630 return @color_schemes;
633 return @{$color_schemes[$type]};
634 # print Dumper $color_schemes[$scheme_nu];
639 sub set_color_scheme {
640 eval $start if $b_log;
642 $colors{'scheme'} = $scheme;
643 my $index = ( $b_irc ) ? 1 : 0; # defaults to non irc
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" ],
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";
677 eval $start if $b_log;
678 # it's already been set with -c 0-43
679 if ( exists $colors{'c1'} ){
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();
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'};
698 if (defined $colors{'irc-virt-term'} && $b_display && $client{'console-irc'}){
699 $color_scheme = $colors{'irc-virt-term'};
701 elsif (defined $colors{'irc-console'} && !$b_display){
702 $color_scheme = $colors{'irc-console'};
704 elsif ( defined $colors{'irc-gui'}) {
705 $color_scheme = $colors{'irc-gui'};
709 if (defined $colors{'console'} && !$b_display){
710 $color_scheme = $colors{'console'};
712 elsif (defined $colors{'virt-term'}){
713 $color_scheme = $colors{'virt-term'};
717 # force 0 for | or > output, all others prints to irc or screen
718 if (!$b_irc && ! -t STDOUT ){
721 set_color_scheme($color_scheme);
727 package SelectColors;
734 my (@data,@rows,%configs,%status);
736 my $safe_color_count = 12; # null/normal + default color group
744 return bless $self, $class;
747 eval $start if $b_log;
749 main::set_color_scheme(0);
752 create_color_selections();
754 main::check_config_file();
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';
772 sub assign_selectors {
774 $configs{'variable'} = 'CONSOLE_COLOR_SCHEME';
775 $configs{'selection'} = 'console';
778 $configs{'variable'} = 'VIRT_TERM_COLOR_SCHEME';
779 $configs{'selection'} = 'virt-term';
782 $configs{'variable'} = 'IRC_COLOR_SCHEME';
783 $configs{'selection'} = 'irc-gui';
786 $configs{'variable'} = 'IRC_X_TERM_COLOR_SCHEME';
787 $configs{'selection'} = 'irc-virt-term';
790 $configs{'variable'} = 'IRC_CONS_COLOR_SCHEME';
791 $configs{'selection'} = 'irc-console';
794 $configs{'variable'} = 'GLOBAL_COLOR_SCHEME';
795 $configs{'selection'} = 'global';
799 my $whoami = getpwuid($<) || "unknown???";
802 [ 0, '', '', "Welcome to $self_name! Please select the default
803 $configs{'selection'} color scheme."],
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"],
819 [ 0, '', '', "Please note that this will set the $configs{'selection'}
820 preferences only for user: $whoami"],
825 [ 0, '', '', "$line1"],
828 main::print_basic(@data);
831 sub create_color_selections {
832 my $spacer = '^^'; # printer removes double spaces, but replaces ^ with ' '
833 $count = ( main::get_color_scheme('count') - 1 );
834 for my $i (0 .. $count){
838 if ($configs{'selection'} =~ /^global|irc-gui|irc-console|irc-virt-term$/ && $i > $safe_color_count ){
841 main::set_color_scheme($i);
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'}"],
848 main::print_basic(@data);
850 main::set_color_scheme(0);
853 my $number = $count + 1;
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'}"],
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"],
874 main::print_basic(@data);
876 my $response = <STDIN>;
878 if ($response =~ /([^0-9]|^$)/ || ( $response =~ /^[0-9]+$/ && $response > ($count + 3) )){
880 [0, '', '', "Error - Invalid Selection. You entered this: $response. Hit <ENTER> to continue."],
881 [0, '', '', "$line1"],
883 main::print_basic(@data);
884 my $response = <STDIN>;
886 create_color_selections();
890 process_selection($response);
893 sub process_selection {
894 my $response = shift;
895 if ($response == ($count + 3) ){
896 @data = ([0, '', '', "Ok, exiting $self_name now. You can set the colors later."],);
897 main::print_basic(@data);
900 elsif ($response == ($count + 2)){
902 [0, '', '', "Ok, continuing $self_name unchanged."],
903 [0, '', '', "$line1"],
905 main::print_basic(@data);
906 if ( defined $colors{'console'} && !$b_display ){
907 main::set_color_scheme($colors{'console'});
909 if ( defined $colors{'virt-term'} ){
910 main::set_color_scheme($colors{'virt-term'});
913 main::set_color_scheme($colors{'default'});
916 elsif ($response == ($count + 1)){
918 [0, '', '', "Removing all color settings from config file now..."],
919 [0, '', '', "$line1"],
921 main::print_basic(@data);
922 delete_all_config_colors();
923 main::set_color_scheme($colors{'default'});
926 main::set_color_scheme($response);
928 [0, '', '', "Updating config file for $configs{'selection'} color scheme now..."],
929 [0, '', '', "$line1"],
931 main::print_basic(@data);
932 if ($configs{'selection'} eq 'global'){
933 delete_all_config_colors();
935 set_config_color_scheme($response);
938 sub delete_all_config_colors {
939 my @file_lines = main::reader( $user_config_file );
940 open( $w_fh, '>', $user_config_file ) or error_handler('open', $user_config_file, $!);
941 foreach ( @file_lines ) {
942 if ( $_ !~ /^(CONSOLE_COLOR_SCHEME|GLOBAL_COLOR_SCHEME|IRC_COLOR_SCHEME|IRC_CONS_COLOR_SCHEME|IRC_X_TERM_COLOR_SCHEME|VIRT_TERM_COLOR_SCHEME)/){
948 sub set_config_color_scheme {
950 my @file_lines = main::reader( $user_config_file );
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";
961 print $w_fh "$configs{'variable'}=$value\n";
966 sub print_irc_message {
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'})"]
979 main::print_basic(@data);
985 #### -------------------------------------------------------------------
987 #### -------------------------------------------------------------------
989 sub check_config_file {
990 $user_config_file = "$user_config_dir/$self_name.conf";
991 if ( ! -f $user_config_file ){
992 open( my $fh, '>', $user_config_file ) or error_handler('create', $user_config_file, $!);
998 my ($key, $val,@config_files);
1001 qq(/etc/$self_name.conf),
1002 qq($user_config_dir/$self_name.conf)
1006 @config_files = (@configs);
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, '<', "$_");
1018 s/true/1/; # switch to 1/0 perl boolean
1019 s/false/0/; # switch to 1/0 perl boolean
1021 ($key, $val) = split(/\s*=\s*/, $_, 2);
1022 get_config_item($key,$val);
1023 # print "f: $file key: $key val: $val\n";
1029 # args: 0: key; 1: value
1030 sub get_config_item {
1031 my ($key,$val) = @_;
1032 if ($key eq 'ALLOW_UPDATE' || $key eq 'B_ALLOW_UPDATE') {$b_update = int($val)}
1033 elsif ($key eq 'ALLOW_WEATHER' || $key eq 'B_ALLOW_WEATHER') {$b_weather = int($val)}
1034 elsif ($key eq 'CPU_SLEEP') {$cpu_sleep = $val if $val =~ /^[0-9\.]$/}
1035 elsif ($key eq 'DL_TIMEOUT') {$dl_timeout = int($val)}
1036 elsif ($key eq 'DOWNLOADER') {
1037 if ($val =~ /^(curl|fetch|ftp|perl|wget)$/){
1038 # this dumps all the other data and resets %dl for only the
1039 # desired downloader.
1040 $val = set_perl_downloader($val);
1041 %dl = ('dl' => $val, $val => 1);
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;
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}
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";
1080 #### -------------------------------------------------------------------
1082 #### -------------------------------------------------------------------
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,
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";
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;
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", "$!");
1105 # then copy initial to second
1106 rename $log_file, $log_file_2 or error_handler('rename', "$log_file -> $log_file_2", "$!");
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
1113 $data .= "START $self_name LOGGING:\n";
1114 $data .= "NOTE: HiRes timer not available.\n" if !$b_hires;
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";
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
1129 # arg: $one type (fs/fe/cat/dump/raw) or logged data;
1130 # [$two is function name; [$three - function args]]
1133 my ($one, $two, $three) = @_;
1134 my ($args,$data,$timer) = ('','','');
1136 # print "1: $one 2: $two 3: $three\n";
1138 if (ref $three eq 'ARRAY'){
1140 # print Data::Dumper::Dumper \@$three;
1141 $args = "\n${spacer}Args: " . joiner($three, '; ', 'unset');
1144 $args = "\n${spacer}Args: None";
1146 # $t1 = [gettimeofday];
1147 #$t3 = tv_interval ($t0, [gettimeofday]);
1148 $t3 = eval 'Time::HiRes::tv_interval(\@t0, [Time::HiRes::gettimeofday()])' if $b_hires;
1150 $data = "Start: Function: $two$args\n${spacer}Elapsed: $t3\n";
1152 $timer = $data if $b_debug_timers;
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;
1159 $data = "${spacer}Elapsed: $t3\nEnd: Function: $two\n";
1161 $timer = $data if $b_debug_timers;
1163 elsif ( $one eq 'cat') {
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";
1172 elsif ($one eq 'cmd'){
1173 $data = "Command: $two\n";
1176 elsif ($one eq 'data'){
1179 elsif ( $one eq 'dump') {
1181 if (ref $three eq 'HASH'){
1182 $data .= Data::Dumper::Dumper \%$three;
1184 elsif (ref $three eq 'ARRAY'){
1185 # print Data::Dumper::Dumper \@$three;
1186 $data .= Data::Dumper::Dumper \@$three;
1189 $data .= Data::Dumper::Dumper $three;
1194 elsif ( $one eq 'raw') {
1196 $data = "\n${line3}Raw System Data:\n\n$two\n$line3";
1203 if ($b_debug_timers){
1204 print $timer if $timer;
1208 print $fh_l "$spacer$data";
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;
1222 elsif ($debug >= 10 && $debug <= 12){
1227 elsif ($debug == 12){
1232 elsif ($debug <= 3){
1235 $b_debug_timers = 1;
1247 package SystemDebugger;
1249 # use File::Find q(find);
1250 #no warnings 'File::Find';
1251 # use File::Spec::Functions;
1253 #use POSIX qw(strftime);
1255 my $option = 'main';
1256 my ($data_dir,$debug_dir,$debug_gz,$parse_src,$upload) = ('','','','','');
1259 my $b_delete_dir = 1;
1267 # print "$option\n";
1268 return bless $self, $class;
1274 require File::Spec::Functions;
1275 import File::Spec::Functions;
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;
1292 if ( -d '/sys' && main::count_dir_files('/sys') ){
1294 sys_traverse_data();
1297 print "Skipping /sys data collection. /sys not present, or empty.\n";
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') ){
1304 proc_traverse_data();
1307 print "Skipping /proc data collection. /proc not present, or empty.\n";
1316 sub create_debug_directory {
1317 my $host = main::get_hostname();
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;
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";}
1331 my $today = "$year-$mon-${mday}_$hour$min$sec";
1332 # my $date = strftime "-%Y-%m-%d_", localtime;
1334 $root_string = '-root';
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", "$!");
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");
1350 print "Data going into:\n$data_dir\n";
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";
1363 print "Directory removed.\n";
1366 # NOTE: incomplete, don't know how to ever find out
1367 # what sound server is actually running, and is in control
1369 my (%data,@files,@files2);
1370 print "Collecting audio data...\n";
1372 ['aplay', '-l'], # alsa
1373 ['pactl', 'list'], # pulseaudio
1375 run_commands(\@cmds,'audio');
1376 @files = main::globber('/proc/asound/card*/codec*');
1378 my $asound = qx(head -n 1 /proc/asound/card*/codec* 2>&1);
1379 $data{'proc-asound-codecs'} = $asound;
1382 $data{'proc-asound-codecs'} = undef;
1385 write_data(\%data,'audio');
1387 '/proc/asound/cards',
1388 '/proc/asound/version',
1390 @files2 = main::globber('/proc/asound/*/usbid');
1391 @files = (@files,@files2) if @files2;
1392 copy_files(\@files,'audio');
1394 ## NOTE: >/dev/null 2>&1 is sh, and &>/dev/null is bash, fix this
1395 # ls -w 1 /sysrs > tester 2>&1
1397 my (%data,@files,@files2);
1398 print "Collecting dev, label, disk, uuid data, df...\n";
1406 '/proc/sys/dev/cdrom/info',
1409 if (-d '/proc/ide/'){
1410 my @ides = main::globber('/proc/ide/*/*');
1411 @files = (@files, @ides) if @ides;
1414 push (@files, '/proc-ide-directory');
1416 copy_files(\@files, 'disk');
1418 ['btrfs', 'filesystem show'],
1419 ['btrfs', 'filesystem show --mounted'],
1420 # ['btrfs', 'filesystem show --all-devices'],
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'],
1443 ['gpart', 'status'],
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', ''],
1461 ['nvme', 'present'],
1462 ['readlink', '/dev/root'],
1468 ['zpool', 'list -v'],
1470 run_commands(\@cmds,'disk');
1472 ['atacontrol', 'list'],
1473 ['camcontrol', 'devlist'],
1474 ['glabel', 'status'],
1475 ['swapctl', '-l -k'],
1476 ['swapctl', '-l -k'],
1479 run_commands(\@cmds,'disk-bsd');
1482 my (%data,@files,@files2);
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");
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");
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/*");
1497 @files = ('/xorg-conf-d');
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";
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'},
1525 write_data(\%data,'display');
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'],
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'],
1553 ['weston','--version'],
1555 ['Xorg','-version'],
1559 run_commands(\@cmds,'display');
1562 print "Collecting networking data...\n";
1563 # no warnings 'uninitialized';
1569 run_commands(\@cmds,'network');
1572 print "Collecting Perl module data (this can take a while)...\n";
1574 my ($dirname,$holder,$mods,$value) = ('','','','');
1575 my $filename = 'perl-modules.txt';
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";
1585 $value .= "ABSENT: $_\n";
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);
1595 $dir =~ s/[^\/]+$//;
1596 if (!$holder || $holder ne $dir ){
1598 $value = "DIR: $dir\n";
1604 $value =~ s/^$dir//;
1605 $value = " $value\n";
1609 open (my $fh, '>', "$data_dir/$filename");
1614 print "Collecting system data...\n";
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'},
1626 my @files = main::globber('/usr/bin/gcc*');
1628 $data{'gcc-versions'} = join "\n",@files;
1631 $data{'gcc-versions'} = undef;
1633 @files = main::globber('/sys/*');
1635 $data{'sys-tree-ls-1-basic'} = join "\n", @files;
1638 $data{'sys-tree-ls-1-basic'} = undef;
1640 write_data(\%data,'system');
1641 # bsd tools http://cb.vu/unixtoolbox.xhtml
1644 ['sysctl', '-b kern.geom.conftxt'],
1645 ['sysctl', '-b kern.geom.confxml'],
1648 ['pciconf','-l -cv'],
1657 ['pcictl','list -ns'],
1659 run_commands(\@cmds,'system-bsd');
1660 # diskinfo -v <disk>
1663 ['clang','--version'],
1666 ['gcc','--version'],
1669 ['ipmi-sensors',''],
1670 ['ipmi-sensors','--output-sensor-thresholds'],
1671 ['ipmitool','sensor'],
1678 ['lspci','-nnkv'],# returns ports
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'],
1702 ['systemctl','list-units'],
1703 ['systemctl','list-units --type=target'],
1704 ['systemd-detect-virt',''],
1707 ['vcgencmd','get_mem arm'],
1708 ['vcgencmd','get_mem gpu'],
1710 run_commands(\@cmds,'system');
1711 @files = main::globber('/dev/bus/usb/*/*');
1712 copy_files(\@files, 'system');
1715 print "Collecting system files data...\n";
1716 my (%data,@files,@files2);
1717 @files = RepoData::get($data_dir);
1718 copy_files(\@files, 'repo');
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');
1735 @files2=main::globber('/sys/class/power_supply/*/uevent');
1737 @files = (@files,@files2);
1740 push (@files, '/sys-class-power-supply-empty');
1742 copy_files(\@files, 'system');
1746 '/var/run/dmesg.boot',
1748 copy_files(\@files,'system-bsd');
1750 ## SELF EXECUTE FOR LOG/OUTPUT
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";
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");
1761 ## UTILITIES COPY/CMD/WRITE
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) {
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);
1783 main::toucher($unreadable);
1787 main::toucher($absent);
1792 my ($cmds,$type) = @_;
1794 my ($name,$cmd,$args);
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);
1804 $args =~ s/\s|--|\/|=/-/g; # for:
1805 $args =~ s/--/-/g;# strip out -- that result from the above
1807 $args = "-$args" if $args;
1808 $name = "$data_dir/$type-cmd-$rows[0]$args.txt";
1809 $cmd = "$program $rows[1] >$name 2>&1";
1814 if ($holder ne $rows[0]){
1815 $name = "$data_dir/$type-cmd-$rows[0]-absent";
1816 main::toucher($name);
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);
1838 main::toucher($empty);
1842 main::toucher($undefined);
1846 ## TOOLS FOR DIRECTORY TREE/LS/TRAVERSE; UPLOADER
1849 if ( $which eq 'sys' && main::check_program('tree') ){
1850 print "Constructing /$which tree data...\n";
1851 my $dirname = '/sys';
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;
1859 $cmd = "tree -a -L 10 $dirname/$_ > $data_dir/sys-data-tree-$_-10.txt";
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);
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
1876 #directory_ls('proc',3,'[a-z]');
1877 #directory_ls('proc',4,'[a-z]');
1881 # include is basic regex for ls path syntax, like [a-z]
1883 my ( $dir,$depth,$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';
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" }
1899 my $result = qx($cmd);
1900 open my $ch, '<', \$result or main::error_handler('open-data',"$cmd", "$!");
1901 while ( my $line = <$ch> ){
1903 $line =~ s/^\s+|\s+$//g;
1904 @working = split /\s+/, $line;
1906 if ( scalar @working > 7 ){
1907 if ($working[0] =~ /^d/ ){
1910 elsif ($working[0] =~ /^l/){
1917 $working[10] ||= '';
1918 $output = $output . " $type$working[8] $working[9] $working[10]\n";
1920 elsif ( $working[0] !~ /^total/ ){
1921 $output = $output . $line . "\n";
1925 my $file = "$data_dir/$dir-data-ls-$depth.txt";
1926 open my $fh, '>', $file or main::error_handler('create',"$file", "$!");
1929 # print "$output\n";
1931 sub proc_traverse_data {
1932 print "Building /proc file list...\n";
1933 # get rid pointless error:Can't cd to (/sys/kernel/) debug: Permission denied
1934 no warnings 'File::Find';
1935 $parse_src = 'proc';
1936 File::Find::find( \&wanted, "/proc");
1937 proc_traverse_processor();
1940 sub proc_traverse_processor {
1941 my ($data,$fh,$result,$row,$sep);
1942 my $proc_dir = "$data_dir/proc";
1943 print "Adding /proc files...\n";
1944 mkdir $proc_dir or main::error_handler('mkdir', "$proc_dir", "$!");
1945 # @content = sort @content;
1946 copy_files(\@content,'proc',$proc_dir);
1947 # foreach (@content){
1952 sub sys_traverse_data {
1953 print "Building /sys file list...\n";
1954 # get rid pointless error:Can't cd to (/sys/kernel/) debug: Permission denied
1955 no warnings 'File::Find';
1957 File::Find::find( \&wanted, "/sys");
1958 sys_traverse_processsor();
1961 sub sys_traverse_processsor {
1962 my ($data,$fh,$result,$row,$sep);
1963 my $filename = "sys-data-parse.txt";
1964 print "Parsing /sys files...\n";
1965 # no sorts, we want the order it comes in
1966 # @content = sort @content;
1971 open($fh, '<', $_) or $b_fh = 0;
1972 # needed for removing -T test and root
1974 while ($row = <$fh>) {
1976 $data .= $sep . '"' . $row . '"';
1981 $data = '<unreadable>';
1983 $result .= "$_:[$data]\n";
1984 # print "$_:[$data]\n"
1986 # print scalar @content . "\n";
1987 open ($fh, '>', "$data_dir/$filename");
1990 # print $fh "$result";
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()
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)$/;
2020 # print $File::Find::name . "\n";
2021 push (@content, $File::Find::name);
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
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";
2039 $domain =~ s/^ftp\.//;
2040 $user = "anonymous";
2041 $pass = "anonymous\@$domain";
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";
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);
2054 print "Connected to FTP server.\n";
2055 $ftp->put($file_path) || main::error_handler('ftp-upload', $ftp->message);
2057 print "Uploaded file successfully!\n";
2058 print $ftp->message;
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";
2064 print "Debugger data generation and upload completed. Thank you for your help.\n";
2067 main::error_handler('ftp-bad-path', "$file_path");
2072 #### -------------------------------------------------------------------
2074 #### -------------------------------------------------------------------
2077 my ($type, $url, $file) = @_;
2078 my ($cmd,$args,$timeout) = ('','','');
2079 my $debug_data = '';
2081 $dl{'no-ssl-opt'} ||= '';
2082 $dl{'spider'} ||= '';
2083 $file ||= 'N/A'; # to avoid debug error
2087 if ($dl{'timeout'}){
2088 $timeout = "$dl{'timeout'}$dl_timeout";
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.';
2099 # But: 0 is success, and 1 is false for these
2100 # when strings are returned, they will be taken as true
2102 if ($type eq 'stdout'){
2103 $args = $dl{'stdout'};
2104 $cmd = "$dl{'dl'} $dl{'no-ssl-opt'} $timeout $args $url $dl{'null'}";
2106 $debug_data = ($result) ? 'Success: stdout data not null.' : 'Download resulted in null data!';
2108 elsif ($type eq 'file') {
2109 $args = $dl{'file'};
2110 $cmd = "$dl{'dl'} $dl{'no-ssl-opt'} $timeout $args $file $url $dl{'null'}";
2112 $result = ($?) ? 0 : 1; # reverse these into Perl t/f
2113 $debug_data = $result;
2115 elsif ( $dl{'dl'} eq 'wget' && $type eq 'spider'){
2116 $cmd = "$dl{'dl'} $dl{'no-ssl-opt'} $timeout $dl{'spider'} $url";
2118 $result = ($?) ? 0 : 1; # reverse these into Perl t/f
2119 $debug_data = $result;
2122 print "-------\nDownloader Data:\n$cmd\nResult: $debug_data\n" if $test[1];
2123 log_data('data',"$cmd\nResult: $result") if $b_log;
2128 my ($type, $url, $file) = @_;
2129 my $response = HTTP::Tiny->new->get($url);
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];
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) {
2155 if ( $type eq "stdout" || $type eq "ua-stdout" ){
2156 $return = $response->{content};
2158 elsif ($type eq "spider"){
2159 # do nothing, just use the return value
2161 elsif ($type eq "file"){
2162 open($fh, ">", $file);
2163 print $fh $response->{content}; # or die "can't write to file!\n";
2170 sub set_downloader {
2171 eval $start if $b_log;
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
2179 if (check_module('HTTP::Tiny') && check_module('IO::Socket::SSL')){
2181 import IO::Socket::SSL;
2188 #print $dl{'tiny'} . "\n";
2193 $dl{'timeout'} = '';
2195 elsif ( $dl{'curl'} && check_program('curl') ){
2197 $dl{'file'} = ' -L -s -o ';
2198 $dl{'no-ssl'} = ' --insecure';
2199 $dl{'stdout'} = ' -L -s ';
2200 $dl{'timeout'} = ' -y ';
2202 elsif ($dl{'wget'} && check_program('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 ';
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 ';
2217 elsif ( $bsd_type eq 'openbsd' && check_program('ftp') ){
2219 $dl{'file'} = ' -o ';
2220 $dl{'null'} = ' 2>/dev/null';
2221 $dl{'stdout'} = ' -o - ';
2222 $dl{'timeout'} = '';
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;
2232 sub set_perl_downloader {
2233 my ($downloader) = @_;
2234 $downloader =~ s/perl/tiny/;
2238 #### -------------------------------------------------------------------
2240 #### -------------------------------------------------------------------
2243 eval $start if $b_log;
2244 my ( $err, $one, $two) = @_;
2245 my ($b_help,$b_recommends);
2246 my ($b_exit,$errno) = (1,0);
2248 if ( $err eq 'empty' ) { 'empty value' }
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" }
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" }
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!" }
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." }
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" }
2308 elsif ( $err eq 'required-module' ) {
2309 $errno=80; $b_recommends=1; "The required $one Perl module is not installed:\n$two" }
2312 $errno=255; "Error handler ERROR!! Unsupported options: $err!"}
2314 print_line("Error $errno: $message\n");
2316 print_line("Check -h for correct parameters.\n");
2319 print_line("See --recommends for more information.\n");
2321 eval $end if $b_log;
2325 sub error_defaults {
2326 my ($type,$one) = @_;
2329 'download-error' => "Download Failure:\n$one\n",
2331 return $errors{$type};
2334 #### -------------------------------------------------------------------
2336 #### -------------------------------------------------------------------
2340 package CheckRecommends;
2342 main::error_handler('not-in-irc', 'recommends') if $b_irc;
2344 my $line = make_line();
2346 @data = basic_data($line);
2349 @data = check_items('required system directories',$line,$pm);
2352 @data = check_items('recommended system programs',$line,$pm);
2354 @data = check_items('recommended display information programs',$line,$pm);
2356 @data = check_items('recommended downloader programs',$line,$pm);
2358 @data = check_items('recommended Perl modules',$line,$pm);
2360 @data = check_items('recommended directories',$line,'');
2362 @data = check_items('recommended files',$line,'');
2365 ['0', '', '', "$line"],
2366 ['0', '', '', "Ok, all done with the checks. Have a nice day."],
2370 #print Data::Dumper::Dumper \@rows;
2371 main::print_basic(@rows);
2378 my $client = $client{'name-print'};
2379 $client .= ' ' . $client{'version'} if $client{'version'};
2380 my $default_shell = 'N/A';
2382 $default_shell = $ENV{'SHELL'};
2383 $default_shell =~ s/.*\///;
2385 my $sh = main::check_program('sh');
2386 my $sh_real = Cwd::abs_path($sh);
2388 ['0', '', '', "$self_name will now begin checking for the programs it needs
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:" ],
2396 ['0', '', '', "Perl version: ^$]" ],
2397 ['0', '', '', "Current shell: " . $client ],
2398 ['0', '', '', "Default shell: " . $default_shell ],
2399 ['0', '', '', "sh links to: $sh_real" ],
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);
2411 $item = 'Directory';
2413 elsif ($type eq 'recommended system programs'){
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';
2420 @data = qw(dig dmidecode fdisk file hddtemp ifconfig ip ipmitool ipmi-sensors
2421 lsblk lsusb modinfo runlevel sensors strings sudo tree upower uptime);
2425 $extra2 = "Note: IPMI sensors are generally only found on servers. To access
2426 that data, you only need one of the ipmi items.";
2428 elsif ($type eq 'recommended display information programs'){
2430 @data = qw(glxinfo wmctrl xdpyinfo xprop xrandr);
2431 $info_os = 'info-bsd';
2434 @data = qw(glxinfo wmctrl xdpyinfo xprop xrandr);
2439 elsif ($type eq 'recommended downloader programs'){
2441 @data = qw(curl dig fetch ftp wget);
2442 $info_os = 'info-bsd';
2445 @data = qw(curl dig wget);
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.";
2457 elsif ($type eq 'recommended Perl modules'){
2458 @data = qw(HTTP::Tiny IO::Socket::SSL Time::HiRes Cpanel::JSON::XS JSON::XS XML::Dumper);
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.";
2467 elsif ($type eq 'recommended directories'){
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);
2476 $item = 'Directory';
2478 elsif ($type eq 'recommended files'){
2480 @data = qw(/var/run/dmesg.boot /var/log/Xorg.0.log);
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 );
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.";
2493 ['0', '', '', "$line" ],
2494 ['0', '', '', "Test: $type$extra:" ],
2495 ['0', '', '', " " ],
2498 $rows[scalar @rows] = (['0', '', '', $extra2]);
2499 $rows[scalar @rows] = (['0', '', '', ' ']);
2502 $rows[scalar @rows] = (['0', '', '', $extra3]);
2503 $rows[scalar @rows] = (['0', '', '', ' ']);
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';
2514 elsif ($b_file && -f $_){
2515 $result = 'Unreadable';
2516 push @unreadable, "$_";
2519 $result = 'Missing';
2520 $install = " ~ Install package: $info{$pm}" if (($b_program || $b_module) && $pm);
2521 push @missing, "$_$install";
2523 $row = make_row($_,$about,$result);
2524 $rows[scalar @rows] = (['0', '', '', $row]);
2526 $rows[scalar @rows] = (['0', '', '', " "]);
2528 $rows[scalar @rows] = (['0', '', '', "The following $type are missing$extra4:"]);
2529 foreach (@missing) {
2530 $rows[scalar @rows] = (['0', '', '', "$item: $_"]);
2534 $rows[scalar @rows] = (['0', '', '', "The following $type are not readable: "]);
2535 foreach (@unreadable) {
2536 $rows[scalar @rows] = (['0', '', '', "$item: $_"]);
2539 if (!@missing && !@unreadable){
2540 $rows[scalar @rows] = (['0', '', '', "All $type are present"]);
2549 '/sys/class/dmi/id' => ({
2550 'info' => '-M system, motherboard, bios',
2553 'info' => '-l,-u,-o,-p,-P,-D disk partition data',
2555 '/dev/disk/by-id' => ({
2556 'info' => '-D serial numbers',
2558 '/dev/disk/by-path' => ({
2559 'info' => '-D extra data',
2561 '/dev/disk/by-label' => ({
2562 'info' => '-l,-o,-p,-P partition labels',
2564 '/dev/disk/by-uuid' => ({
2565 'info' => '-u,-o,-p,-P partition uuid',
2574 '/etc/lsb-release' => ({
2575 'info' => '-S distro version data (older version)',
2577 '/etc/os-release' => ({
2578 'info' => '-S distro version data (newer version)',
2580 '/proc/asound/cards' => ({
2581 'info' => '-A sound card data',
2583 '/proc/asound/version' => ({
2584 'info' => '-A ALSA data',
2586 '/proc/cpuinfo' => ({
2587 'info' => '-C cpu data',
2589 '/proc/mdstat' => ({
2590 'info' => '-R mdraid data (if you use dm-raid)',
2592 '/proc/meminfo' => ({
2593 'info' => '-I,-tm, -m memory data',
2595 '/proc/modules' => ({
2596 'info' => '-G module data (sometimes)',
2598 '/proc/mounts' => ({
2599 'info' => '-P,-p partition advanced data',
2601 '/proc/scsi/scsi' => ({
2602 'info' => '-D Advanced hard disk data (used rarely)',
2604 '/var/log/Xorg.0.log' => ({
2605 'info' => '-G graphics driver load status',
2607 '/var/run/dmesg.boot' => ({
2608 'info' => '-D,-d disk data',
2611 # apt-dpkg,apt-get; pm-arch,pacman; rpm-redhat,suse
2613 'info' => '-i (if no dig); -w,-W; -U',
2614 'info-bsd' => '-i (if no dig); -w,-W; -U',
2621 'info-bsd' => '-R; -D; -P. Get actual gptid /dev path',
2627 'info' => '-i wlan IP',
2628 'info-bsd' => '-i wlan IP',
2629 'apt' => 'dnsutils',
2630 'pacman' => 'dnsutils',
2631 'rpm' => 'bind-utils',
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',
2641 'info' => '-D partition scheme (fallback)',
2642 'info-bsd' => '-D partition scheme',
2644 'pacman' => 'util-linux',
2645 'rpm' => 'util-linux',
2649 'info-bsd' => '-i (if no dig); -w,-W; -U',
2655 'info' => '-o unmounted file system (if no lsblk)',
2656 'info-bsd' => '-o unmounted file system',
2663 'info-bsd' => '-i (if no dig); -w,-W; -U',
2670 'info-bsd' => '-R; -D; -P. Get actual gptid /dev path',
2677 'info-bsd' => '-p,-P file system, size',
2683 'info' => 'Experimental',
2686 'pacman' => 'bluez-utils',
2687 'rpm' => 'bluez-utils',
2690 'info' => '-Dx show hdd temp',
2691 'info-bsd' => '-Dx show hdd temp',
2693 'pacman' => 'hddtemp',
2697 'info' => '-i ip LAN (deprecated)',
2698 'info-bsd' => '-i ip LAN',
2699 'apt' => 'net-tools',
2700 'pacman' => 'net-tools',
2701 'rpm' => 'net-tools',
2704 'info' => '-i ip LAN',
2707 'pacman' => 'iproute2',
2710 'ipmi-sensors' => ({
2711 'info' => '-s IPMI sensors (servers)',
2713 'apt' => 'freeipmi-tools',
2714 'pacman' => 'freeipmi',
2715 'rpm' => 'freeipmi',
2718 'info' => '-s IPMI sensors (servers)',
2719 'info-bsd' => '-s IPMI sensors (servers)',
2720 'apt' => 'ipmitool',
2721 'pacman' => 'ipmitool',
2722 'rpm' => 'ipmitool',
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',
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',
2739 'info' => 'Ax; -Nx module version',
2741 'apt' => 'module-init-tools',
2742 'pacman' => 'module-init-tools',
2743 'rpm' => 'module-init-tools',
2746 'info' => '-I fallback to Perl',
2748 'apt' => 'systemd or sysvinit',
2749 'pacman' => 'systemd',
2750 'rpm' => 'systemd or sysvinit',
2753 'info' => '-s sensors output',
2755 'apt' => 'lm-sensors',
2756 'pacman' => 'lm-sensors',
2757 'rpm' => 'lm-sensors',
2760 'info' => '-Dx show hdd temp',
2761 'info-bsd' => '-Dx show hdd temp',
2767 'info' => '-I sysvinit version',
2769 'apt' => 'binutils',
2775 'info-bsd' => '-C; -I; -m; -tm',
2781 'info' => '-Dx hddtemp-user; -o file-user',
2782 'info-bsd' => '-Dx hddtemp-user; -o file-user',
2788 'info' => '--debugger 20,21 /sys tree',
2789 'info-bsd' => '--debugger 20,21 /sys tree',
2795 'info' => '-sx attached device battery info',
2796 'info-bsd' => '-sx attached device battery info',
2798 'pacman' => 'upower',
2802 'info' => '-I uptime',
2803 'info-bsd' => '-I uptime',
2805 'pacman' => 'procps',
2810 'info-bsd' => '-A; -N; --usb;',
2811 'apt' => 'usbutils',
2812 'pacman' => 'usbutils',
2813 'rpm' => 'usbutils',
2816 'info' => '-i (if no dig); -w,-W; -U',
2817 'info-bsd' => '-i (if no dig); -w,-W; -U',
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)',
2831 'info' => '-S active window manager (fallback)',
2832 'info-bsd' => '-S active window managerr (fallback)',
2834 'pacman' => 'wmctrl',
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',
2845 'info' => '-S desktop data',
2846 'info-bsd' => '-S desktop data',
2847 'apt' => 'X11-utils',
2848 'pacman' => 'xorg-xprop',
2849 'rpm' => 'x11-utils',
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',
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',
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',
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',
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',
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',
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',
2902 my $ref = $data{$type};
2908 if (main::check_program('dpkg')){
2911 elsif (main::check_program('pacman')){
2914 elsif (main::check_program('rpm')){
2919 # note: end will vary, but should always be treated as longest value possible.
2920 # expected values: Present/Missing
2922 my ($start,$middle,$end) = @_;
2923 my ($dots,$line,$sep) = ('','',': ');
2924 foreach (0 .. ($size{'max'} - 16 - length("$start$middle"))){
2927 $line = "$start$sep$middle$dots $end";
2932 foreach (0 .. $size{'max'} - 2 ){
2939 #### -------------------------------------------------------------------
2941 #### -------------------------------------------------------------------
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
2951 eval $start if $b_log;
2952 my ($ref,$search,$num,$sep) = @_;
2954 # print "search: $search\n";
2955 return if ! @$ref || ! $search;
2959 $result =~ s/^\s+|\s+$//g;
2963 if ($result && defined $num){
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;
2969 eval $end if $b_log;
2973 # $1 - Perl module to check
2977 eval "require $module";
2978 $b_present = 1 if !$@;
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
2985 (grep { return "$_/$_[0]" if -e "$_/$_[0]"} @paths)[0];
2989 # maybe add in future: , $fh_c, $fh_j, $fh_x
2990 foreach my $fh ($fh_l){
2997 # returns count of files in directory, if 0, dir is empty
2998 sub count_dir_files {
2999 return unless -d $_[0];
3000 opendir my $dh, $_[0] or error_handler('open-dir-failed', "$_[0]", $!);
3001 my $count = grep { ! /^\.{1,2}/ } readdir $dh; # strips out . and ..
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 ' '
3009 eval $start if $b_log;
3010 my ($string, $num, $sep) = @_;
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;
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
3027 eval $start if $b_log;
3028 my ($cmd,$split,$strip) = @_;
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;
3035 eval $end if $b_log;
3039 # args: 1 - string value to glob
3041 eval $start if $b_log;
3042 my @files = <$_[0]>;
3043 eval $end if $b_log;
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
3052 my ($ref,$join,$default) = @_;
3058 $string .= $_ . $join;
3061 $string .= $default . $join;
3068 # 0 - match string; 1 - search number; 2 - version string; 3 - Print name
3069 # 4 - console 0/1; 5 - 0/1 exit version loop at first iteration;
3070 # 6 - 0/1 write to stderr
3071 # arg: 1 - program lower case name
3072 sub program_values {
3075 # note: setting index 1 and 2 to 0 will trip flags to not do version
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],
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],
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],
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],
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
3183 if ( defined $data{$app} ){
3184 my $ref = $data{$app};
3185 @client_data = @$ref;
3187 #my $debug = main::Dumper \@client_data;
3188 main::log_data('dump',"Client Data",\@client_data) if $b_log;
3189 return @client_data;
3192 # args: 1 - desktop/app command for --version; 2 - search string;
3193 # 3 - space print number; 4 - [optional] version arg: -v, version, etc
3194 # 5 - [optional] exit first find 0/1; 6 - [optional] 0/1 stderr output
3195 sub program_version {
3196 eval $start if $b_log;
3197 my ($app, $search, $num,$version,$exit,$b_stderr) = @_;
3198 my ($cmd,$line,$output);
3199 my $version_nu = '';
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');
3214 my @temp = split /\s+/, $ksh;
3216 $temp[2] =~ s/^v//i; # trim off leading v
3217 log_data('data',"Program *ksh array: @temp version: $temp[2]") if $b_log;
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) ){
3230 log_data('data',"$app not found in path.");
3234 # note, some wm/apps send version info to stderr instead of stdout
3236 $cmd = "$app $version 2>&1";
3238 # elsif ( $app eq 'csh' ){
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";
3246 $cmd = "$app $version 2>/dev/null";
3248 log_data('data',"version: $version num: $num search: $search command: $cmd") if $b_log;
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
3254 open my $ch, '<', \$output or error_handler('open-data',"$cmd", "$!");
3257 last if $count > $exit;
3258 if ( $_ =~ /$search/i ) {
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";
3278 log_data('data',"Program version: $version_nu") if $b_log;
3279 eval $end if $b_log;
3282 # print program_version('bash', 'bash', 4) . "\n";
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>
3288 eval $start if $b_log;
3289 my ($file,$strip) = @_;
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;
3297 eval $end if $b_log;
3301 # args: 1 - the file to create if not exists
3305 open( my $fh, '>', $file ) or error_handler('create', $file, $!);
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
3313 #eval $start if $b_log;
3315 $str =~ s/^\s+|\s+$|\n$//g;
3316 #eval $end if $b_log;
3321 # send array, assign to hash, return array, uniq values only.
3324 grep !$seen{$_}++, @_;
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.
3331 my ($path, $ref_content) = @_;
3334 # print Dumper $ref_content, "\n";
3335 if (ref $ref_content eq 'ARRAY'){
3336 $content = join "\n", @$ref_content or die "failed with error $!";
3339 $content = scalar $ref_content;
3341 open(my $fh, ">", $path) or error_handler('open',"$path", "$!");
3346 #### -------------------------------------------------------------------
3348 ##### -------------------------------------------------------------------
3350 # arg 1: type to return
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",
3365 if ( exists $defaults{$type}){
3366 return $defaults{$type};
3369 error_handler('bad-arg-int', $type);
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
3377 eval $start if $b_log;
3378 my ( $self_download, $download_id ) = @_;
3379 my $downloader_error=1;
3380 my $file_contents='';
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";
3387 error_handler('not-in-irc', "-U/--update" )
3389 if ( ! -w $full_self_path ){
3390 error_handler('not-writable', "$self_name", '');
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";
3400 $self_download = "$self_download/$self_name";
3401 $file_contents = download_file('stdout', $self_download);
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", "$!" );
3410 qx( chmod +x '$self_path/$self_name' );
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";
3421 update_man($download_id);
3424 print "Skipping man download because branch version is being used.\n";
3429 error_handler('file-corrupt', "$self_name");
3432 # now run the error handlers on any downloader failure
3434 error_handler('download-error', $self_download, $download_id);
3436 eval $end if $b_log;
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) = ('','');
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";
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";
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') ){
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);
3469 print "Download successful. Compressing file...\n";
3470 system("$program -9 -f $man_file_path > $man_file_path.gz");
3473 print "Oh no! Something went wrong compressing the manfile:\n";
3474 print "Local path: $man_file_path Error: $err\n";
3477 print "Download and install of man page successful.\nCheck to make sure it works: man $self_name\n";
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";
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";
3498 sub set_man_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';
3504 if ( $man_paths && $man_paths =~ /$man_local/ ){
3507 # for distro installs
3508 if ( -f "$default_location/inxi.1.gz" ){
3509 $location=$default_location;
3512 if ( $b_use_local ){
3513 if ( ! -d "$man_local/man1" ){
3514 mkdir "$man_local/man1";
3516 $location="$man_local/man1";
3520 $location=$default_location;
3525 # update for updater output version info
3526 # note, this is only now used for self updater function so it can get
3527 # the values from the UPDATED file, NOT the running program!
3528 sub set_version_data {
3529 open (my $fh, '<', "$self_path/$self_name");
3530 while( my $row = <$fh>){
3533 if ($row =~ /^my \$self_name/ ){
3534 $self_name = (split /=/, $row)[1];
3536 elsif ($row =~ /^my \$self_version/ ){
3537 $self_version = (split /=/, $row)[1];
3539 elsif ($row =~ /^my \$self_date/ ){
3540 $self_date = (split /=/, $row)[1];
3542 elsif ($row =~ /^my \$self_patch/ ){
3543 $self_patch = (split /=/, $row)[1];
3545 elsif ($row =~ /^## END INXI INFO/){
3552 ########################################################################
3553 #### OPTIONS HANDLER / VERSION
3554 ########################################################################
3557 eval $start if $b_log;
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);
3567 $show{'audio'} = 1;},
3570 $show{'battery'} = 1;
3571 $show{'cpu-basic'} = 1;
3572 $show{'raid-basic'} = 1;
3573 $show{'disk-total'} = 1;
3574 $show{'graphic'} = 1;
3576 $show{'machine'} = 1;
3577 $show{'network'} = 1;
3578 $show{'system'} = 1;},
3579 'B|battery' => sub {
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);
3588 elsif ( $arg >= 94 && $arg <= 99 ){
3589 $colors{'selector'} = $arg;
3592 error_handler('bad-arg', $opt, $arg);
3596 $show{'cpu'} = 1; },
3597 'd|disk-full|optical' => sub {
3600 $show{'optical'} = 1; },
3603 $show{'disk'} = 1; },
3604 'f|flags|flag' => sub {
3607 $show{'cpu-flag'} = 1; },
3611 $show{'battery'} = 1;
3614 $show{'graphic'} = 1;
3616 $show{'machine'} = 1;
3617 $show{'network'} = 1;
3618 $show{'network-advanced'} = 1;
3619 $show{'partition'} = 1;
3621 $show{'sensor'} = 1;
3622 $show{'system'} = 1; },
3623 'G|graphics|graphic' => sub {
3625 $show{'graphic'} = 1; },
3629 $show{'network'} = 1;
3630 $show{'network-advanced'} = 1;
3631 $b_downloader = 1 if ! check_program('dig');},
3634 $show{'info'} = 1; },
3635 'l|labels|label' => sub {
3638 $show{'partition'} = 1; },
3640 my ($opt,$arg) = @_;
3645 error_handler('bad-arg',$opt,$arg);
3649 $show{'ram'} = 1; },
3650 'M|machine' => sub {
3652 $show{'machine'} = 1; },
3653 'n|network-advanced' => sub {
3655 $show{'network'} = 1;
3656 $show{'network-advanced'} = 1; },
3657 'N|network' => sub {
3659 $show{'network'} = 1; },
3660 'o|unmounted' => sub {
3662 $show{'unmounted'} = 1; },
3663 'p|partition-full' => sub {
3665 $show{'partition'} = 0;
3666 $show{'partition-full'} = 1; },
3667 'P|partitions|partition' => sub {
3669 $show{'partition'} = 1; },
3670 'r|repos|repo' => sub {
3672 $show{'repo'} = 1; },
3676 $show{'raid-forced'} = 1; },
3677 's|sensors|sensor' => sub {
3679 $show{'sensor'} = 1; },
3681 my ($opt,$arg) = @_;
3687 error_handler('bad-arg',$opt,$arg);
3689 'slots|slot' => sub {
3691 $show{'slot'} = 1; },
3694 $show{'system'} = 1; },
3695 't|processes|process:s' => sub {
3696 my ($opt,$arg) = @_;
3700 $num =~ s/^[cm]+// if $num;
3701 if ( $arg =~ /^([cm]+)([0-9]+)?$/ && (!$num || $num =~ /^\d+/) ){
3702 $show{'process'} = 1;
3704 $show{'ps-cpu'} = 1;
3707 $show{'ps-mem'} = 1;
3709 $ps_count = $num if $num;
3712 error_handler('bad-arg',$opt,$arg);
3716 $show{'usb'} = 1; },
3719 $show{'partition'} = 1;
3720 $show{'uuid'} = 1; },
3721 'v|verbosity:i' => sub {
3722 my ($opt,$arg) = @_;
3724 if ( $arg =~ /^[0-8]$/ ){
3729 $show{'cpu-basic'} = 1;
3730 $show{'disk-total'} = 1;
3731 $show{'graphic'} = 1;
3733 $show{'system'} = 1;
3736 $show{'battery'} = 1;
3737 $show{'disk-basic'} = 1;
3738 $show{'raid-basic'} = 1;
3739 $show{'machine'} = 1;
3740 $show{'network'} = 1;
3743 $show{'network-advanced'} = 1;
3749 $show{'partition'} = 1;
3755 $show{'optical-basic'} = 1;
3758 $show{'sensor'} = 1;
3762 $show{'optical'} = 1;
3763 $show{'partition-full'} = 1;
3764 $show{'unmounted'} = 1;
3769 $b_downloader = 1 if ! check_program('dig');
3770 $show{'cpu-flag'} = 1;
3772 $show{'raid-forced'} = 1;
3778 $show{'process'} = 1;
3779 $show{'ps-cpu'} = 1;
3780 $show{'ps-mem'} = 1;
3782 #$show{'weather'} = 1;
3786 error_handler('bad-arg',$opt,$arg);
3788 'w|weather' => sub {
3793 $show{'weather'} = 1;
3796 error_handler('distro-block', $opt);
3798 'W|weather-location:s' => sub {
3799 my ($opt,$arg) = @_;
3806 $show{'weather'} = 1;
3807 $show{'weather-location'} = $arg;
3810 error_handler('bad-arg',$opt,$arg);
3814 error_handler('distro-block', $opt);
3816 'weather-unit:s' => sub {
3817 my ($opt,$arg) = @_;
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;
3827 error_handler('bad-arg',$opt,$arg);
3829 'x|extra:i' => sub {
3830 my ($opt,$arg) = @_;
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);
3844 error_handler('bad-arg', $opt, $arg);
3847 $show{'filter'} = 1; },
3848 'Z|filter-override' => sub {
3849 $show{'filter-override'} = 1; },
3850 ## Start non data options
3852 my ($opt,$arg) = @_;
3856 elsif ($arg == 41) {
3859 elsif ($arg == 42) {
3862 elsif ($arg == 43) {
3865 elsif ($arg == 44) {
3871 error_handler('bad-arg', $opt, $arg);
3876 my ($opt,$arg) = @_;
3877 if ($arg =~ /^(darwin|dragonfly|freebsd|openbsd|netbsd)$/i){
3878 $bsd_type = lc($arg);
3882 error_handler('bad-arg', $opt, $arg);
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';
3894 error_handler('bad-arg', $opt, $arg);
3898 my ($opt,$arg) = @_;
3903 error_handler('bad-arg', $opt, $arg);
3906 my ($opt,$arg) = @_;
3907 if ($arg =~ /^[1-3]|1[0-3]|2[0-4]$/){
3911 error_handler('bad-arg', $opt, $arg);
3913 'display:s' => sub {
3914 my ($opt,$arg) = @_;
3915 if ($arg =~ /^:?([0-9]+)?$/){
3918 $display = ":$display" if $display !~ /^:/;
3919 $b_display = ($b_root) ? 0 : 1;
3920 $b_force_display = 1;
3921 $display_opt = "-display $display";
3924 error_handler('bad-arg', $opt, $arg);
3926 'dmidecode' => sub {
3927 $b_dmidecode_force = 1 },
3928 'downloader:s' => sub {
3929 my ($opt,$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);
3935 elsif ( !check_program($arg)) {
3936 error_handler('missing-downloader', $opt, $arg);
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);
3947 error_handler('bad-arg', $opt, $arg);
3950 my ($opt,$arg) = @_;
3951 # pattern: ftp.x.x/x
3952 if ($arg =~ /^ftp\..+\..+\/[^\/]+$/ ){
3956 error_handler('bad-arg', $opt, $arg);
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;
3968 error_handler('bad-arg', $opt, $arg);
3975 my ($opt,$arg) = @_;
3976 if ($arg =~ /^(json|screen|xml)$/){
3977 if ($arg =~ /json|screen|xml/){
3978 $output_type = $arg;
3981 error_handler('option-feature-incomplete', $opt, $arg);
3985 error_handler('bad-arg', $opt, $arg);
3987 'no-host|no-hostname' => sub {
3988 $show{'host'} = 0 },
3990 $b_no_man_force = 0; },
3992 $dl{'no-ssl-opt'}=1 },
3993 'output-file:s' => sub {
3994 my ($opt,$arg) = @_;
3996 if ($arg eq 'print' || check_output_path($arg)){
3997 $output_file = $arg;
4000 error_handler('output-file-bad', $opt, $arg);
4004 error_handler('bad-arg', $opt, $arg);
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) = @_;
4015 if (!$arg && $self_name eq 'pinxi'){
4017 $download_id = 'inxi-perl branch';
4018 $self_download = get_defaults('inxi-pinxi');
4020 elsif ($arg && $arg eq '3'){
4022 $download_id = 'dev server';
4023 $self_download = get_defaults('inxi-dev');
4027 $download_id = 'main branch';
4028 $self_download = get_defaults('inxi-main');
4032 elsif ( $arg =~ /^[12]$/){
4033 $download_id = "branch $arg";
4034 $self_download = get_defaults("inxi-branch-$arg");
4036 elsif ( $arg =~ /^http/){
4037 $download_id = 'alt server';
4038 $self_download = $arg;
4041 if (!$self_download){
4042 error_handler('bad-arg', $opt, $arg);
4046 error_handler('distro-block', $opt);
4048 'V|version' => sub {
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;
4065 if ($output_type ne 'screen' && ! $output_file){
4066 error_handler('bad-arg', '--output', '--output-file not provided');
4069 if ( $show{'ram'} || $show{'slot'} ||
4070 ( ( $bsd_type || $b_dmidecode_force ) && ($show{'machine'} || $show{'battery'}) ) ){
4073 if ($show{'audio'} || $show{'graphic'} || $show{'network'} || $show{'raid'} || $show{'raid-forced'} ){
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;
4080 if ($bsd_type && ($show{'short'} || $show{'battery'} || $show{'cpu'} || $show{'cpu-basic'} ||
4081 $show{'info'} || $show{'machine'} || $show{'process'} || $show{'ram'} || $show{'sensor'} ) ){
4084 if ($show{'filter-override'}){
4085 $show{'filter'} = 0;
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;
4096 if ($bsd_type && ($show{'short'} || $show{'disk-basic'} || $show{'disk-total'} || $show{'disk'})){
4097 $b_dm_boot_disk = 1;
4099 if ($bsd_type && ($show{'optical-basic'} || $show{'optical'})){
4100 $b_dm_boot_optical = 1
4105 error_handler('not-in-irc', 'help') if $b_irc;
4106 my (@row,@rows,@data);
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' ;
4113 $partition_string='slice';
4114 $partition_string_u='Slice';
4116 # fit the line to the screen!
4117 for my $i ( 0 .. ( ( $size{'max'} / 2 ) - 2 ) ){
4118 $line = $line . '- ';
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." ],
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
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
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);
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)."],
4229 # if distro maintainers don't want the weather feature disable it
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)."],
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
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
4272 ['2', '-t', '', "Adds memory use output to CPU (-xt c), and CPU use to
4274 ['2', '--usb', '', "For Devices, shows USB version/speed." ],
4278 @rows = (['2', '-w -W', '', "Wind speed and direction, humidity, pressure,
4279 and (-w only) time zone." ]);
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." ],
4310 @rows = (['2', '-w -W', '', "Wind chill, dew point, heat index, if available." ]);
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
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
4336 @rows = (['2', '-w -W', '', "Location (uses -z/irc filter), weather observation
4337 time, altitude (shows extra lines for data where relevant)." ] );
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." ]
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" ]
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
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)." ],
4397 ['1', '', '--man', "Install correct man version for dev branch (-U 3) or pinxi using -U." ],
4402 ['1', '', '--no-host', "Turn off hostname for -S. Useful if showing output from servers etc." ],
4407 ['1', '', '--no-man', "Disable man install for all -U update actions." ],
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
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" ],
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();
4457 elsif ( $working_path !~ /^\// ){
4458 $working_path = getcwd() . "/$working_path";
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
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/[^\/]+$//;
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)"],);
4473 @row = ([ 0, '', '', ""],);
4475 my $year = (split/-/, $self_date)[0];
4476 @row = [ 0, '', '', "Program Location: $working_path" ];
4479 @row = [ 0, '', '', "Started via symbolic link: $link" ];
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" ],
4487 [ 0, '', '', "$self_name - the universal, portable, system information tool
4488 for console and irc." ],
4489 [ 0, '', '', "Using Perl version: $]"],
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." ],
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)" ]
4509 ########################################################################
4511 ########################################################################
4515 package StartClient;
4523 # NOTE: there's no reason to crete an object, we can just access
4524 # the features statically.
4527 # my $class = shift;
4530 # # print "$type\n";
4531 # return bless $self, $class;
4534 sub get_client_data {
4535 eval $start if $b_log;
4537 main::set_ps_aux() if ! @ps_aux;
4539 main::get_shell_data($ppid);
4542 $show{'filter'} = 1;
4544 if ($client{'konvi'} == 1 || $client{'konvi'} == 3){
4548 eval $end if $b_log;
4551 sub get_client_name {
4552 eval $start if $b_log;
4553 my $client_name = '';
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;
4570 $client{'name'} = $client_name;
4571 get_client_version();
4572 # print "c:$client_name p:$pppid\n";
4575 if (! check_modern_konvi() ){
4577 $client_name = (main::grabber("ps -p $ppid"))[1];
4579 my @data = split /\s+/, $client_name if $client_name;
4581 $client_name = lc($data[5]);
4583 # gnu/linux uses last value
4585 $client_name = lc($data[-1]);
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();
4594 $client{'name'} = "PPID='$ppid' - Empty?";
4599 my $string = "Client: $client{'name'} :: version: $client{'version'} :: konvi: $client{'konvi'} :: PPID: $ppid";
4600 main::log_data('data', $string);
4602 eval $end if $b_log;
4604 sub get_client_version {
4605 eval $start if $b_log;
4606 @app = main::program_values($client{'name'});
4607 my (@data,@working,$string);
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];
4614 if ($client{'name'} =~ /^bash|dash|sh$/ ){
4615 $client{'name-print'} = 'shell wrapper';
4616 $client{'console-irc'} = 1;
4618 elsif ($client{'name'} eq 'bitchx') {
4619 @data = main::grabber("$client{'name'} -v");
4620 $string = awk(\@data,'Version');
4622 $string =~ s/[()]|bitchx-//g;
4623 @data = split /\s+/, $string;
4625 $client{'version'} = ($data[1] eq 'version') ? $data[2] : $data[1];
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');
4637 elsif ( -f '~/.config/hexchat/xchat.conf' ){
4638 @data = main::reader('~/.config/hexchat/xchat.conf','strip');
4640 $client{'version'} = main::awk(\@data,'version',2,'\s*=\s*');
4641 $client{'name-print'} = 'HexChat';
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;
4647 elsif ($client{'name'} =~ /quassel/) {
4648 @data = main::grabber("$client{'name'} -v 2>/dev/null");
4650 if ($_ =~ /^Quassel IRC:/){
4651 $client{'version'} = (split /\s+/, $_ )[2];
4654 elsif ($_ =~ /quassel\s[v]?[0-9]/){
4655 $client{'version'} = (split /\s+/, $_ )[1];
4659 $client{'version'} ||= '(pre v0.4.1)?';
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 ;)
4673 if ( $_ =~ /dsirc/ ){
4674 $client{'version'} = main::program_version('ksirc','KSirc:',2,'-v',0,0);
4675 $client{'name'} = 'ksirc';
4676 $client{'name-print'} = 'KSirc';
4679 $client{'console-irc'} = 1;
4680 perl_python_client();
4682 elsif ($client{'name'} =~ /python/) {
4683 perl_python_client();
4685 if (!$client{'name-print'}) {
4686 $client{'name-print'} = 'Unknown Client: ' . $client{'name'};
4688 eval $end if $b_log;
4691 eval $start if $b_log;
4695 if (! -e "/proc/$ppid/cmdline" ){
4699 open( my $fh, '<', "/proc/$ppid/cmdline" ) or
4700 print_line("Open /proc/$ppid/cmdline failed: $!");
4710 $cmdline[0] = $rows[0];
4711 $i = ($cmdline[0]) ? 1 : 0;
4713 main::log_data('string',"cmdline: @cmdline count: $i") if $b_log;
4714 eval $end if $b_log;
4717 sub perl_python_client {
4718 eval $start if $b_log;
4719 return 1 if $client{'version'};
4720 # this is a hack to try to show konversation if inxi is running but started via /cmd
4721 # OR via program shortcuts, both cases in fact now
4722 # main::print_line("konvi: " . scalar grep { $_ =~ /konversation/ } @ps_cmd);
4723 if ( $b_display && main::check_program('konversation') && ( grep { $_ =~ /konversation/ } @ps_cmd )){
4724 @app = main::program_values('konversation');
4725 $client{'version'} = main::program_version('konversation',$app[0],$app[1],$app[2],$app[5],$app[6]);
4726 $client{'name'} = 'konversation';
4727 $client{'name-print'} = $app[3];
4728 $client{'console-irc'} = $app[4];
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';
4742 if ( grep { $_ =~ /limnoria/ } @ps_cmd){
4743 $client{'name'} = 'limnoria';
4744 $client{'name-print'} = 'Limnoria';
4747 $client{'name'} = 'supybot';
4748 $client{'name-print'} = 'Supybot';
4752 $client{'name'} = 'supybot';
4753 $client{'name-print'} = 'Supybot';
4755 $client{'console-irc'} = 1;
4758 $client{'name-print'} = "Unknown $client{'name'} client";
4761 my $string = "namep: $client{'name-print'} name: $client{'name'} version: $client{'version'}";
4762 main::log_data('data',$string);
4764 eval $end if $b_log;
4766 ## try to infer the use of Konversation >= 1.2, which shows $PPID improperly
4767 ## no known method of finding Konvi >= 1.2 as parent process, so we look to see if it is running,
4768 ## and all other irc clients are not running. As of 2014-03-25 this isn't used in my cases
4769 sub check_modern_konvi {
4770 eval $start if $b_log;
4772 return 0 if ! $client{'qdbus'};
4773 my $b_modern_konvi = 0;
4774 my $konvi_version = '';
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');
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;
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;
4813 sub set_konvi_data {
4814 eval $start if $b_log;
4815 my $config_tool = '';
4816 # https://userbase.kde.org/Konversation/Scripts/Scripting_guide
4817 if ( $client{'konvi'} == 3 ){
4818 $client{'dserver'} = shift @ARGV;
4819 $client{'dtarget'} = shift @ARGV;
4820 $client{'dobject'} = 'default';
4822 elsif ( $client{'konvi'} == 1 ){
4823 $client{'dport'} = shift @ARGV;
4824 $client{'dserver'} = shift @ARGV;
4825 $client{'dtarget'} = shift @ARGV;
4826 $client{'dobject'} = 'Konversation';
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';
4834 elsif ( main::check_program('kde5-config') ){
4835 $config_tool = 'kde5-config';
4837 elsif ( main::check_program('kde-config') ){
4838 $config_tool = 'kde-config';
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
4843 my @data = main::grabber("$config_tool --path data 2>/dev/null",':');
4844 main::get_configs(@data);
4846 eval $end if $b_log;
4850 ########################################################################
4852 ########################################################################
4854 #### -------------------------------------------------------------------
4855 #### FILTERS AND TOOLS
4856 #### -------------------------------------------------------------------
4861 $string = ( $show{'filter'} ) ? $filter_string : $string;
4870 $item =~ s/(\(?Device Tree\)?)//gi;
4871 $item =~ s/\s\s+/ /g;
4872 $item =~ s/^\s+|\s+$//g;
4876 sub clean_characters {
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
4882 $data =~ s/[:\47]|\\[a-z]|\n|,|\"|\*|\||\+|\[\s\]|n\/a|\s\s+/ /g;
4884 $data =~ s/^\s+|\s+$//g;
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;
4900 return $item if !$item;
4902 $item =~ s/vendor.*|product.*|O\.?E\.?M\.?//gi;
4903 $item =~ s/\s\s+/ /g;
4904 $item =~ s/^\s+|\s+$//g;
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;
4923 sub remove_duplicates {
4925 return if ! $string;
4928 my @data = split /\s+/, $string;
4935 $string = join ' ', @temp;
4939 # args: $1 - size in KB, return KB, MB, GB, TB, PB, EB
4941 my ($size,$b_int) = @_;
4943 return ('','') if ! defined $size;
4944 if ($size !~ /^[0-9\.]+$/){
4948 elsif ($size > 1024**5){
4949 $data[0] = sprintf("%.2f",$size/1024**5);
4952 elsif ($size > 1024**4){
4953 $data[0] = sprintf("%.2f",$size/1024**4);
4956 elsif ($size > 1024**3){
4957 $data[0] = sprintf("%.2f",$size/1024**3);
4960 elsif ($size > 1024**2){
4961 $data[0] = sprintf("%.2f",$size/1024**2);
4964 elsif ($size > 1024){
4965 $data[0] = sprintf("%.1f",$size/1024);
4969 $data[0] = sprintf("%.0f",$size);
4972 $data[0] = int($data[0]) if $b_int && $data[0];
4976 # not used, but keeping logic for now
4977 sub increment_starters {
4978 my ($key,$indexes) = @_;
4980 if (defined $$indexes{$key} ){
4982 $result = "$key-$$indexes{$key}";
4987 sub memory_data_full {
4988 eval $start if $b_log;
4992 my ($gpu_ram,$percent,$total,$used) = (0,'','','');
4993 if (!$show{'info'}){
4994 $memory = get_memory_data('splits');
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];
5004 @temp2 = get_size($gpu_ram);
5005 $gpu_ram = $temp2[0] . ' ' . $temp2[1] if $temp2[1];
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;
5015 eval $end if $b_log;
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;
5032 sub pci_cleaner_subsystem {
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;
5044 sub pci_long_filter {
5046 if ($string =~ /\[AMD(\/ATI)?\]/){
5047 $string =~ s/Advanced\sMicro\sDevices\s\[AMD(\/ATI)?\]/AMD/;
5053 my ($type,$id) = @_;
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>',
5105 return $unfound{$type};
5108 # convert string passed to KB, based on GB/MB/TB id
5109 # NOTE: K 1024 KB 1000
5110 sub translate_size {
5113 #print ":$working:\n";
5114 return if ! defined $working;
5115 my $math = ( $working =~ /B$/) ? 1000: 1024;
5116 if ( $working =~ /^([0-9\.]+)M[B]?$/i){
5119 elsif ( $working =~ /^([0-9\.]+)G[B]?$/i){
5120 $size = $1 * $math**2;
5122 elsif ( $working =~ /^([0-9\.]+)T[B]?$/i){
5123 $size = $1 * $math**3;
5125 elsif ( $working =~ /^([0-9\.]+)P[B]?$/i){
5126 $size = $1 * $math**4;
5128 elsif ( $working =~ /^([0-9\.]+)E[B]?$/i){
5129 $size = $1 * $math**5;
5131 elsif ( $working =~ /^([0-9\.]+)K[B]?$/i){
5134 $size = int($size) if $size;
5138 #### -------------------------------------------------------------------
5139 #### GENERATE OUTPUT
5140 #### -------------------------------------------------------------------
5142 sub check_output_path {
5144 my ($b_good,$dir,$file);
5146 $dir =~ s/([^\/]+)$//;
5148 # print "file: $file : dir: $dir\n";
5149 $b_good = 1 if (-d $dir && -w $dir && $dir =~ /^\// && $file);
5153 sub output_handler {
5155 # print Dumper \%data;
5156 if ($output_type eq 'screen'){
5159 elsif ($output_type eq 'json'){
5160 generate_json(%data);
5162 elsif ($output_type eq 'xml'){
5163 generate_xml(%data);
5167 # NOTE: file has already been set and directory verified
5169 eval $start if $b_log;
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);
5180 elsif (check_module('JSON::XS')){
5182 $json = JSON::XS::encode_json(\%data);
5185 error_handler('required-module', 'json', 'Cpanel::JSON::XS OR JSON::XS');
5188 #$json =~ s/"[0-9]+#/"/g;
5189 if ($output_file eq 'print'){
5190 #$json =~ s/\}/}\n/g;
5194 print_line("Writing JSON data to: $output_file\n");
5195 open(my $fh, '>', $output_file) or error_handler('open',$output_file,"$!");
5198 print_line("Data written successfully.\n");
5201 eval $end if $b_log;
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.
5208 eval $start if $b_log;
5212 error_handler('not-in-irc', 'help') if $b_irc;
5213 #print Dumper \%data if $b_debug;
5214 if (check_module('XML::Dumper')){
5216 $xml = XML::Dumper::pl2xml(\%data);
5217 #$xml =~ s/"[0-9]+#/"/g;
5218 if ($output_file eq 'print'){
5222 print_line("Writing XML data to: $output_file\n");
5223 open(my $fh, '>', $output_file) or error_handler('open',$output_file,"$!");
5226 print_line("Data written successfully.\n");
5230 error_handler('required-module', 'xml', 'XML::Dumper');
5232 eval $end if $b_log;
5236 return sprintf("%03d#%s", $_[0],$_[1]);
5242 my $indent_static = 18;
5243 my $indent1_static = 5;
5244 my $indent2_static = 8;
5248 my ($start,$aref,$i,$j,$line);
5250 if ( $size{'max'} > 110 ){
5251 $indent_static = 22;
5253 elsif ($size{'max'} < 90 ){
5254 $indent_static = 15;
5256 # print $length . "\n";
5257 for my $i (0 .. $#data){
5259 #print "0: $data[$i][0]\n";
5260 if ($data[$i][0] == 0 ){
5265 elsif ($data[$i][0] == 1 ){
5266 $indent = $indent_static;
5267 $indent1 = $indent1_static;
5268 $indent2= $indent2_static;
5270 elsif ($data[$i][0] == 2 ){
5271 $indent = ( $indent_static + 7 );
5272 $indent1 = ( $indent_static + 5 );
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] . ', ';
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");
5285 #print "1-print.\n";
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]);
5291 #print "2-print.\n";
5296 foreach my $word (split / /, $data[$i][3]){
5298 if ( ( $indent + length($holder) + length($word) ) < $size{'max'} ) {
5300 $holder .= $word . $sep;
5303 #elsif ( ( $indent + length($holder) + length($word) ) >= $size{'max'}){
5305 $line = sprintf("%-${indent}s%s\n", "$start", $holder);
5309 $holder = $word . $sep;
5310 #print "4-print-hold.\n";
5313 if ($holder !~ /^[ ]*$/){
5314 $line = sprintf("%-${indent}s%s\n", "$start", $holder);
5316 #print "5-print-last.\n";
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.
5328 my $array_holder = 1;
5330 my $split_count = 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 ){
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'}");
5361 if (ref($data{$key1}) eq 'ARRAY'){
5362 # @working = @{$data{$key1}};
5370 'Hardware' => 1, # hardware raid report
5374 'variant' => 1, # arm > 1 cpu type
5377 foreach my $val1 (@{$data{$key1}}){
5379 if (ref($val1) eq 'HASH'){
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
5390 if ($key eq 'Array' && $array_holder != $ids{$key} ){
5391 $array_holder = $ids{$key};
5392 $ids{'Device'} = 1 if ($ids{'Device'} > 1);
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);
5398 if ($counter == 0 && defined $ids{$key}){
5399 $key .= '-' . $ids{$key}++;
5401 $val2 = $$val1{$key2};
5402 # we have to handle cases where $val2 is 0
5403 if ($val2 || $val2 eq '0'){
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";
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 ";
5425 $length += length("$key$sep{'s2'} $val3 ");
5426 # print scalar @values,"\n";
5428 # my $l = (length("$_ ") + $length);
5430 if ( (length("$_ ") + $length) < $size{'max'} ){
5433 $holder2 .= "$start2$_ ";
5435 #$length += $length2;
5441 $length += length("$_ ");
5446 $holder2 = "$start2$holder2";
5449 $holder2 = "$colors{'c2'}$holder2";
5451 #print "xx:$holder";
5452 $line = sprintf("%-${indent}s%s$colors{'cn'}\n","$start","$holder$holder2");
5457 #print "h2: $holder2\n";
5458 $length = length($holder2) + $indent;
5464 if ($holder2 !~ /^\s*$/){
5466 $holder2 = "$colors{'c2'}$holder2";
5467 $line = sprintf("%-${indent}s%s$colors{'cn'}\n","$start","$holder$holder2");
5478 #print "H: $counter $hash\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;
5489 $holder = "$colors{'c1'}$key$sep{'s2'}$colors{'c2'} $val2";
5490 #$line = sprintf("%-${indent}s%s$colors{'cn'}\n",$start,"$holder");
5497 if ($holder !~ /^\s*$/){
5499 $line = sprintf("%-${indent}s%s$colors{'cn'}\n",$start,"$start2$holder");
5507 elsif (ref($val1) eq 'ARRAY'){
5510 foreach my $item (@$val1){
5512 $line = "$colors{'c1'}$array$sep{'s2'} $colors{'c2'}$item$colors{'cn'}";
5513 $line = sprintf("%-${indent}s%s\n","","$line");
5527 if ($b_irc && $client{'test-konvi'}){
5528 $client{'konvi'} = 3;
5529 $client{'dobject'} = 'Konversation';
5531 if ($client{'konvi'} == 1 && $client{'dcop'} ){
5532 # konvi doesn't seem to like \n characters, it just prints them literally
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");
5537 elsif ($client{'konvi'} == 3 && $client{'qdbus'} ){
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);
5548 ########################################################################
5549 #### DATA PROCESSORS
5550 ########################################################################
5552 #### -------------------------------------------------------------------
5553 #### PRIMARY DATA GENERATORS
5554 #### -------------------------------------------------------------------
5572 eval $start if $b_log;
5575 if (($b_arm || $b_mips) && !$b_soc_audio && !$b_pci_tool){
5576 my $key = ($b_arm) ? 'ARM' : 'MIPS';
5578 main::key($num++,$key) => main::row_defaults(lc($key) . '-pci',''),
5580 @rows = (@rows,@data);
5583 @data = card_data();
5584 @rows = (@rows,@data);
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);
5592 @rows = (@rows,@data);
5594 my $key = 'Message';
5596 main::key($num++,$key) => main::row_defaults('pci-card-data',''),
5598 @rows = (@rows,@data);
5600 @data = sound_server_data();
5601 @rows = (@rows,@data);
5602 eval $end if $b_log;
5607 eval $start if $b_log;
5609 my ($j,$num) = (0,1);
5613 if ($row[0] =~ /^(audio|daudio|hdmi|multimedia)$/){
5615 my $driver = $row[9];
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);
5624 main::key($num++,'Card') => $card,
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;
5631 $rows[$j]{main::key($num++,'driver')} = $driver;
5632 if ($extra > 0 && !$bsd_type){
5634 my $version = main::get_module_version($row[9]);
5635 $rows[$j]{main::key($num++,'v')} = $version if $version;
5639 $rows[$j]{main::key($num++,'bus ID')} = (!$row[2] && !$row[3]) ? 'N/A' : "$row[2].$row[3]";
5642 $rows[$j]{main::key($num++,'chip ID')} = ($row[5]) ? "$row[5]:$row[6]" : $row[6];
5647 #my $ref = $pci[-1];
5648 #print $$ref[0],"\n";
5649 eval $end if $b_log;
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.
5656 eval $start if $b_log;
5658 my (@asound,@rows,@data);
5659 my ($card,$driver,$j,$num) = ('','',0,1);
5660 @asound = main::reader($file);
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]/ ) {
5666 my @working = split /:\s*/, $_;
5668 $working[1] =~ /(.*)\s+-\s+(.*)/;
5675 main::key($num++,'Card') => $card,
5676 main::key($num++,'driver') => $driver,
5678 @rows = (@rows,@data);
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','');
5687 # print Data::Dumper:Dumper \s@rows;
5688 eval $end if $b_log;
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');
5700 my $id = (main::reader($_))[0];
5701 push @ids, $id if ($id && ! grep {/$id/} @ids);
5703 # lsusb is a very expensive operation
5705 if (!$bsd_type && !$b_usb_check){
5706 main::set_usb_data();
5710 main::log_data('dump','@ids',\@ids) if $b_log;
5712 foreach my $id (@ids){
5714 foreach my $ref (@usb){
5716 # a device will always be the second or > device on the bus
5717 if ($row[1] > 1 && $row[2] eq $id){
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]);
5725 foreach my $line (@row){
5726 my @working = split /:/, $line;
5727 if ($working[0] eq 'idVendor' && $working[2]){
5728 $vendor = main::cleaner($working[2]);
5730 if ($working[0] eq 'idProduct' && $working[2]){
5731 $product = main::cleaner($working[2]);
5733 if ($working[0] eq 'iManufacturer' && $working[2]){
5734 $vendor2 = main::cleaner($working[2]);
5736 if ($working[0] eq 'iProduct' && $working[2]){
5737 $product2 = main::cleaner($working[2]);
5739 if ($working[0] eq 'Descriptor_Configuration'){
5744 if ($vendor && $product){
5745 $product = ($product =~ /$vendor/) ? $product: "$vendor $product" ;
5748 if ($vendor && $product2){
5749 $product = ($product2 =~ /$vendor/) ? $product2: "$vendor $product2" ;
5751 elsif ($vendor2 && $product2){
5752 $product = ($product2 =~ /$vendor2/) ? $product2: "$vendor2 $product2" ;
5758 $product = $vendor2;
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];
5768 $driver ||= 'snd-usb-audio';
5770 main::key($num++,'Card') => $product,
5771 main::key($num++,'type') => 'USB',
5772 main::key($num++,'driver') => $driver,
5774 @rows = (@rows,@data);
5776 $rows[$j]{main::key($num++,'bus ID')} = "$row[0]:$row[1]";
5779 $rows[$j]{main::key($num++,'chip ID')} = $row[2];
5785 eval $end if $b_log;
5789 sub sound_server_data {
5790 eval $start if $b_log;
5791 my (@data,$server,$version);
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){
5799 #$_ =~ s/Advanced Linux Sound Architecture/ALSA/;
5800 $version = (split /\s+/, $content)[-1];
5801 $version =~ s/\.$//; # trim off period
5806 elsif (my $program = main::check_program('oss')){
5808 $version = main::program_version('oss','\S',2);
5813 main::key($num++,'Sound Server') => $server,
5814 main::key($num++,'v') => $version,
5817 eval $end if $b_log;
5824 package BatteryData;
5825 my (@upower_items,$b_upower,$upower);
5827 eval $start if $b_log;
5828 my (@rows,%battery,$key1,$val1);
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,});
5839 %battery = battery_data_dmi();
5841 if ($show{'battery-forced'}){
5843 $val1 = main::row_defaults('battery-data','');
5844 @rows = ({main::key($num++,$key1) => $val1,});
5848 @rows = create_output(%battery);
5852 elsif (-d '/sys/class/power_supply/'){
5853 %battery = battery_data_sys();
5855 if ($show{'battery-forced'}){
5857 $val1 = main::row_defaults('battery-data','');
5858 @rows = ({main::key($num++,$key1) => $val1,});
5862 @rows = create_output(%battery);
5866 if ($show{'battery-forced'}){
5868 $val1 = main::row_defaults('battery-data-sys','');
5869 @rows = ({main::key($num++,$key1) => $val1,});
5872 (@upower_items,$b_upower,$upower) = undef;
5873 eval $end if $b_log;
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
5884 # 5 voltage_min_design
5887 # 8 energy_full_design
5898 eval $start if $b_log;
5900 my ($key,@data,@rows);
5903 # print Data::Dumper::Dumper \%battery;
5904 foreach $key (sort keys %battery){
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'}%)";
5920 $condition ||= 'N/A';
5923 main::key($num++,'ID') => $key,
5924 main::key($num++,'charge') => $charge,
5925 main::key($num++,'condition') => $condition,
5927 @rows = (@rows,@data);
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'}";
5936 $rows[$j]{main::key($num++,'volts')} = $volts;
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'}";
5942 elsif ($battery{$key}{'manufacturer'}){
5943 $model = $battery{$key}{'manufacturer'};
5945 elsif ($battery{$key}{'model_name'}){
5946 $model = $battery{$key}{'model_name'};
5952 $rows[$j]{main::key($num++,'model')} = $model;
5954 $chemistry = ( $battery{$key}{'technology'} ) ? $battery{$key}{'technology'}: 'N/A';
5955 $rows[$j]{main::key($num++,'type')} = $chemistry;
5958 $serial = main::apply_filter($battery{$key}{'serial_number'});
5959 $rows[$j]{main::key($num++,'serial')} = $serial;
5961 $status = ($battery{$key}{'status'}) ? $battery{$key}{'status'}: 'N/A';
5962 $rows[$j]{main::key($num++,'status')} = $status;
5964 if ($battery{$key}{'cycle_count'}){
5965 $rows[$j]{main::key($num++,'cycles')} = $battery{$key}{'cycle_count'};
5967 if ($battery{$key}{'location'}){
5968 $rows[$j]{main::key($num++,'location')} = $battery{$key}{'location'};
5972 $battery{$key} = undef;
5974 # print Data::Dumper::Dumper \%battery;
5975 # now if there are any devices left, print them out, excluding Mains
5977 $upower = main::check_program('upower');
5978 foreach $key (sort keys %battery){
5980 next if !defined $battery{$key} || $battery{$key}{'purpose'} eq 'mains';
5981 my ($charge,$model,$serial,$percent,$status,$vendor) = ('','','','','','');
5984 %upower_data = upower_data($key) if $upower;
5985 if ($upower_data{'percent'}){
5986 $charge = $upower_data{'percent'};
5988 elsif ($battery{$key}{'capacity_level'} && lc($battery{$key}{'capacity_level'}) ne 'unknown'){
5989 $charge = $battery{$key}{'capacity_level'};
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";
6009 main::key($num++,'Device') => $key,
6010 main::key($num++,'model') => $model,
6012 @rows = (@rows,@data);
6014 $serial = main::apply_filter($battery{$key}{'serial_number'});
6015 $rows[$j]{main::key($num++,'serial')} = $serial;
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'};
6021 $rows[$j]{main::key($num++,'status')} = $status;
6024 eval $end if $b_log;
6028 # charge: mAh energy: Wh
6029 sub battery_data_sys {
6030 eval $start if $b_log;
6031 my ($b_ma,%battery,$file,$id,$item,$path,$value);
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){
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]: '';
6054 if ($file eq 'type' && $value && lc($value) ne 'battery' ){
6055 $battery{$id}{'purpose'} = 'mains';
6058 if ($file eq 'voltage_min_design'){
6059 $value = sprintf("%.1f", $value/1000000);
6061 elsif ($file eq 'voltage_now'){
6062 $value = sprintf("%.1f", $value/1000000);
6064 elsif ($file eq 'energy_full_design'){
6065 $value = $value/1000000;
6067 elsif ($file eq 'energy_full'){
6068 $value = $value/1000000;
6070 elsif ($file eq 'energy_now'){
6071 $value = sprintf("%.1f", $value/1000000);
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;
6081 elsif ($file eq 'charge_full'){
6082 $value = $value/1000000;
6085 elsif ($file eq 'charge_now'){
6086 $value = $value/1000000;
6089 elsif ($file eq 'manufacturer'){
6090 $value = main::dmi_cleaner($value);
6092 elsif ($file eq 'model_name'){
6093 $value = main::dmi_cleaner($value);
6096 elsif ($b_root && -e $path && ! -r $path ){
6097 $value = main::row_defaults('root-required');
6099 $battery{$id}{$file} = $value;
6100 # print "$battery{$id}{$file}\n";
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'};
6110 if ($battery{$id}{'charge_full'}){
6111 $battery{$id}{'energy_full'} = $battery{$id}{'charge_full'}*$battery{$id}{'voltage_min_design'};
6113 if ($battery{$id}{'charge_full_design'}){
6114 $battery{$id}{'energy_full_design'} = $battery{$id}{'charge_full_design'} * $battery{$id}{'voltage_min_design'};
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'} );
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'} );
6125 if ( $battery{$id}{'energy_now'} ){
6126 $battery{$id}{'energy_now'} = sprintf( "%.1f", $battery{$id}{'energy_now'} );
6128 if ( $battery{$id}{'energy_full_design'} ){
6129 $battery{$id}{'energy_full_design'} = sprintf( "%.1f",$battery{$id}{'energy_full_design'} );
6131 if ( $battery{$id}{'energy_full'} ){
6132 $battery{$id}{'energy_full'} = sprintf( "%.1f", $battery{$id}{'energy_full'} );
6135 eval $end if $b_log;
6138 # note, dmidecode does not have charge_now or charge_full
6139 sub battery_data_dmi {
6140 eval $start if $b_log;
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;
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);
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);
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'} );
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'} );
6179 elsif ($ref[0] > 22){
6183 # print Data::Dumper::Dumper \%battery;
6184 eval $end if $b_log;
6189 eval $start if $b_log;
6191 if (!$b_upower && $upower){
6192 @upower_items = main::grabber("$upower -e",'','strip');
6195 if ($upower && @upower_items){
6196 foreach (@upower_items){
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];
6204 elsif ($temp[0] eq 'rechargeable'){
6205 $data{'rechargeable'} = $temp[1];
6212 eval $end if $b_log;
6223 eval $start if $b_log;
6225 my (@data,@rows,$single,$key1,$val1);
6227 if ($type eq 'short' || $type eq 'basic'){
6228 @rows = data_short($type);
6231 @rows = create_output_full();
6233 eval $end if $b_log;
6236 sub create_output_full {
6237 eval $start if $b_log;
6239 my ($b_flags,$b_speeds,$core_speeds_value,$flag_key,@flags,%cpu,@data,@rows);
6240 my $sleep = $cpu_sleep * 1000000;
6242 eval 'Time::HiRes::usleep( $sleep )';
6245 select(undef, undef, undef, $cpu_sleep);
6247 if (my $file = main::system_files('cpuinfo')){
6248 %cpu = data_cpuinfo($file,'full');
6251 my ($key1,$val1) = ('','');
6252 if ( $alerts{'sysctl'} ){
6253 if ( $alerts{'sysctl'}{'action'} eq 'use' ){
6255 # $val1 = main::row_defaults('dev');
6256 %cpu = data_sysctl('full');
6259 $key1 = ucfirst($alerts{'sysctl'}{'action'});
6260 $val1 = $alerts{'sysctl'}{$alerts{'sysctl'}{'action'}};
6261 @data = ({main::key($num++,$key1) => $val1,});
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';
6274 main::key($num++,'Topology') => $properties{'cpu-layout'},
6275 main::key($num++,'model') => $cpu{'model_name'},
6277 @rows = (@rows,@data);
6278 if ($cpu{'arm-cpus'}){
6279 my $ref = $cpu{'arm-cpus'};
6280 my %arm_cpus = %$ref;
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;
6288 $properties{'bits-sys'} ||= 'N/A';
6289 $rows[$j]{main::key($num++,'bits')} = $properties{'bits-sys'};
6291 $rows[$j]{main::key($num++,'type')} = $type;
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'};
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'};
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'};
6311 if ($extra > 0 && !$show{'cpu-flag'}){
6313 @flags = split /\s+/, $cpu{'flags'} if $cpu{'flags'};
6314 $flag_key = ($b_arm || $bsd_type) ? 'features': '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;
6323 if ($b_arm && $flag eq 'N/A'){
6324 $flag = main::row_defaults('arm-cpu-f');
6327 main::key($num++,$flag_key) => $flag,
6329 @rows = (@rows,@data);
6332 if ($extra > 0 && !$bsd_type){
6333 my $bogomips = ($cpu{'bogomips'}) ? int($cpu{'bogomips'}) : 'N/A';
6334 $rows[$j]{main::key($num++,'bogomips')} = $bogomips;
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
6344 if (grep {$_ ne '0'} @speeds){
6345 $core_speeds_value = '';
6349 $core_speeds_value = main::row_defaults('cpu-speeds',scalar @speeds);
6353 $core_speeds_value = 'N/A';
6357 main::key($num++,$speed_key) => $speed,
6358 main::key($num++,$min_max_key) => $min_max,
6360 @rows = (@rows,@data);
6362 my $boost = get_boost_status();
6363 $rows[$j]{main::key($num++,'boost')} = $boost if $boost;
6365 $rows[$j]{main::key($num++,$core_key)} = $core_speeds_value;
6367 # if say 96 0 speed cores, no need to print all those 0s
6370 $rows[$j]{main::key($num++,$i++)} = $_;
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'};
6378 @flags = sort(@flags);
6379 $flag = join ' ', @flags if @flags;
6382 main::key($num++,$flag_key) => $flag,
6384 @rows = (@rows,@data);
6386 if ($b_admin && $cpu{'bugs'}){
6387 my @bugs = split /\s+/, $cpu{'bugs'};
6388 @bugs = sort(@bugs);
6389 my $bug = join ' ', @bugs;
6391 main::key($num++,'Errata') => $bug,
6393 @rows = (@rows,@data);
6395 eval $end if $b_log;
6398 sub create_output_short {
6399 eval $start if $b_log;
6403 $cpu[1] ||= main::row_defaults('cpu-model-null');
6406 main::key($num++,$cpu[0]) => $cpu[1],
6407 main::key($num++,'type') => $cpu[2],
6410 $data[0]{main::key($num++,'arch')} = $cpu[7];
6412 $data[0]{main::key($num++,$cpu[3])} = $cpu[4];
6414 $data[0]{main::key($num++,$cpu[5])} = $cpu[6];
6416 eval $end if $b_log;
6420 eval $start if $b_log;
6423 my (%cpu,@data,%speeds);
6424 my $sys = '/sys/devices/system/cpu/cpufreq/policy0';
6425 my $sleep = $cpu_sleep * 1000000;
6427 eval 'Time::HiRes::usleep( $sleep )';
6430 select(undef, undef, undef, $cpu_sleep);
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);
6438 my ($key1,$val1) = ('','');
6439 if ( $alerts{'sysctl'} ){
6440 if ( $alerts{'sysctl'}{'action'} eq 'use' ){
6442 # $val1 = main::row_defaults('dev');
6443 %cpu = data_sysctl($type);
6446 $key1 = ucfirst($alerts{'sysctl'}{'action'});
6447 $val1 = $alerts{'sysctl'}{$alerts{'sysctl'}{'action'}};
6448 @data = ({main::key($num++,$key1) => $val1,});
6453 # $cpu{'cur-freq'} = $cpu[0]{'core-id'}[0]{'speed'};
6454 if ($type eq 'short' || $type eq 'basic'){
6455 @data = prep_short_data(%cpu);
6457 if ($type eq 'basic'){
6458 @data = create_output_short(@data);
6460 eval $end if $b_log;
6464 sub prep_short_data {
6465 eval $start if $b_log;
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'};
6474 $properties{'cpu-layout'},
6479 $properties{'min-max-key'},
6480 $properties{'min-max'},
6483 $cpu{'arch'} ||= 'N/A';
6484 $result[7] = $cpu{'arch'};
6486 eval $end if $b_log;
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
6527 my %cpu = set_cpu_data();
6528 # note, there con be a lot of processors, 32 core HT would have 64, for example.
6531 @line = split /\s*:\s*/, $_;
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;
6547 $cpu{'model_name'} .= ' ' . $cpu{'arch'} if $cpu{'model_name'} !~ /$cpu{'arch'}/i;
6549 $cpu{'processors'}[$proc_count] = 0;
6555 elsif ($line[0] eq 'processor'){
6556 # this protects against double processor lines, one int, one string
6557 if ($line[1] =~ /^\d+$/){
6560 $cpu{'processors'}[$proc_count] = 0;
6562 #print "p1: $proc_count\n";
6566 $cpu{'processors'}[$proc_count] = 0;
6568 #print "p2a: $proc_count\n";
6572 # Processor : AArch64 Processor rev 4 (aarch64)
6573 # but no model name type
6574 if ( $b_arm || $line[1] =~ /ARM|AArch/i){
6576 $cpu{'type'} = 'arm';
6578 $cpu{'model_name'} = main::cleaner($line[1]);
6579 $cpu{'model_name'} = cpu_cleaner($cpu{'model'});
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]));
6592 $cpu{'arch'} = $line[1];
6595 elsif (!$cpu{'rev'} && ($line[0] eq 'stepping' || $line[0] eq 'cpu revision' )){
6596 $cpu{'rev'} = uc(sprintf("%x", $line[1]));
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]));
6602 elsif (!$cpu{'model_id'} && $line[0] eq 'cpu variant' ){
6603 $cpu{'model_id'} = uc($line[1]);
6604 $cpu{'model_id'} =~ s/^0X//;
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){
6612 $cpu{'type'} = 'arm';
6613 if ($cpu{'model_name'} && $cpu{'model_name'} =~ /(.*)\srev\s([\S]+)\s(\(([\S]+)\))?/){
6614 $cpu{'model_name'} = $1;
6618 $cpu{'model_name'} .= ' ' . $cpu{'arch'} if $cpu{'model_name'} !~ /$cpu{'arch'}/i;
6620 #$cpu{'processors'}[$proc_count] = 0;
6623 elsif ($b_mips || $line[1] =~ /mips/i){
6625 $cpu{'type'} = 'mips';
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)]);
6633 elsif (!$cpu{'siblings'} && $line[0] eq 'siblings' ){
6634 $cpu{'siblings'} = $line[1];
6636 elsif (!$cpu{'cores'} && $line[0] eq 'cpu cores' ){
6637 $cpu{'cores'} = $line[1];
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";
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
6657 $die_holder = $line[1];
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
6663 elsif ($line[1] == 0 && $die_holder > 0 ){
6664 $die_holder = $line[1];
6666 $die_id++ if ($cpu{'type'} ne 'intel' && $cpu{'type'} ne 'amd' );
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";
6672 if (!$cpu{'type'} && $line[0] eq 'vendor_id' ){
6673 $cpu{'type'} = cpu_vendor($line[1]);
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;
6681 elsif ($line[1] =~ /(\d+)\sMB$/){
6682 $cpu{'l2-cache'} = ($1*1024);
6685 if (!$cpu{'flags'} && ($line[0] eq 'flags' || $line[0] eq 'features' )){
6686 $cpu{'flags'} = $line[1];
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;
6696 if ( !$cpu{'bugs'} && $line[0] eq 'bugs'){
6697 $cpu{'bugs'} = $line[1];
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//;
6706 $cpu{'microcode'} = uc(sprintf("%x", $line[1]));
6711 $cpu{'phys'} = scalar @phys_cpus;
6712 $cpu{'dies'} = $die_id++; # count starts at 0, all cpus have 1 die at least
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;
6719 $cpu{'type'} = 'arm' if !$cpu{'type'};
6721 my %arm_cpus = arm_cpu_name();
6722 $cpu{'arm-cpus'} = \%arm_cpus if %arm_cpus;
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";
6731 if (!$speeds{'cur-freq'}){
6732 $cpu{'cur-freq'} = $cpu{'processors'}[0];
6733 $speeds{'min-freq'} = 0;
6734 $speeds{'max-freq'} = 0;
6737 $cpu{'cur-freq'} = $speeds{'cur-freq'};
6738 $cpu{'min-freq'} = $speeds{'min-freq'};
6739 $cpu{'max-freq'} = $speeds{'max-freq'};
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;
6748 eval $start if $b_log;
6750 my %cpu = set_cpu_data();
6751 my (@ids,@line,%speeds,@working);
6753 my ($cache,$die_holder,$die_id,$phys_holder,$phys_id,$proc_count,$speed) = (0,0,0,0,0,0,0);
6755 @line = split /\s*:\s*/, $_;
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;
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');
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');
6781 if ( $line[1] =~ /\)$/ ){
6782 $line[1] =~ s/\s*\(.*\)$//;
6784 $cpu{'model_name'} = $line[1];
6785 $cpu{'type'} = cpu_vendor($line[1]);
6787 # NOTE: hw.l1icachesize: hw.l1dcachesize:
6788 elsif ($line[0] eq 'hw.l1icachesize') {
6789 $cpu{'l1-cache'} = $line[1]/1024;
6791 elsif ($line[0] eq 'hw.l2cachesize') {
6792 $cpu{'l2-cache'} = $line[1]/1024;
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];
6798 # these are in hz: 2400000000
6799 elsif ($line[0] eq 'hw.cpufrequency') {
6800 $cpu{'cur-freq'} = $line[1]/1000000;
6802 elsif ($line[0] eq 'hw.busfrequency_min') {
6803 $cpu{'min-freq'} = $line[1]/1000000;
6805 elsif ($line[0] eq 'hw.busfrequency_max') {
6806 $cpu{'max-freq'} = $line[1]/1000000;
6808 elsif ($line[0] eq 'machdep.cpu.vendor') {
6809 $cpu{'type'} = cpu_vendor($line[1]);
6812 elsif ($line[0] eq 'machdep.cpu.features') {
6813 $cpu{'flags'} = lc($line[1]);
6815 elsif ($line[0] eq 'hw.ncpu' ) {
6816 $cpu{'cores'} = $line[1];
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;
6829 elsif (!$cpu{'cur-freq'} && $line[0] eq 'dev.cpu.0.freq' ) {
6830 $cpu{'cur-freq'} = $line[1];
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;
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;
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] ){
6853 $phys_holder = $line[1];
6854 $ids[$phys_id] = ([(0)]);
6855 $ids[$phys_id][$die_id] = ([(0)]);
6858 elsif ( $line[0] eq 'hw.cpu_topology.cpu0.core_id' ){
6860 $die_holder = $line[1];
6862 # this handles multi die cpus like 16 core ryzen
6863 elsif ($line[1] == 0 && $die_holder > 0 ){
6865 $die_holder = $line[1];
6867 $ids[$phys_id][$die_id][$line[1]] = $speed;
6868 $cpu{'dies'} = $die_id;
6871 if (!$cpu{'flags'}){
6872 $cpu{'flags'} = cpu_flags_bsd();
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;
6880 sub cpu_properties {
6882 my ($b_amd_zen,$b_epyc,$b_ht,$b_intel,$b_ryzen,$b_xeon);
6884 if ($cpu{'type'} eq 'intel'){
6886 $b_xeon = 1 if $cpu{'model_name'} =~ /Xeon/i;
6888 elsif ($cpu{'type'} eq 'amd' ){
6889 if ( $cpu{'family'} && $cpu{'family'} eq '17' ) {
6891 if ($cpu{'model_name'} ){
6892 if ($cpu{'model_name'} =~ /Ryzen/i ){
6895 elsif ($cpu{'model_name'} =~ /EPYC/i){
6902 #my @dies = $phys[0][0];
6903 my $ref = $cpu{'ids'};
6905 my $phyical_count = 0;
6906 #my $phyical_count = scalar @phys;
6908 my ($speed,$speed_key);
6909 # handle case where cpu reports say, phys id 0, 2, 4, 6 [yes, seen it]
6911 $phyical_count++ if $_;
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 ){
6927 my @dies = @$die_ref;
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;
6941 #print 'cores: ' . $core_count, "\n";
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'};
6952 elsif ($core_count > $cpu{'cores'}){
6953 $cpu_cores = $core_count;
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
6962 if ($cpu{'siblings'} && $cpu{'siblings'} > 1 && $cpu{'cores'} && $cpu{'cores'} > 1 ){
6963 if ( $cpu{'siblings'}/$cpu{'cores'} == 1 ){
6968 $cpu_cores = ($cpu{'siblings'}/2);
6973 # ryzen is made out of blocks of 8 core dies
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];
6981 # these always have 4 dies
6983 $cpu_cores = $cpu{'cores'};
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);
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;
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;;
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;
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){
7022 $cpu{'siblings'} = 1;
7024 #print "pc: $processors_count s: $cpu{'siblings'} cpuc: $cpu_cores corec: $core_count\n";
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 ) ) {
7033 if ($processors_count == ($phyical_count * $cpu_cores * 2)){
7037 # elsif ($b_xeon && $cpu{'siblings'} > 1){
7039 # $cpu_type .= 'MT';
7041 elsif ($cpu{'siblings'} > 1 && ($cpu{'siblings'} == 2 * $cpu_cores )){
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';
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';
7055 # >1 cpu sockets active: Symetric Multi Processing
7056 if ($phyical_count > 1){
7057 my $sep = ($cpu_type) ? ' ' : '' ;
7058 $cpu_type .= $sep . 'SMP';
7064 if ($phyical_count > 1){
7065 $cpu_layout = $phyical_count . 'x ';
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
7071 $cache = $cpu{'l2-cache'} * $phyical_count;
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;
7077 elsif ($cpu{'type'} ne 'intel'){
7078 $cache = $cpu{'l2-cache'} * $cpu_cores * $phyical_count;
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
7083 $cache = $cpu{'l2-cache'} * $phyical_count;
7085 if ($cache > 10000){
7086 $cache = sprintf("%.01f MiB",$cache/1024); # trim to no decimals?
7089 $cache = "$cache KiB";
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";
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";
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)";
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";
7113 elsif ($cpu{'cur-freq'} && !$cpu{'max-freq'}){
7114 $speed_key = ($show{'short'} || $show{'cpu-basic'}) ? 'speed' : 'Speed';
7115 $speed = "$cpu{'cur-freq'} MHz";
7118 if ( !$bits_sys && !$b_arm && $cpu{'flags'} ){
7119 $bits_sys = ($cpu{'flags'} =~ /\blm\b/) ? 64 : 32;
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,
7129 'l2-cache' => $cache,
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;
7140 eval $start if $b_log;
7141 my (@processors) = @_;
7143 my @files = main::globber('/sys/devices/system/cpu/cpu*/cpufreq/scaling_cur_freq');
7145 my $speed = (main::reader($_))[0];
7146 if ($speed || $speed eq '0'){
7147 $speed = sprintf "%.0f", $speed/1000;
7148 push @speeds, $speed;
7152 foreach (@processors){
7153 if ($_ || $_ eq '0'){
7154 $_ = sprintf "%.0f", $_;
7159 #print join '; ', @speeds, "\n";
7160 eval $end if $b_log;
7163 sub set_cpu_speeds_sys {
7164 eval $start if $b_log;
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){
7171 ($cur,$min,$max) = ('scaling_cur_freq','cpuinfo_min_freq','cpuinfo_max_freq');
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');
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
7186 if (scalar @arm > 1){
7187 my ($current,$max,$min) = (0,0,0);
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){
7195 my $min_temp = main::reader("$_/cpuinfo_min_freq");
7196 $min_temp = speed_cleaner($min_temp,'khz');
7197 if ($min_temp < $min || $min == 0){
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;
7206 $speeds{'cur-freq'} = $current if $current;
7207 $speeds{'max-freq'} = $max if $max;
7208 $speeds{'min-freq'} = $min if $min;
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;
7217 main::log_data('dump','%speeds',\%speeds) if $b_log;
7218 eval $end if $b_log;
7222 # right now only using this for ARM cpus, this is not the same in intel/amd
7224 eval $start if $b_log;
7225 my @data = main::globber('/sys/devices/system/cpu/cpu*/topology/core_siblings_list');
7228 my $siblings = (main::reader($_))[0];
7229 if (! grep {/$siblings/} @dies){
7230 push @dies, $siblings;
7233 my $die_count = scalar @dies;
7234 eval $end if $b_log;
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');
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];
7261 $flags =~ s/\s+/ /g;
7262 $flags =~ s/^\s+|\s+$//g;
7266 if ( $file && ! -r $file ){
7267 $flags = main::row_defaults('dmesg-boot-permissions');
7270 eval $end if $b_log;
7275 eval $start if $b_log;
7277 my ($vendor) = ('');
7278 $string = lc($string);
7279 if ($string =~ /intel/) {
7282 elsif ($string =~ /amd/){
7286 elsif ($string =~ /centaur/){
7289 eval $end if $b_log;
7292 sub get_boost_status {
7293 eval $start if $b_log;
7295 my $path = '/sys/devices/system/cpu/cpufreq/boost';
7297 $boost = (main::reader($path))[0];
7298 if (defined $boost && $boost =~/^[01]$/){
7299 $boost = ($boost) ? 'enabled' : 'disabled';
7302 eval $end if $b_log;
7306 eval $start if $b_log;
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;
7319 main::log_data('dump','%cpus',\%cpus) if $b_log;
7320 eval $end if $b_log;
7325 eval $start if $b_log;
7326 my ($type,$family,$model) = @_;
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'}
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'}
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+'}
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+'}
7354 elsif ($family eq '10'){
7355 if ( $model =~ /^(2|4|5|6|8|9|A)$/ ) {$arch = 'K10'}
7356 else {$arch = 'K10'}
7358 elsif ($family eq '11'){
7359 if ( $model =~ /^(3)$/ ) {$arch = 'Turion X2 Ultra'}
7361 # might also need cache handling like 14/16
7362 elsif ($family eq '12'){
7363 if ( $model =~ /^(1)$/ ) {$arch = 'Fusion'}
7364 else {$arch = 'Fusion'}
7367 elsif ($family eq '14'){
7368 if ( $model =~ /^(1|2)$/ ) {$arch = 'Bobcat'}
7369 else {$arch = 'Bobcat'}
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'}
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'}
7384 elsif ($family eq '17'){
7385 if ( $model =~ /^(1)$/ ) {$arch = 'Zen'}
7386 else {$arch = 'Zen'}
7389 elsif ( $type eq 'arm'){
7390 if ($family ne ''){$arch="ARMv$family";}
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'}
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'}
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'}
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'}
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
7453 # itanium 1 family 7 all recalled
7454 elsif ($family eq 'B'){
7455 if ( $model =~ /^(1)$/ ) {$arch = 'Knights Corne'}
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'}
7466 eval $end if $b_log;
7473 my @alpha = qw(Single Dual Triple Quad);
7478 $count = $alpha[$count-1] . ' ' if $count > 0;
7492 'l1-cache' => 0, # store in KB
7493 'l2-cache' => 0, # store in KB
7494 'l3-cache' => 0, # store in KB
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;
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;
7527 sub hex_and_decimal {
7530 $data .= ' (' . hex($data) . ')' if hex($data) ne $data;
7542 my ($b_hddtemp,$b_nvme);
7543 my ($hddtemp,$nvme) = ('','');
7544 my (@by_id,@by_path);
7547 eval $start if $b_log;
7548 my (@data,@rows,$key1,$val1);
7550 $type ||= 'standard';
7552 @data = disk_data($type);
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');
7565 $val1 = main::row_defaults('dmesg-boot-missing');
7568 $val1 = main::row_defaults('disk-data-bsd');
7570 @data = ({main::key($num++,$key1) => $val1,});
7571 @rows = (@rows,@data);
7576 # print Data::Dumper::Dumper \@rows;
7581 $val1 = main::row_defaults('disk-data');
7582 @rows = ({main::key($num++,$key1) => $val1,});
7586 $val1 = main::row_defaults('disk-data');
7587 @data = ({main::key($num++,$key1) => $val1,});
7589 #@rows = (@rows,@data);
7591 if ($show{'optical'} || $show{'optical-basic'}){
7592 @data = OpticalData::get();
7593 @rows = (@rows,@data);
7595 ($b_hddtemp,$b_nvme,$hddtemp,$nvme) = (undef,undef,undef,undef);
7596 (@by_id,@by_path) = (undef,undef);
7597 eval $end if $b_log;
7601 eval $start if $b_log;
7603 #print Data::Dumper::Dumper \@disks;
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;
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];
7617 @sizing = main::get_size($disks[0]{'used'}) if $disks[0]{'used'};
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) . '%)';
7630 main::key($num++,'Local Storage') => '',
7631 main::key($num++,'total') => $size,
7632 main::key($num++,'used') => $used,
7634 @rows = (@rows,@data);
7636 if ( $show{'disk'} && @disks){
7637 @disks = sort { $a->{'id'} cmp $b->{'id'} } @disks;
7638 foreach my $ref (@disks){
7639 ($id,$model,$size) = ('','','');
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;
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];
7660 main::key($num++,'ID') => $id,
7662 @rows = (@rows,@data);
7664 $rows[$j]{main::key($num++,'type')} = $row{'type'},
7666 if ($row{'vendor'}){
7667 $rows[$j]{main::key($num++,'vendor')} = $row{'vendor'},
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'};
7675 if ($extra > 2 && $row{'rotation'}){
7676 $rows[$j]{main::key($num++,'rotation')} = $row{'rotation'};
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'};
7685 if ($extra > 0 && $row{'temp'}){
7686 $rows[$j]{main::key($num++,'temp')} = $row{'temp'} . ' C';
7688 # extra level tests already done
7689 if (defined $row{'partition-table'}){
7690 $rows[$j]{main::key($num++,'scheme')} = $row{'partition-table'};
7695 eval $end if $b_log;
7699 eval $start if $b_log;
7701 my (@rows,@data,@devs);
7704 PartitionData::partition_data() if !$b_partitions;
7705 foreach my $ref (@partitions){
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'};
7721 if (!$bsd_type && (my $file = main::system_files('partitions'))){
7722 @data = proc_data($used,$file);
7725 @data = dmesg_boot_data($used);
7727 #print Data::Dumper::Dumper \@data;
7728 main::log_data('data',"used: $used") if $b_log;
7729 eval $end if $b_log;
7733 eval $start if $b_log;
7734 my ($used,$file) = @_;
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){
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]/;
7750 'size' => $drive_size,
7757 @drives = (@drives,@data);
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 ) {
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 ) ) {
7773 # print Data::Dumper::Dumper \@drives;
7774 main::log_data('data',"size: $size") if $b_log;
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);
7785 main::log_data('dump','@data',\@data) if $b_log;
7786 # print Data::Dumper::Dumper \@data;
7787 eval $end if $b_log;
7790 sub proc_data_advanced {
7791 eval $start if $b_log;
7792 my ($b_hdx,@drives) = @_;
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
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;
7820 if ($file = main::system_files('scsi')){
7821 @scsi = scsi_data($file);
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) = ('','','','','','','');
7829 @data = advanced_disk_data($pt_cmd,$drives[$i]{'id'});
7831 $drives[$i]{'partition-table'} = uc($data[1]) if $data[1];
7832 $drives[$i]{'rotation'} = "$data[2] rpm" if $data[2];
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/";
7841 elsif ($drives[$i]{'id'} =~ /mmcblk/){
7842 $block_type = 'mmc';
7843 $working_path = "/sys/block/$drives[$i]{'id'}/device/";
7845 elsif ($drives[$i]{'id'} =~ /nvme/){
7846 $block_type = 'nvme';
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[^\/]*$//;
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
7859 foreach my $ref (@scsi){
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'};
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";
7880 $model = (main::reader($path,'strip'))[0];
7882 $drives[$i]{'model'} = $model;
7885 elsif ($block_type eq 'mmc' && -e "${working_path}name"){
7886 $path = "${working_path}name";
7887 $model = (main::reader($path,'strip'))[0];
7889 $drives[$i]{'model'} = $model;
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];
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];
7905 $path = "${working_path}removable";
7906 $drives[$i]{'type'} = 'Removable' if -e $path && (main::reader($path,'strip'))[0]; # 0/1 value
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";
7913 $drives[$i]{'temp'} = hdd_temp("/dev/$drives[$i]{'id'}");
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];
7922 $path = "${working_path}serial";
7924 $serial = (main::reader($path,'strip'))[0];
7925 $drives[$i]{'serial'} = $serial if $serial;
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";
7933 $drives[$i]{'firmware'} = (main::reader($path,'strip'))[0];
7941 # print Data::Dumper::Dumper \@drives;
7942 eval $end if $b_log;
7945 # camcontrol identify <device> |grep ^serial (this might be (S)ATA specific)
7946 # smartcl -i <device> |grep ^Serial
7947 # see smartctl; camcontrol devlist; gptid status;
7948 sub dmesg_boot_data {
7949 eval $start if $b_log;
7951 my (@data,@drives,@temp);
7952 my ($id_holder,$i,$size,$working) = ('',0,0,0);
7953 my $file = main::system_files('dmesg-boot');
7955 foreach (@dm_boot_disk){
7956 my @row = split /:\s*/, $_;
7957 next if ! defined $row[1];
7958 if ($id_holder ne $row[0]){
7960 # print "$i $id_holder $row[0]\n";
7961 $id_holder = $row[0];
7963 # no dots, note: ada2: 2861588MB BUT: ada2: 600.000MB/s
7964 if (! exists $drives[$i]){
7966 $drives[$i]{'id'} = $row[0];
7967 $drives[$i]{'firmware'} = '';
7968 $drives[$i]{'temp'} = '';
7969 $drives[$i]{'type'} = '';
7970 $drives[$i]{'vendor'} = '';
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;
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];
7989 # print "openbsd\n";
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;
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;
8003 if ($row[1] =~ /^Serial\sNumber\s(.*)/){
8004 $drives[$i]{'serial'} = $1;
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'};
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];
8017 $size = main::row_defaults('data-bsd');
8020 elsif ( $file && ! -r $file ){
8021 $size = main::row_defaults('dmesg-boot-permissions');
8024 $size = main::row_defaults('dmesg-boot-missing');
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;
8035 # print Data::Dumper::Dumper \@data;
8036 eval $end if $b_log;
8040 # check for usb/firewire/[and thunderwire when data found]
8041 sub peripheral_data {
8042 eval $start if $b_log;
8045 # print "$id here\n";
8048 if ("/dev/$id" eq Cwd::abs_path($_)){
8049 #print "$id here\n";
8053 elsif (/ieee1394--/i){
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($_)){
8067 elsif (/ieee1394--/i){
8074 eval $end if $b_log;
8077 sub advanced_disk_data {
8078 eval $start if $b_log;
8079 my ($set_cmd,$id) = @_;
8080 my ($cmd,$pt,$program,@data,@return);
8081 if ($set_cmd ne 'unset'){
8082 $return[0] = $set_cmd;
8085 # runs as user, but is SLOW: udisksctl info -b /dev/sda
8086 # line: org.freedesktop.UDisks2.PartitionTable:
8088 if ($program = main::check_program('udevadm')){
8089 $return[0] = "$program info -q property -n ";
8091 elsif ($b_root && -e "/lib/udev/udisks-part-id") {
8092 $return[0] = "/lib/udev/udisks-part-id /dev/";
8094 elsif ($b_root && ($program = main::check_program('fdisk'))) {
8095 $return[0] = "$program -l /dev/";
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/){
8109 if (/^WARNING:\s+GPT/){
8113 elsif (/^Disklabel\stype:\s*(.+)/i){
8118 $return[1] = 'dos' if !$return[1];
8122 if ( /^(UDISKS_PARTITION_TABLE_SCHEME|ID_PART_TABLE_TYPE)/ ){
8123 my @working = split /=/, $_;
8124 $return[1] = $working[1];
8126 elsif (/^ID_ATA_ROTATION_RATE_RPM/){
8127 my @working = split /=/, $_;
8128 $return[2] = $working[1];
8130 last if $return[1] && $return[2];
8133 $return[1] = 'mbr' if $return[1] && lc($return[1]) eq 'dos';
8135 eval $end if $b_log;
8139 eval $start if $b_log;
8141 my @temp = main::reader($file);
8143 my ($firmware,$model,$vendor) = ('','','');
8145 if (/Vendor:\s*(.*)\s+Model:\s*(.*)\s+Rev:\s*(.*)/i){
8151 if (/Type:\s*Direct-Access/i){
8153 'vendor' => $vendor,
8155 'firmware' => $firmware,
8157 @scsi = (@scsi,@working);
8160 ($firmware,$model,$vendor) = ('','','');
8164 main::log_data('dump','@scsi', \@scsi) if $b_log;
8165 eval $end if $b_log;
8168 # @b_id has already been cleaned of partitions, wwn-, nvme-eui
8169 sub disk_data_by_id {
8170 eval $start if $b_log;
8172 my ($model,$serial,$vendor) = ('','','');
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);
8194 eval $end if $b_log;
8197 # receives space separated string that may or may not contain vendor data
8199 eval $start if $b_log;
8200 my ($model,$serial) = @_;
8201 my ($vendor) = ('');
8204 # 0 - match pattern; 1 - replace pattern; 2 - vendor print; 3 - serial pattern
8205 # Data URLs: inxi-resources.txt Section: DiskData device_vendor()
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_
8305 foreach my $ref (@vendors){
8307 if ($model =~ /$row[0]/i || ($row[3] && $serial && $serial =~ /$row[3]/)){
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);
8316 eval $end if $b_log;
8319 # Normally hddtemp requires root, but you can set user rights in /etc/sudoers.
8320 # args: $1 - /dev/<disk> to be tested for
8322 eval $start if $b_log;
8325 my (@data,$hdd_temp);
8326 if ($device =~ /nvme/i){
8329 if ($path = main::check_program('nvme')) {
8334 $device =~ s/n[0-9]//;
8335 @data = main::grabber("$sudo$nvme smart-log $device 2>/dev/null");
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];
8350 if ($path = main::check_program('hddtemp')) {
8355 $hdd_temp = (main::grabber("$sudo$hddtemp -nq -u C $device 2>/dev/null"))[0];
8358 eval $end if $b_log;
8362 eval $start if $b_log;
8364 my ($b_nvme,$lanes,$speed,@data);
8365 my $working = Cwd::abs_path("/sys/class/block/$device");
8366 #print "$working\n";
8369 # slice out the ata id:
8370 # /sys/devices/pci0000:00:11.0/ata1/host0/target0:
8371 if ($working =~ /^.*\/ata([0-9]+)\/.*/){
8374 # /sys/devices/pci0000:00/0000:00:05.0/virtio1/block/vda
8375 elsif ($working =~ /^.*\/virtio([0-9]+)\/.*/){
8378 # /sys/devices/pci0000:10/0000:10:01.2/0000:13:00.0/nvme/nvme0/nvme0n1
8379 elsif ($working =~ /^.*\/(nvme[0-9]+)\/.*/){
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;
8388 # print "$working $id\n";
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/){
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";
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;
8419 @data = ($speed,$lanes);
8420 #print "$working $speed\n";
8421 eval $end if $b_log;
8424 # gptid/c5e940f1-5ce2-11e6-9eeb-d05099ac4dc2 N/A ada0p1
8426 eval $start if $b_log;
8428 return if !@glabel || ! $gptid;
8429 #$gptid =~ s/s[0-9]+$//;
8430 my ($dev_id) = ('');
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 ) ){
8441 $dev_id ||= $gptid; # no match? return full string
8442 eval $end if $b_log;
8446 eval $start if $b_log;
8448 if (my $path = main::check_program('glabel')){
8449 @glabel = main::grabber("$path status 2>/dev/null");
8451 main::log_data('dump','@glabel:with Headers',\@glabel) if $b_log;
8452 # get rid of first header line
8454 eval $end if $b_log;
8460 package GraphicData;
8461 my $driver = ''; # we need this as a fallback in case no xorg.0.log
8463 eval $start if $b_log;
8466 if (($b_arm || $b_mips) && !$b_soc_gfx && !$b_pci_tool){
8467 my $key = ($b_arm) ? 'ARM' : 'MIPS';
8469 main::key($num++,$key) => main::row_defaults(lc($key) . '-pci',''),
8471 @rows = (@rows,@data);
8474 @data = card_data();
8475 @rows = (@rows,@data);
8477 my $key = 'Message';
8479 main::key($num++,$key) => main::row_defaults('pci-card-data',''),
8481 @rows = (@rows,@data);
8484 @data = display_data();
8485 @rows = (@rows,@data);
8487 @rows = (@rows,@data);
8488 eval $end if $b_log;
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
8508 eval $start if $b_log;
8510 my ($j,$num) = (0,1);
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";
8520 my $card = main::trimmer($row[4]);
8521 $card = ($card) ? main::pci_cleaner($card,'output') : '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);
8528 main::key($num++,'Card') => $card,
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;
8535 $rows[$j]{main::key($num++,'driver')} = $driver;
8536 if ($row[9] && !$bsd_type){
8537 my $version = main::get_module_version($row[9]);
8539 $rows[$j]{main::key($num++,'v')} = $version;
8542 $rows[$j]{main::key($num++,'bus ID')} = (!$row[2] && !$row[3]) ? 'N/A' : "$row[2].$row[3]";
8545 $rows[$j]{main::key($num++,'chip ID')} = ($row[5]) ? "$row[5]:$row[6]" : $row[6];
8550 #my $ref = $pci[-1];
8551 #print $$ref[0],"\n";
8552 eval $end if $b_log;
8556 eval $start if $b_log;
8557 my (%graphics,@row);
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')){
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');
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
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';
8585 # initial tests, if wayland, it is certainly a compositor
8586 $protocol = lc($protocol) if $protocol;
8587 $graphics{'compositor'} = display_compositor($protocol);
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] );
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';
8610 $graphics{'vendor'} = $working[1];
8612 elsif ($working[0] eq 'version number'){
8613 $graphics{'version-id'} = $working[1];
8615 elsif ($working[0] eq 'vendor release number'){
8616 $graphics{'vendor-release'} = $working[1];
8618 elsif ($working[0] eq 'X.Org version'){
8619 $graphics{'xorg-version'} = $working[1];
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]]);
8628 $graphics{'dimensions'} = ([$working[1]]);
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'};
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');
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]);
8653 $graphics{'screens'} = ([$screen]);
8661 $graphics{'tty'} = tty_data();
8665 $graphics{'screens'} = ([main::row_defaults('xdpyinfo-missing')]);
8669 $graphics{'tty'} = tty_data();
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'};
8678 #print Data::Dumper::Dumper \%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";
8686 elsif ($graphics{'version'}) {
8687 $server_string = "X.org $graphics{'version'}";
8689 if ($graphics{'screens'}){
8690 my $ref = $graphics{'screens'};
8691 my @screens = @$ref;
8694 $resolution .= $sep . $_;
8698 my @drivers = x_drivers();
8699 if (!$protocol && !$server_string && !$graphics{'vendor'} && !@drivers){
8700 $server_string = main::row_defaults('display-server');
8702 main::key($num++,'Display') => '',
8703 main::key($num++,'server') => $server_string,
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;
8713 main::key($num++,'Display') => $protocol,
8714 main::key($num++,'server') => $server_string,
8715 main::key($num++,'driver') => $driver,
8718 $row[0]{main::key($num++,'FAILED')} = $drivers[2];
8721 $row[0]{main::key($num++,'unloaded')} = $drivers[1];
8723 if ($extra > 1 && $drivers[3]){
8724 $row[0]{main::key($num++,'alternate')} = $drivers[3];
8726 if ($graphics{'compositor'}){
8727 $row[0]{main::key($num++,'compositor')} = $graphics{'compositor'};
8731 $row[0]{main::key($num++,'resolution')} = $resolution;
8734 $graphics{'tty'} ||= 'N/A';
8735 $row[0]{main::key($num++,'tty')} = $graphics{'tty'};
8738 eval $end if $b_log;
8742 eval $start if $b_log;
8745 #print ("$b_display : $b_root\n");
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");
8751 my $type = 'display-console';
8753 $type = 'display-root-x';
8756 $type = 'display-null';
8759 main::key($num++,'Message') => main::row_defaults($type),
8763 #print join "\n",@glxinfo,"\n";
8764 my $compat_version = '';
8765 my ($b_compat,@core_profile_version,@direct_render,@renderer,@opengl_version,@working);
8768 if (/^opengl renderer/i){
8769 @working = split /:\s*/, $_;
8770 $working[1] = main::cleaner($working[1]);
8772 #if ($working[1] =~ /mesa/i){
8775 push @renderer, $working[1];
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];
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];
8801 elsif (/direct rendering/){
8802 @working = split /:\s*/, $_;
8803 push @direct_render, $working[1];
8805 # if -B was always available, we could skip this, but it is not
8806 elsif (/GLX Visuals/){
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;
8820 $version = join ', ', @opengl_version if @opengl_version;
8821 $renderer = join ', ', @renderer if @renderer;
8823 main::key($num++,'OpenGL') => '',
8824 main::key($num++,'renderer') => $renderer,
8825 main::key($num++,'v') => $version,
8828 if ($b_compat && $extra > 1 && $compat_version){
8829 $row[0]{main::key($num++,'compat-v')} = $compat_version;
8832 $row[0]{main::key($num++,'direct render')} = $direct_render;
8837 main::key($num++,'Message') => main::row_defaults('glxinfo-missing'),
8842 my $type = 'display-console';
8843 if (!main::check_program('glxinfo')){
8844 $type = 'glxinfo-missing';
8848 $type = 'display-root';
8851 $type = 'display-try';
8855 main::key($num++,'Message') => main::row_defaults($type),
8858 eval $end if $b_log;
8862 eval $start if $b_log;
8864 if ($size{'term-cols'}){
8865 $tty = "$size{'term-cols'}x$size{'term-lines'}";
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];
8873 my @temp = split /\s+/, $tty;
8874 $tty = "$temp[1]x$temp[0]";
8878 eval $end if $b_log;
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
8899 #@xorg = grep {/Failed|Unload|Loading/} @xorg;
8901 next if !/Failed|Unload|Loading/;
8903 # note that in file names, driver is always lower case
8904 if (/\sLoading.*($list)_drv.so$/i ) {
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';
8910 # openbsd uses UnloadModule:
8911 elsif (/(Unloading\s|UnloadModule).*\"?($list)(_drv.so)?\"?$/i ) {
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';
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
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
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';
8937 # reset the previous line's 'unloaded' to 'loaded' as well
8939 $drivers{$driver}='loaded';
8942 elsif ($_ =~ /module does not exist/){
8943 $drivers{$driver}='alternate';
8948 foreach (sort keys %drivers){
8949 if ($drivers{$_} eq 'loaded') {
8950 $sep = ($loaded) ? ',' : '';
8951 $loaded .= $sep . $_;
8953 elsif ($drivers{$_} eq 'unloaded') {
8954 $sep = ($unloaded) ? ',' : '';
8955 $unloaded .= $sep . $_;
8957 elsif ($drivers{$_} eq 'failed') {
8958 $sep = ($failed) ? ',' : '';
8959 $failed .= $sep . $_;
8961 elsif ($drivers{$_} eq 'alternate') {
8962 $sep = ($alternate) ? ',' : '';
8963 $alternate .= $sep . $_;
8967 @driver_data = ($loaded,$unloaded,$failed,$alternate);
8969 eval $end if $b_log;
8970 return @driver_data;
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");
8979 elsif ($program = main::check_program('X')){
8980 @data = main::grabber("$program -version 2>&1");
8982 #print Data::Dumper::Dumper \@data;
8985 if (/^X.org X server/i){
8986 my @working = split /\s+/, $_;
8987 $version = $working[3];
8990 elsif (/^X Window System Version/i) {
8991 my @working = split /\s+/, $_;
8992 $version = $working[4];
8997 eval $end if $b_log;
9000 # $1 - protocol: wayland|x11
9001 sub display_compositor {
9002 eval $start if $b_log;
9003 my ($protocol) = @_;
9004 my ($compositor) = ('');
9005 main::set_ps_gui() if ! $b_ps_gui;
9007 # 1 check program; 2 search; 3 unused version; 4 print
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'],
9039 foreach my $ref (@compositors){
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];
9049 main::log_data('data',"compositor: $compositor") if $b_log;
9050 eval $end if $b_log;
9057 package MachineData;
9060 eval $start if $b_log;
9061 my (%soc_machine,@data,@rows,$key1,$val1,$which);
9063 if ($bsd_type && @sysctl_machine && !$b_dmidecode_force ){
9064 @data = machine_data_sysctl();
9065 if (!@data && !$key1){
9067 $val1 = main::row_defaults('machine-data-force-dmidecode','');
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);
9078 @data = machine_data_dmi();
9079 if (!@data && !$key1){
9081 $val1 = main::row_defaults('machine-data','');
9085 elsif (-d '/sys/class/dmi/id/') {
9086 @data = machine_data_sys();
9089 $val1 = main::row_defaults('machine-data-dmidecode','');
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;
9100 $val1 = main::row_defaults('machine-data-force-dmidecode','');
9103 # if error case, null data, whatever
9105 @data = ({main::key($num++,$key1) => $val1,});
9107 eval $end if $b_log;
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
9115 # 12-chassis_vendor 13-chassis_type 14-chassis_version 15-chassis_serial
9116 ## unused: 16-bios_rev 17-bios_romsize 18 - firmware type
9118 eval $start if $b_log;
9120 my (%data,@row,@rows);
9122 my $firmware = 'BIOS';
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";
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'})){
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'} ) ) ){
9149 $data{'device'} ||= 'N/A';
9152 main::key($num++,'Type') => ucfirst($data{'device'}),
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
9168 if ($data{'board_version'} && $data{'chassis_version'} eq $data{'board_version'}){
9169 $b_skip_chassis = 1;
9171 if (!$b_skip_chassis && $data{'chassis_vendor'} ){
9172 if ($data{'chassis_vendor'} ne $data{'sys_vendor'} ){
9173 $chassis_vendor = $data{'chassis_vendor'};
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'};
9179 if ($data{'chassis_version'}){
9180 $chassis_version = $data{'chassis_version'};
9181 $chassis_version =~ s/^v([0-9])/$1/i;
9183 $chassis_serial = main::apply_filter($data{'chassis_serial'});
9184 $chassis_vendor ||= '';
9185 $chassis_type ||= '';
9186 $rows[$j]{main::key($num++,'Chassis')} = $chassis_vendor;
9188 $rows[$j]{main::key($num++,'type')} = $chassis_type;
9190 if ($chassis_version){
9191 $rows[$j]{main::key($num++,'v')} = $chassis_version;
9193 $rows[$j]{main::key($num++,'serial')} = $chassis_serial;
9196 $j++; # start new row
9198 if ($data{'firmware'}){
9199 $firmware = $data{'firmware'};
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'};
9213 $bios_version ||= 'N/A';
9214 if ($data{'bios_date'}){
9215 $bios_date = $data{'bios_date'};
9217 $bios_date ||= 'N/A';
9218 if ($extra > 1 && $data{'bios_romsize'}){
9219 $bios_romsize = $data{'bios_romsize'};
9221 $rows[$j]{main::key($num++,'Mobo')} = $mobo_vendor;
9222 $rows[$j]{main::key($num++,'model')} = $mobo_model;
9224 $rows[$j]{main::key($num++,'v')} = $mobo_version;
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'};
9230 $rows[$j]{main::key($num++,$firmware)} = $bios_vendor;
9231 $rows[$j]{main::key($num++,'v')} = $bios_version;
9233 $rows[$j]{main::key($num++,'rev')} = $bios_rev;
9235 $rows[$j]{main::key($num++,'date')} = $bios_date;
9237 $rows[$j]{main::key($num++,'rom size')} = $bios_romsize;
9239 eval $end if $b_log;
9242 sub create_output_soc {
9243 my (%data,@row,@rows);
9244 my (%soc_machine) = @_;
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';
9258 my $device = $soc_machine{'device'};
9260 $rows[$j]{main::key($num++,$system)} = $device;
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'};
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'});
9275 eval $end if $b_log;
9279 sub machine_data_sys {
9280 eval $start if $b_log;
9281 my (%data,$path,$vm);
9282 my $sys_dir = '/sys/class/dmi/id/';
9283 my $sys_dir_alt = '/sys/devices/virtual/dmi/id/';
9284 my @sys_files = qw(bios_vendor bios_version bios_date
9285 board_name board_serial board_vendor board_version chassis_type
9286 product_name product_serial product_uuid product_version sys_vendor
9289 splice @sys_files, 0, 0, qw( chassis_serial chassis_vendor chassis_version);
9291 $data{'firmware'} = 'BIOS';
9292 # print Data::Dumper::Dumper \@sys_files;
9294 if ( -d $sys_dir_alt){
9295 $sys_dir = $sys_dir_alt;
9301 if ( -d '/sys/firmware/efi'){
9302 $data{'firmware'} = 'UEFI';
9304 elsif ( glob('/sys/firmware/acpi/tables/UEFI*') ){
9305 $data{'firmware'} = 'UEFI [Legacy]';
9307 foreach (@sys_files){
9308 $path = "$sys_dir$_";
9310 $data{$_} = (main::reader($path))[0];
9311 $data{$_} = ($data{$_}) ? main::dmi_cleaner($data{$_}) : '';
9313 elsif (!$b_root && -e $path && !-r $path ){
9314 $data{$_} = main::row_defaults('root-required');
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?';
9326 $data{'device'} = get_device_sys($data{'chassis_type'});
9330 # foreach (keys %data){
9331 # print "$_: $data{$_}\n";
9333 main::log_data('dump','%data',\%data) if $b_log;
9334 my @rows = create_output(\%data);
9335 eval $end if $b_log;
9338 # this will create an alternate machine data source
9339 # which will be used for alt ARM machine data in cases
9340 # where no dmi data present, or by cpu data to guess at
9341 # certain actions for arm only.
9342 sub machine_data_soc {
9343 eval $end if $b_log;
9344 my (%soc_machine,@temp);
9345 if (my $file = main::system_files('cpuinfo')){
9346 #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/arm/arm-shevaplug-1.2ghz.txt";
9347 my @data = main::reader($file);
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]);
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]);
9360 elsif (/^Revision/i){
9361 @temp = split /\s*:\s*/, $_;
9362 $soc_machine{'firmware'} = $temp[1];
9365 @temp = split /\s*:\s*/, $_;
9366 $soc_machine{'serial'} = $temp[1];
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;
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
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;
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;
9391 #print Data::Dumper::Dumper \%soc_machine;
9392 eval $end if $b_log;
9393 return %soc_machine;
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+
9403 # board_vendor: ASRock
9414 # sys_uuid: dmi/sysctl only
9416 sub machine_data_dmi {
9417 eval $start if $b_log;
9420 $data{'firmware'} = 'BIOS';
9422 # 0 bios; 1 system info; 2 board|base board info; 3 chassis info;
9423 # 4 processor info, use to check for hypervisor
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';}
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]) }
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]) }
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]) }
9486 if ( $data{'chassis_type'} && $data{'chassis_type'} ne 'Other' ){
9487 $data{'device'} = $data{'chassis_type'};
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';
9503 elsif ($ref[0] > 4){
9507 if (!$data{'device'}){
9508 $data{'device'} = get_device_vm($data{'sys_vendor'},$data{'product_name'});
9509 $data{'device'} ||= 'other-vm?';
9512 # foreach (keys %data){
9513 # print "$_: $data{$_}\n";
9515 main::log_data('dump','%data',\%data) if $b_log;
9516 my @rows = create_output(\%data);
9517 eval $end if $b_log;
9520 # As far as I know, only OpenBSD supports this method.
9521 # it uses hw. info from sysctl -a and bios info from dmesg.boot
9522 sub machine_data_sysctl {
9523 eval $start if $b_log;
9525 # ^hw\.(vendor|product|version|serialno|uuid)
9526 foreach (@sysctl_machine){
9528 my @item = split /:/, $_;
9530 if ($item[0] eq 'hw.vendor'){
9531 $data{'board_vendor'} = main::dmi_cleaner($item[1]);
9533 elsif ($item[0] eq 'hw.product'){
9534 $data{'board_name'} = main::dmi_cleaner($item[1]);
9536 elsif ($item[0] eq 'hw.version'){
9537 $data{'board_version'} = $item[1];
9539 elsif ($item[0] eq 'hw.serialno'){
9540 $data{'board_serial'} = $item[1];
9542 elsif ($item[0] eq 'hw.serial'){
9543 $data{'board_serial'} = $item[1];
9545 elsif ($item[0] eq 'hw.uuid'){
9546 $data{'board_uuid'} = $item[1];
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/;
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;
9563 my @rows = create_output(\%data);
9564 eval $end if $b_log;
9568 sub get_device_sys {
9569 eval $start if $b_log;
9570 my ($chasis_id) = @_;
9571 my ($device) = ('');
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;
9611 eval $start if $b_log;
9612 my ($manufacturer,$product_name) = @_;
9614 if ( my $program = main::check_program('systemd-detect-virt') ){
9615 my $vm_test = (main::grabber("$program 2>/dev/null"))[0];
9617 # kvm vbox reports as oracle, usually, unless they change it
9618 if (lc($vm_test) eq 'oracle'){
9621 elsif ( $vm_test ne 'none'){
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");
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'}
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);
9646 if ( grep {/innotek|vbox|virtualbox/i} @vm_data){
9649 elsif (grep {/vmware/i} @vm_data){
9652 elsif (grep {/Virtual HD/i} @vm_data){
9655 if (!$vm && (my $file = main::system_files('cpuinfo'))){
9656 my @info = main::reader($file);
9657 $vm = 'virtual-machine' if grep {/^flags.*hypervisor/} @info;
9659 if (!$vm && -e '/dev/vda' || -e '/dev/vdb' || -e '/dev/xvda' || -e '/dev/xvdb' ){
9660 $vm = 'virtual-machine';
9663 if (!$vm && $product_name){
9664 if ($product_name eq 'VMware'){
9667 elsif ($product_name eq 'VirtualBox'){
9670 elsif ($product_name eq 'KVM'){
9673 elsif ($product_name eq 'Bochs'){
9677 if (!$vm && $manufacturer && $manufacturer eq 'Xen'){
9680 eval $end if $b_log;
9688 package NetworkData;
9689 my ($b_ip_run,@ifs_found);
9691 eval $start if $b_log;
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
9699 @data = card_data();
9700 @rows = (@rows,@data) if @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';
9708 main::key($num++,$key) => main::row_defaults(lc($key) . '-pci',''),
9710 @rows = (@rows,@data);
9712 if ($show{'network-advanced'}){
9717 @data = advanced_data_sys('check','',0,'','');
9718 @rows = (@rows,@data) if @data;
9721 @data = advanced_data_bsd('check');
9722 @rows = (@rows,@data) if @data;
9727 @rows = (@rows,@data);
9729 eval $end if $b_log;
9742 # 11 driver nu (bsds)
9744 eval $start if $b_log;
9745 my ($b_wifi,@rows,@data,%holder);
9746 my ($j,$num) = (0,1);
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";
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;
9763 $holder{$chip_id}++;
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]);
9768 $card = ($card) ? main::pci_cleaner($card,'output') : 'N/A';
9772 main::key($num++,'Card') => $card,
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;
9779 if ($row[1] eq '0680'){
9780 $rows[$j]{main::key($num++,'type')} = 'network bridge';
9782 $rows[$j]{main::key($num++,'driver')} = $driver;
9784 if ($row[9] && !$bsd_type){
9785 my $version = main::get_module_version($row[9]);
9787 $rows[$j]{main::key($num++,'v')} = $version;
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') );
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;
9800 $rows[$j]{main::key($num++,'chip ID')} = $chip_id;
9802 if ($show{'network-advanced'}){
9804 @data = advanced_data_sys($row[5],$row[6],$holder{$chip_id},$b_wifi,'');
9807 @data = advanced_data_bsd("$row[9]$row[11]",$b_wifi);
9809 @rows = (@rows,@data);
9815 # we want to handle ARM errors in main get
9816 if (!@rows && !$b_arm){
9817 my $key = 'Message';
9819 main::key($num++,$key) => main::row_defaults('pci-card-data',''),
9821 @rows = (@rows,@data);
9824 #my $ref = $pci[-1];
9825 #print $$ref[0],"\n";
9826 eval $end if $b_log;
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);
9834 foreach my $ref (@usb){
9836 # a device will always be the second or > device on the bus
9839 ($product,$product2,$test,$vendor,$vendor2) = ('','','','','');
9840 if ($usb_level == 1){
9841 $product = main::cleaner($row[3]);
9844 foreach my $line (@row){
9845 my @working = split /:/, $line;
9846 if ($working[0] eq 'idVendor' && $working[2]){
9847 $vendor = main::cleaner($working[2]);
9849 if ($working[0] eq 'idProduct' && $working[2]){
9850 $product = main::cleaner($working[2]);
9852 if ($working[0] eq 'iVendor' && $working[2]){
9853 $product2 = main::cleaner($working[2]);
9855 if ($working[0] eq 'iProduct' && $working[2]){
9856 $product2 = main::cleaner($working[2]);
9858 if ($working[0] eq 'Descriptor_Configuration'){
9862 if ($vendor && $product){
9863 $product = ($product =~ /$vendor/) ? $product: "$vendor $product";
9865 elsif ($vendor && $product2){
9866 $product = ($product2 =~ /$vendor/) ? $product2: "$vendor $product2";
9868 elsif ($vendor2 && $product){
9869 $product = ($product =~ /$vendor2/) ? $product: "$vendor2 $product";
9871 elsif ($vendor2 && $product2){
9872 $product = ($product2 =~ /$vendor2/) ? $product2: "$vendor2 $product2";
9878 $product = $vendor2;
9880 $test = "$vendor $product $vendor2 $vendor2";
9882 if ($product && network_device($test)){
9883 @temp2 = main::get_usb_drivers($row[0],$row[2]) if !$bsd_type && -d "/sys/devices";
9885 $driver = $temp2[0] if $temp2[0];
9886 $path = $temp2[1] if $temp2[1];
9888 $driver ||= 'usb-network';
9890 main::key($num++,'Card') => $product,
9891 main::key($num++,'type') => 'USB',
9892 main::key($num++,'driver') => $driver,
9894 $b_wifi = check_wifi($product);
9895 @rows = (@rows,@data);
9897 $rows[$j]{main::key($num++,'bus ID')} = "$row[0]:$row[1]";
9900 $rows[$j]{main::key($num++,'chip ID')} = $row[2];
9902 if ($show{'network-advanced'}){
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);
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.
9913 # @data = advanced_data_bsd($row[2],$b_wifi);
9915 @rows = (@rows,@data) if @data;
9921 eval $end if $b_log;
9924 sub advanced_data_sys {
9925 eval $start if $b_log;
9926 return if ! -d '/sys/class/net';
9927 my ($vendor,$chip,$count,$b_wifi,$path_usb) = @_;
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/
9936 @paths = main::globber("${path_usb}*/net/*");
9939 @paths = main::globber('/sys/class/net/*');
9941 @paths = grep {!/\/lo$/} @paths;
9942 if ( $count > 0 && $count < scalar @paths ){
9943 @paths = splice @paths, $count, scalar @paths;
9945 if ($vendor eq 'check'){
9949 #print join '; ', @paths, $count, "\n";
9951 my ($data1,$data2,$duplex,$mac,$speed,$state);
9952 # for usb, we already know where we are
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;
9965 $path = Cwd::abs_path($_);
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 )) {
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;
9982 $path = "$_/address";
9983 $mac = (main::reader($path))[0] if -e $path;
9984 $mac = main::apply_filter($mac);
9986 $speed = (main::reader($path))[0] if -e $path;
9988 $path = "$_/operstate";
9989 $state = (main::reader($path))[0] if -e $path;
9993 main::key($num++,$key) => $if,
9994 main::key($num++,'state') => $state,
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;
10010 $row[0]{main::key($num++,'mac')} = $mac;
10012 @rows = (@rows,@row);
10019 @rows = (@rows,@row);
10024 eval $end if $b_log;
10027 sub advanced_data_bsd {
10028 eval $start if $b_log;
10029 return if ! @ifs_bsd;
10030 my ($if,$b_wifi) = @_;
10031 my (@data,@row,@rows,$working_if);
10032 my ($b_check,$state,$speed,$duplex,$mac);
10036 if ($if eq 'check'){
10040 foreach my $ref (@ifs_bsd){
10041 if (ref $ref ne 'ARRAY'){
10042 $working_if = $ref;
10043 # print "$working_if\n";
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];
10057 $mac = main::apply_filter($data[3]);
10062 #print "$speed \n";
10064 main::key($num++,$key) => $if,
10065 main::key($num++,'state') => $state,
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;
10078 $row[0]{main::key($num++,'mac')} = $mac;
10080 @rows = (@rows,@row);
10082 @row = if_ip($if) if $if;
10083 @rows = (@rows,@row) if @row;
10087 eval $end if $b_log;
10093 # 2 - broadcast, if found
10094 # 3 - scope, if found
10095 # 4 - scope if, if different from if
10097 eval $start if $b_log;
10099 my (@data,@row,@rows,$working_if);
10104 foreach my $ref (@ifs){
10105 if (ref $ref ne 'ARRAY'){
10106 $working_if = $ref;
10107 # print "if:$if wif:$working_if\n";
10112 # print "ref:$ref\n";
10114 if ($working_if eq $if){
10115 foreach my $ref2 (@data){
10118 if ($limit > 0 && $j >= $limit){
10120 main::key($num++,'Message') => main::row_defaults('output-limit',scalar @data),
10122 @rows = (@rows,@row);
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';
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
10140 # scope site dynamic
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' ;
10146 main::key($num++,"IP v$ipv") => $ip,
10147 main::key($num++,$key) => $data2[4],
10148 main::key($num++,'scope') => $scope,
10153 main::key($num++,"IP v$ipv") => $ip,
10154 main::key($num++,'scope') => $scope,
10160 main::key($num++,'IF') => $if,
10161 main::key($num++,"IP v$ipv") => $ip,
10162 main::key($num++,'scope') => $scope,
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;
10173 eval $end if $b_log;
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
10186 eval $start if $b_log;
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];
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);
10199 $ip = main::download_file('stdout',$_);
10203 $ip = (split /\s+/, $ip)[-1];
10208 if ($ip && $show{'filter'}){
10209 $ip = $filter_string;
10211 $ip ||= main::row_defaults('IP', 'WAN IP');
10213 main::key($num++,'WAN IP') => $ip,
10215 eval $end if $b_log;
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
10223 # Wi-Fi.*Adapter Wireless.*Adapter Ethernet.*Adapter WLAN.*Adapter
10224 # Network.*Adapter 802\.11 Atheros Atmel D-Link.*Adapter D-Link.*Wireless Linksys
10225 # Netgea Ralink Realtek.*Network Realtek.*Wireless Realtek.*WLAN Belkin.*Wireless
10226 # Belkin.*WLAN Belkin.*Network Actiontec.*Wireless Actiontec.*Network AirLink.*Wireless
10227 # Asus.*Network Asus.*Wireless Buffalo.*Wireless Davicom DWA-.*RangeBooster DWA-.*Wireless
10228 # ENUWI-.*Wireless LG.*Wi-Fi Rosewill.*Wireless RNX-.*Wireless Samsung.*LinkStick
10229 # Samsung.*Wireless Sony.*Wireless TEW-.*Wireless TP-Link.*Wireless
10230 # WG[0-9][0-9][0-9].*Wireless WNA[0-9][0-9][0-9] WNDA[0-9][0-9][0-9]
10231 # Zonet.*ZEW.*Wireless
10232 sub network_device {
10233 eval $start if $b_log;
10234 my ($device_string) = @_;
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
10249 if ($device_string =~ /$_/i ){
10254 eval $end if $b_log;
10259 my $b_wifi = ($item =~ /wireless|wifi|wi-fi|wlan|802\.11|centrino/i) ? 1 : 0;
10266 package OpticalData;
10269 eval $start if $b_log;
10270 my (@data,@rows,$key1,$val1);
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();
10281 my $file = main::system_files('dmesg-boot');
10282 if ( $file && ! -r $file ){
10283 $val1 = main::row_defaults('dmesg-boot-permissions');
10286 $val1 = main::row_defaults('dmesg-boot-missing');
10289 $val1 = main::row_defaults('optical-data-bsd');
10291 $key1 = 'Optical Report';
10292 @data = ({main::key($num++,$key1) => $val1,});
10296 @data = optical_data_linux();
10300 $val1 = main::row_defaults('optical-data');
10301 @data = ({main::key($num++,$key1) => $val1,});
10303 @rows = (@rows,@data);
10304 eval $end if $b_log;
10307 sub create_output {
10308 eval $start if $b_log;
10309 my (%devices) = @_;
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};
10321 foreach my $key (sort keys %devices){
10324 my $vendor = $devices{$key}{'vendor'};
10326 my $model = $devices{$key}{'model'};
10329 main::key($num++,ucfirst($devices{$key}{'type'})) => "/dev/$key",
10330 main::key($num++,'vendor') => $vendor,
10331 main::key($num++,'model') => $model,
10333 @rows = (@rows,@data);
10335 my $rev = $devices{$key}{'rev'};
10337 $rows[$j]{ main::key($num++,'rev')} = $rev;
10339 if ($extra > 1 && $devices{$key}{'serial'}){
10340 $rows[$j]{ main::key($num++,'serial')} = main::apply_filter($devices{$key}{'serial'});
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'}){
10347 my $speed = $devices{$key}{'speed'};
10349 my ($audio,$multisession) = ('','');
10350 if (defined $devices{$key}{'multisession'}){
10351 $multisession = ( $devices{$key}{'multisession'} == 1 ) ? 'yes' : 'no' ;
10353 $multisession ||= 'N/A';
10354 if (defined $devices{$key}{'audio'}){
10355 $audio = ( $devices{$key}{'audio'} == 1 ) ? 'yes' : 'no' ;
10360 if (defined $devices{$key}{'dvd'}){
10361 $dvd = ( $devices{$key}{'dvd'} == 1 ) ? 'yes' : 'no' ;
10363 if ($devices{$key}{'cdr'}){
10366 if ($devices{$key}{'cdrw'}){
10369 if ($devices{$key}{'dvdr'}){
10372 if ($devices{$key}{'dvdram'}){
10373 push @rw, 'dvd-ram';
10375 $rws = (@rw) ? join ',', @rw: 'none' ;
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,
10384 @rows = (@rows,@data);
10387 my $state = $devices{$key}{'state'};
10389 $rows[$j]{ main::key($num++,'state')} = $state;
10393 #print Data::Dumper::Dumper \%devices;
10394 eval $end if $b_log;
10397 sub optical_data_bsd {
10398 eval $start if $b_log;
10399 my (@data,%devices,@rows,@temp);
10400 my ($count,$i,$working) = (0,0,'');
10401 foreach (@dm_boot_optical){
10402 $_ =~ s/(cd[0-9]+)\(([^:]+):([0-9]+):([0-9]+)\):/$1:$2-$3.$4,/;
10403 my @row = split /:\s*/, $_;
10404 next if ! defined $row[1];
10405 if ($working ne $row[0]){
10406 # print "$id_holder $row[0]\n";
10407 $working = $row[0];
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';
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;
10432 if ($show{'optical'}){
10434 $devices{$working}{'dvd'} = 1;
10437 $devices{$working}{'cdrw'} = 1;
10438 $devices{$working}{'dvdr'} = 1 if $devices{$working}{'dvd'};
10442 if ($row[1] && $row[1] =~ /^Serial/){
10443 @temp = split /\s+/,$row[1];
10444 $devices{$working}{'serial'} = $temp[-1];
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]+//;
10451 if (/\bDVD[-]?RAM\b/){
10452 $devices{$working}{'cdr'} = 1;
10453 $devices{$working}{'dvdram'} = 1;
10455 if ($row[2] && $row[2] =~ /,\s(.*)$/){
10456 $devices{$working}{'state'} = $1;
10457 $devices{$working}{'state'} =~ s/\s+-\s+/, /;
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];
10472 if ($show{'optical'}){
10474 $devices{$working}{'dvd'} = 1;
10477 $devices{$working}{'cdrw'} = 1;
10478 $devices{$working}{'dvdr'} = 1 if $devices{$working}{'dvd'};
10480 if (/\bDVD[-]?RAM\b/){
10481 $devices{$working}{'cdr'} = 1;
10482 $devices{$working}{'dvdram'} = 1;
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];
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;
10503 sub optical_data_linux {
10504 eval $start if $b_log;
10505 my (@data,%devices,@info,@rows);
10506 @data = main::globber('/dev/dvd* /dev/cdr* /dev/scd* /dev/sr* /dev/fd[0-9]');
10507 # Newer kernel is NOT linking all optical drives. Some, but not all.
10508 # Get the actual disk dev location, first try default which is easier to run,
10509 # need to preserve line breaks
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' ;
10523 my $ref = $devices{$working}{'links'};
10524 push @$ref, $_ if $_ ne $working;
10526 #print "$working\n";
10528 if ($show{'optical'} && -e '/proc/sys/dev/cdrom/info'){
10529 @info = main::reader('/proc/sys/dev/cdrom/info','strip');
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";
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];
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'});
10549 if ($show{'optical'} && @info){
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);
10559 last if ! $index; # index will be > 0 if it was found
10561 elsif ($item =~/^drive speed:/) {
10562 $devices{$key}{'speed'} = $split[$index];
10564 elsif ($item =~/^Can read multisession:/) {
10565 $devices{$key}{'multisession'}=$split[$index+1];
10567 elsif ($item =~/^Can read MCN:/) {
10568 $devices{$key}{'mcn'}=$split[$index+1];
10570 elsif ($item =~/^Can play audio:/) {
10571 $devices{$key}{'audio'}=$split[$index+1];
10573 elsif ($item =~/^Can write CD-R:/) {
10574 $devices{$key}{'cdr'}=$split[$index+1];
10576 elsif ($item =~/^Can write CD-RW:/) {
10577 $devices{$key}{'cdrw'}=$split[$index+1];
10579 elsif ($item =~/^Can read DVD:/) {
10580 $devices{$key}{'dvd'}=$split[$index+1];
10582 elsif ($item =~/^Can write DVD-R:/) {
10583 $devices{$key}{'dvdr'}=$split[$index+1];
10585 elsif ($item =~/^Can write DVD-RAM:/) {
10586 $devices{$key}{'dvdram'}=$split[$index+1];
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;
10602 package PartitionData;
10605 eval $start if $b_log;
10606 my (@rows,$key1,$val1);
10608 partition_data() if !$b_partitions;
10609 if (!@partitions) {
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,});
10617 @rows = create_output();
10619 eval $end if $b_log;
10622 sub create_output {
10623 eval $start if $b_log;
10626 my (@data,@data2,%part,@rows,$dev,$dev_type,$fs);
10627 @partitions = sort { $a->{'id'} cmp $b->{'id'} } @partitions;
10628 foreach my $ref (@partitions){
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'} . '%)' : '';
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'};
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'};
10649 # an error has occurred almost for sure
10650 elsif (!$row{'dev-base'}){
10652 $dev = main::row_defaults('unknown-dev');
10656 $dev = '/dev/' . $row{'dev-base'};
10662 $fs = ($row{'fs'}) ? lc($row{'fs'}): 'N/A';
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,
10672 @rows = (@rows,@data);
10673 if ($show{'label'}){
10674 $rows[$j]{main::key($num++,'label')} = ($row{'label'}) ? $row{'label'}: 'N/A';
10676 if ($show{'uuid'}){
10677 $rows[$j]{main::key($num++,'uuid')} = ($row{'uuid'}) ? $row{'uuid'}: 'N/A';
10680 eval $end if $b_log;
10684 sub partition_data {
10685 eval $start if $b_log;
10686 #return if $bsd_type && $bsd_type eq 'darwin'; # darwin has muated output, of course
10687 my (@data,@rows,@mapper,@mount,@partitions_working,%part);
10688 my ($b_fake_map,$b_fs,$b_load,$cols,$roots) = (0,1,0,6,0);
10689 my ($back_size,$back_used) = (4,3);
10690 my ($dev_base,$fs,$id,$label,$percent_used,$size,$type,$uuid,$used);
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
10698 @partitions_working = main::grabber("df -P -T -k 2>/dev/null");
10699 if (-d '/dev/mapper'){
10700 @mapper = main::globber('/dev/mapper/*');
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");
10708 #Filesystem 1024-blocks Used Available Capacity iused ifree %iused Mounted on
10712 ($back_size,$back_used) = (7,6);
10715 # busybox only supports -k and -P, openbsd, darwin
10716 if (!@partitions_working){
10717 @partitions_working = main::grabber("df -k 2>/dev/null");
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");
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){
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')){
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();
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]);
10767 elsif ($row[0] =~ /mapper\// && @mapper){
10768 $row[0] = get_mapper($row[0],@mapper);
10770 $dev_base = $row[0];
10771 $dev_base =~ s/^\/dev\///;
10772 %part = check_lsblk($dev_base,0) if @lsblk;
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]";
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$/){
10784 # note, older df in bsd do not have file system column
10787 elsif ($row[$cols] !~ /^\/$|^\/boot$|^\/var$|^\/var\/tmp$|^\/var\/log$|^\/home$|^\/opt$|^\/tmp$|^\/usr$|^filesystem/){
10789 $type = 'secondary';
10794 $fs = (%part && $part{'fs'}) ? $part{'fs'} : $row[1];
10797 $fs = get_mounts_fs($row[0],@mount);
10799 if ($show{'label'}) {
10800 if (%part && $part{'label'}) {
10801 $label = $part{'label'};
10804 $label = get_label($row[0]);
10807 if ($show{'uuid'}) {
10808 if (%part && $part{'uuid'}) {
10809 $uuid = $part{'uuid'};
10812 $uuid = get_uuid($row[0]);
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");
10821 $label = $extra[0];
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);
10833 'dev-base' => $dev_base,
10840 'percent-used' => $percent_used,
10842 @partitions = (@partitions,@data);
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;
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);
10857 # faster, avoid subshell, same as swapon -s
10858 if ( -r '/proc/swaps'){
10859 @working = main::reader("/proc/swaps");
10861 elsif ( $path = main::check_program('swapon') ){
10862 # note: while -s is deprecated, --show --bytes is not supported
10864 @working = main::grabber("$path -s 2>/dev/null");
10868 if ( $path = main::check_program('swapctl') ){
10869 # output in in KB blocks
10870 @working = main::grabber("$path -l -k 2>/dev/null");
10872 ($size_id,$used_id) = (1,2);
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]);
10888 if ($show{'uuid'} && @uuids){
10889 $uuid = get_uuid($data[0]);
10891 if ($bsd_type && @gpart && ($show{'label'} || $show{'uuid'} ) ){
10892 my @extra = get_bsd_label_uuid("$dev_base");
10894 $label = $extra[0];
10900 'dev-base' => $dev_base,
10907 'percent-used' => $percent_used,
10909 @swap = (@swap,@data);
10912 eval $end if $b_log;
10915 sub get_mounts_fs {
10916 eval $start if $b_log;
10917 my ($item,@mount) = @_;
10918 $item =~ s/map:\/(\S+)/map $1/ if $bsd_type && $bsd_type eq 'darwin';
10919 return 'N/A' if ! @mount;
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)
10925 if ($bsd_type && $_ =~ /^$item\son.*\(([^,\s\)]+)[,\s]*.*\)/){
10929 elsif (!$bsd_type && $_ =~ /^$item\son.*\stype\s([\S]+)\s\([^\)]+\)/){
10934 eval $end if $b_log;
10935 main::log_data('data',"fs: $fs") if $b_log;
10941 # rawuuid: b710678b-f196-11e1-98fd-021fc614aca9
10942 sub get_bsd_label_uuid {
10943 eval $start if $b_log;
10945 my (@data,$b_found);
10947 my @working = split /\s*:\s*/, $_;
10948 if ($_ =~ /^[0-9]+\.\sName:/ && $working[1] eq $item){
10951 elsif ($_ =~ /^[0-9]+\.\sName:/ && $working[1] ne $item){
10955 if ($working[0] eq 'label'){
10956 $data[0] = $working[1];
10957 $data[0] =~ s/\(|\)//g; # eg: label:(null) - we want to show null
10959 if ($working[0] eq 'rawuuid'){
10960 $data[1] = $working[1];
10961 $data[0] =~ s/\(|\)//g;
10965 main::log_data('dump','@data',\@data) if $b_log;
10966 eval $end if $b_log;
10969 sub set_label_uuid {
10970 eval $start if $b_log;
10972 if ( $show{'unmounted'} || $show{'label'} || $show{'uuid'} ){
10974 if (-d '/dev/disk/by-label'){
10975 @labels = main::globber('/dev/disk/by-label/*');
10977 if (-d '/dev/disk/by-uuid'){
10978 @uuids = main::globber('/dev/disk/by-uuid/*');
10982 if ( my $path = main::check_program('gpart')){
10983 @gpart = main::grabber("$path list 2>/dev/null",'strip');
10987 eval $end if $b_log;
10990 eval $start if $b_log;
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
11010 @lsblk = (@lsblk,@temp);
11014 # print Data::Dumper::Dumper \@lsblk;
11015 main::log_data('dump','@lsblk',\@lsblk) if $b_log;
11016 eval $end if $b_log;
11019 eval $start if $b_log;
11020 my ($name,$b_size) = @_;
11022 foreach my $ref (@lsblk){
11024 next if ! $row{'name'};
11025 if ($name eq $row{'name'}){
11030 # print Data::Dumper::Dumper \%part;
11031 main::log_data('dump','%part',\%part) if $b_log;
11032 eval $end if $b_log;
11036 eval $start if $b_log;
11040 if ($item eq Cwd::abs_path($_)){
11042 $label =~ s/\/dev\/disk\/by-label\///;
11043 $label =~ s/\\x20/ /g;
11044 $label =~ s%\\x2f%/%g;
11049 eval $end if $b_log;
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
11056 eval $start if $b_log;
11057 my ($item,@mapper) = @_;
11061 my $temp = Cwd::abs_path($_);
11062 $mapped = $temp if $temp;
11067 eval $end if $b_log;
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)
11083 if (/^([\S]+)\son\s\/\s/){
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/;
11092 eval $end if $b_log;
11097 eval $start if $b_log;
11101 if ($item eq Cwd::abs_path($_)){
11103 $uuid =~ s/\/dev\/disk\/by-uuid\///;
11108 eval $end if $b_log;
11115 package ProcessData;
11118 eval $start if $b_log;
11119 my (@processes,@rows);
11120 if ($show{'ps-cpu'}){
11121 @rows = cpu_processes();
11122 @processes = (@processes,@rows);
11124 if ($show{'ps-mem'}){
11125 @rows = mem_processes();
11126 @processes = (@processes,@rows);
11129 eval $end if $b_log;
11131 sub cpu_processes {
11132 eval $start if $b_log;
11133 my ($j,$num,$cpu,$cpu_mem,$mem) = (0,0,'','','');
11135 my $count = ($b_irc)? 5: $ps_count;
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;
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";
11149 main::key($num++,'CPU top') => "$count$throttled",
11151 @processes = (@processes,@data);
11155 $j = scalar @processes;
11156 my @row = split /\s+/, $_;
11157 my @command = process_starter(scalar @row, $row[10],$row[11]);
11159 main::key($num++,$i++) => '',
11160 main::key($num++,'cpu') => $row[2] . '%',
11161 main::key($num++,'command') => $command[0],
11163 @processes = (@processes,@data);
11165 $processes[$j]{main::key($num++,'started by')} = $command[1];
11167 $processes[$j]{main::key($num++,'pid')} = $row[1];
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;
11174 #print Data::Dumper::Dumper \@processes, "i: $i; j: $j ";
11176 eval $end if $b_log;
11179 sub mem_processes {
11180 eval $start if $b_log;
11181 my ($j,$num,$cpu,$cpu_mem,$mem) = (0,0,'','','');
11182 my (@data,@processes,$memory);
11183 my $count = ($b_irc)? 5: $ps_count;
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;
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";
11197 main::key($num++,'Memory top') => "$count$throttled",
11199 @processes = (@processes,@data);
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] . "%)";
11210 main::key($num++,$i++) => '',
11211 main::key($num++,'mem') => $mem,
11212 main::key($num++,'command') => $command[0],
11214 @processes = (@processes,@data);
11216 $processes[$j]{main::key($num++,'started by')} = $command[1];
11218 $processes[$j]{main::key($num++,'pid')} = $row[1];
11220 $cpu = $row[2] . '%';
11221 $processes[$j]{main::key($num++,'cpu')} = $cpu;
11223 #print Data::Dumper::Dumper \@processes, "i: $i; j: $j ";
11225 eval $end if $b_log;
11228 sub process_starter {
11229 my ($count, $row10, $row11) = @_;
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;
11239 $row10 =~ s/^\/.*\///;
11240 $return[0] = $row10;
11246 my ($ps_count,$count,$j) = @_;
11247 my $throttled = '';
11249 $throttled = " ( $j processes)";
11251 elsif ($count < $ps_count){
11252 $throttled = " (throttled from $ps_count)";
11261 # debugger switches
11265 eval $start if $b_log;
11266 my (@rows,$key1,$val1);
11268 raid_data() if !$b_raid;
11269 #print 'get: ', Data::Dumper::Dumper \@raid;
11270 if (!@raid && !@hardware_raid){
11271 if ($show{'raid-forced'}){
11273 $val1 = main::row_defaults('raid-data');
11277 @rows = create_output();
11279 if (!@rows && $key1){
11280 @rows = ({main::key($num++,$key1) => $val1,});
11282 eval $end if $b_log;
11283 ($b_md,$b_zfs,@hardware_raid) = undef;
11286 sub create_output {
11287 eval $start if $b_log;
11288 my (@arrays,@arrays_holder,@components,@components_good,@data,@failed,@rows,
11289 @sizes,@spare,@temp);
11290 my ($allocated,$available,$blocks_avail,$chunk_raid,$component_string,$raid,
11291 $ref2,$ref3,$report_size,$size,$status);
11292 my ($b_row_1_sizes);
11293 my ($i,$j,$num,$status_id) = (0,0,0,0);
11294 #print Data::Dumper::Dumper \@raid;
11295 if (@hardware_raid){
11296 foreach my $ref (@hardware_raid){
11299 my $device = ($row{'device'}) ? $row{'device'}: 'N/A';
11300 my $driver = ($row{'driver'}) ? $row{'driver'}: 'N/A';
11302 main::key($num++,'Hardware') => $device,
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;
11309 my $driver_version = ($row{'driver-version'}) ? $row{'driver-version'}: 'N/A' ;
11310 $rows[$j]{main::key($num++,'v')} = $driver_version;
11312 my $port= ($row{'port'}) ? $row{'port'}: 'N/A' ;
11313 $rows[$j]{main::key($num++,'port')} = $port;
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;
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;
11323 my $rev= (defined $row{'rev'} && $row{'rev'}) ? $row{'rev'}: 'N/A' ;
11324 $rows[$j]{main::key($num++,'rev')} = $rev;
11328 if ($extra > 2 && $raid[0]{'system-supported'}){
11330 main::key($num++,'Supported md-raid types') => $raid[0]{'system-supported'},
11332 @rows = (@rows,@data);
11334 foreach my $ref (@raid){
11337 $b_row_1_sizes = 0;
11341 main::key($num++,'Device') => $row{'id'},
11342 main::key($num++,'type') => $row{'type'},
11343 main::key($num++,'status') => $row{'status'},
11345 @rows = (@rows,@data);
11346 if ($row{'type'} eq 'mdraid'){
11347 $blocks_avail = 'blocks';
11348 $chunk_raid = 'chunk size';
11349 $report_size = 'report';
11351 $available = ($row{'blocks'}) ? $row{'blocks'} : 'N/A';
11353 $size = ($row{'report'}) ? $row{'report'}: '';
11354 $size .= " $row{'u-data'}" if $size;
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]" : '';
11367 @sizes = ($row{'allocated'}) ? main::get_size($row{'allocated'}) : ();
11368 $allocated = (@sizes) ? "$sizes[0] $sizes[1]" : '';
11372 $ref2 = $row{'arrays'};
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;
11380 if ( ( $row{'type'} eq 'zfs' || ($row{'type'} eq 'mdraid' && $extra == 0 ) ) && $size){
11382 $rows[$j]{main::key($num++,$report_size)} = $size;
11384 $b_row_1_sizes = 1;
11386 if ( $row{'type'} eq 'zfs' && $available){
11387 $rows[$j]{main::key($num++,$blocks_avail)} = $available;
11389 $b_row_1_sizes = 1;
11391 if ( $row{'type'} eq 'zfs' && $allocated){
11392 $rows[$j]{main::key($num++,$chunk_raid)} = $allocated;
11396 my $count = scalar @arrays;
11397 foreach $ref3 (@arrays){
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';
11409 main::key($num++,'array') => $raid,
11410 main::key($num++,'status') => $status,
11411 main::key($num++,'size') => $size,
11412 main::key($num++,'free') => $available,
11414 @rows = (@rows,@data);
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;
11426 @sizes = ($row{'allocated'}) ? main::get_size($row2{'allocated'}) : ();
11427 $allocated = (@sizes) ? "$sizes[0] $sizes[1]" : '';
11429 $rows[$j]{main::key($num++,$chunk_raid)} = $allocated;
11433 $ref3 = $row2{'components'};
11434 @components = (ref $ref3 eq 'ARRAY') ? @$ref3 : ();
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];
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];
11450 $temp[0] = ($status_id == 2) ? "$temp[0]~$temp[1]" : $temp[0];
11451 push @components_good, $temp[0];
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;
11458 $rows[$j]{main::key($num++,'FAILED')} = join ' ', @failed;
11461 $rows[$j]{main::key($num++,'spare')} = join ' ', @spare;
11463 if ($row{'type'} eq 'mdraid' && $extra > 0 ){
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;
11472 $rows[$j]{main::key($num++,$report_size)} = $size;
11474 my $chunk = ($row{'chunk-size'}) ? $row{'chunk-size'}: 'N/A';
11475 $rows[$j]{main::key($num++,$chunk_raid)} = $chunk;
11477 if ($row{'bitmap'}){
11478 $rows[$j]{main::key($num++,'bitmap')} = $row{'bitmap'};
11480 if ($row{'super-block'}){
11481 $rows[$j]{main::key($num++,'super blocks')} = $row{'super-block'};
11483 if ($row{'algorithm'}){
11484 $rows[$j]{main::key($num++,'algorithm')} = $row{'algorithm'};
11490 if ($row{'recovery-percent'}){
11493 my $percent = $row{'recovery-percent'};
11494 if ($extra > 1 && $row{'progress-bar'}){
11495 $percent .= " $row{'progress-bar'}"
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;
11501 if ($row{'sectors-recovered'}){
11502 $rows[$j]{main::key($num++,'sectors')} = $row{'sectors-recovered'};
11505 if ($extra > 1 && $row{'recovery-speed'}){
11506 $rows[$j]{main::key($num++,'speed')} = $row{'recovery-speed'};
11510 eval $end if $b_log;
11511 #print Data::Dumper::Dumper \@rows;
11515 eval $start if $b_log;
11518 if ($b_hardware_raid){
11521 if ($b_md || (my $file = main::system_files('mdstat') )){
11522 @data = mdraid_data($file);
11523 @raid = (@raid,@data) if @data;
11525 if ($b_zfs || (my $path = main::check_program('zpool') )){
11526 @data = zfs_data($path);
11527 @raid = (@raid,@data) if @data;
11529 main::log_data('dump','@raid',\@raid) if $b_log;
11530 #print Data::Dumper::Dumper \@raid;
11531 eval $end if $b_log;
11544 sub hardware_raid {
11545 eval $start if $b_log;
11546 my ($driver,$vendor,@data,@working);
11547 foreach my $ref (@pci){
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]);
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,
11568 @hardware_raid = (@hardware_raid,@data);
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;
11575 eval $start if $b_log;
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;
11591 if ($working[-1] && $working[-1] =~ /^used\sdevices/){
11592 $unused = ( split /:\s*/, $working[0])[1];
11593 $unused =~ s/<|>|none//g if $unused;
11596 foreach (@working){
11597 $_ =~ s/\s*:\s*/:/;
11599 #md126 : active (auto-read-only) raid1 sdq1[0]
11600 if (/^(md[0-9]+)\s*:\s*([^\s]+)(\s\([^)]+\))?\s([^\s]+)\s(.*)/){
11604 my $component_string = $5;
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;
11618 @components = @temp;
11619 #print "$component_string\n";
11620 $j = scalar @mdraid;
11624 'status' => $status,
11625 'type' => 'mdraid',
11627 @mdraid = (@mdraid,@data);
11628 $mdraid[$j]{'arrays'}[0]{'raid'} = $raid;
11629 $mdraid[$j]{'arrays'}[0]{'components'} = \@components;
11632 if ($_ =~ /^([0-9]+)\sblocks/){
11633 $mdraid[$j]{'blocks'} = $1;
11635 if ($_ =~ /super\s([0-9\.]+)\s/){
11636 $mdraid[$j]{'super-block'} = $1;
11638 if ($_ =~ /algorithm\s([0-9\.]+)\s/){
11639 $mdraid[$j]{'algorithm'} = $1;
11641 if ($_ =~ /\[([0-9]+\/[0-9]+)\]\s\[([U_]+)\]/){
11642 $mdraid[$j]{'report'} = $1;
11643 $mdraid[$j]{'u-data'} = $2;
11645 if ($_ =~ /resync=([\S]+)/){
11646 $mdraid[$j]{'resync'} = $1;
11648 if ($_ =~ /([0-9]+[km])\schunk/i){
11649 $mdraid[$j]{'chunk-size'} = $1;
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;
11656 if ($_ =~ /finish\s*=\s*([\S]+)\s+speed\s*=\s*([\S]+)/){
11657 $mdraid[$j]{'recovery-finish'} = $1;
11658 $mdraid[$j]{'recovery-speed'} = $2;
11660 #print 'mdraid loop: ', Data::Dumper::Dumper \@mdraid;
11663 $mdraid[0]{'system-supported'} = $system if $system;
11664 $mdraid[0]{'unused'} = $unused if $unused;
11666 #print Data::Dumper::Dumper \@mdraid;
11667 eval $end if $b_log;
11672 eval $start if $b_log;
11674 my (@components,@data,@zfs);
11675 my ($allocated,$free,$ref,$size,$status);
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
11687 @working = main::grabber("$zpool list 2>/dev/null");
11690 #print Data::Dumper::Dumper \@working;
11691 main::log_data('dump','@working',\@working) if $b_log;
11693 main::log_data('data','no zpool list data') if $b_log;
11694 eval $end if $b_log;
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
11701 foreach (split /\s+/, $test){
11702 last if $_ eq 'HEALTH';
11706 foreach (@working){
11707 my @row = split /\s+/, $_;
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';
11718 'allocated' => $allocated,
11722 'status' => $status,
11725 @zfs = (@zfs,@data);
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'};
11734 $zfs[$j]{'arrays'}[$k]{'raid'} = $row[1];
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]) : '';
11740 # https://blogs.oracle.com/eschrock/entry/zfs_hot_spares
11741 elsif ($row[1] =~ /spares/){
11744 # the first is a member of a raid array
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)?$/;
11753 my $state = ($3) ? $3 : '';
11754 if ($working =~ /[\S]+\// && @glabel){
11755 $working = DiskData::match_glabel($working);
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
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;
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;
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;
11773 $zfs[$j]{'arrays'}[$k]{'components'}[$i] = $working . '~' . $state;
11777 # print Data::Dumper::Dumper \@zfs;
11778 # clear out undefined arrrays values
11780 foreach $ref (@zfs){
11782 my $ref2 = $row{'arrays'};
11783 my @arrays = (ref $ref2 eq 'ARRAY' ) ? @$ref2 : ();
11784 @arrays = grep {defined $_} @arrays;
11785 $zfs[$j]{'arrays'} = \@arrays;
11788 @zfs = zfs_status($zpool,@zfs);
11789 # print Data::Dumper::Dumper \@zfs;
11790 eval $end if $b_log;
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){
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 : ();
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;
11836 # haven't seen a raid5/6 type array yet
11837 $i++ if $row2{'raid'}; # && $row2{'raid'} eq 'mirror';
11841 eval $end if $b_log;
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){
11852 $status = $temp[1];
11856 eval $end if $b_log;
11866 my (@data,@rows,$key1,@ram,$val1);
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};
11874 main::key($num++,'RAM Report') => '',
11875 main::key($num++,$key1) => $val1,
11877 @rows = (@rows,@data);
11880 @ram = dmidecode_data();
11882 @data = create_output(@ram);
11886 $val1 = main::row_defaults('ram-data');
11888 main::key($num++,'RAM Report') => '',
11889 main::key($num++,$key1) => $val1,
11892 @rows = (@rows,@data);
11894 eval $end if $b_log;
11898 sub create_output {
11899 eval $start if $b_log;
11910 main::key($num++,'Array') => '',
11911 main::key($num++,'capacity') => process_size($ref{'capacity'}),
11913 @rows = (@rows,@data);
11914 if ($ref{'cap-qualifier'}){
11915 $rows[$j]{main::key($num++,'note')} = $ref{'cap-qualifier'};
11917 $rows[$j]{main::key($num++,'slots')} = $ref{'slots'};
11918 $rows[$j]{main::key($num++,'EC')} = $ref{'eec'};
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'};
11925 foreach my $ref2 ($ref{'modules'}){
11926 my @modules = @$ref2;
11927 # print Data::Dumper::Dumper \@modules;
11928 foreach my $ref3 ( @modules){
11931 # multi array setups will start index at next from previous array
11932 next if ref $ref3 ne 'HASH';
11934 $mod{'locator'} ||= 'N/A';
11936 main::key($num++,'Device') => $mod{'locator'},
11937 main::key($num++,'size') => process_size($mod{'size'}),
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'};
11944 $rows[$j]{main::key($num++,'speed')} = $mod{'speed'};
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'};
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'};
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'};
11966 $mod{'serial'} = main::apply_filter($mod{'serial'});
11967 $rows[$j]{main::key($num++,'serial')} = $mod{'serial'};
11972 eval $end if $b_log;
11976 sub dmidecode_data {
11977 eval $start if $b_log;
11978 my ($b_5,$handle,@ram,@temp);
11979 my ($derived_module_size,$max_cap_5,$max_cap_16,$max_module_size) = (0,0,0,0);
11980 my ($i,$j,$k) = (0,0,0);
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;
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;
11997 elsif ($temp[0] eq 'Memory Module Voltage'){
11998 $temp[1] =~ s/\s*V.*$//;
11999 $ram[$k]{'voltage'} = $temp[1];
12001 elsif ($temp[0] eq 'Associated Memory Slots'){
12002 $ram[$k]{'slots-5'} = $temp[1];
12005 $ram[$k]{'modules'} = ([],);
12006 #print Data::Dumper::Dumper \@ram;
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'){
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]);
12023 elsif ($temp[0] eq 'Current Speed'){
12027 $ram[$k]{'modules'}[$j] = ({
12029 'speed-ns' => $speed,
12032 #print Data::Dumper::Dumper \@ram;
12035 elsif ($ref[0] == 16){
12037 $ram[$handle] = $ram[$k] if $ram[$k];
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;
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];
12053 elsif ($temp[0] eq 'Use'){
12054 $temp[1] ||= 'System Memory';
12055 $ram[$handle]{'use'} = $temp[1];
12057 elsif ($temp[0] eq 'Error Correction Type'){
12058 $temp[1] ||= 'None';
12059 $ram[$handle]{'eec'} = $temp[1];
12061 elsif ($temp[0] eq 'Number Of Devices'){
12062 $ram[$handle]{'slots-16'} = $temp[1];
12064 #print "0: $temp[0]\n";
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";
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]);
12082 elsif ($temp[0] eq 'Data Width'){
12083 $data_width = $temp[1];
12085 elsif ($temp[0] eq 'Total Width'){
12086 $total_width = $temp[1];
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;
12097 $device_size = $temp[1];
12100 elsif ($temp[0] eq 'Locator'){
12101 $temp[1] =~ s/RAM slot #/Slot/;
12102 $locator = $temp[1];
12104 elsif ($temp[0] eq 'Bank Locator'){
12105 $bank_locator = $temp[1];
12107 elsif ($temp[0] eq 'Form Factor'){
12108 $form_factor = $temp[1];
12110 elsif ($temp[0] eq 'Type'){
12111 $device_type = $temp[1];
12113 elsif ($temp[0] eq 'Type Detail'){
12114 $device_type_detail = $temp[1];
12116 elsif ($temp[0] eq 'Speed'){
12119 elsif ($temp[0] eq 'Configured Clock Speed'){
12120 $configured_clock_speed = $temp[1];
12122 elsif ($temp[0] eq 'Manufacturer'){
12123 $temp[1] = main::dmi_cleaner($temp[1]);
12124 $manufacturer = $temp[1];
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];
12130 elsif ($temp[0] eq 'Serial Number'){
12131 $temp[1] =~ s/(^[0]+$|Undefined.*|SerNum.*|\[Empty\]|^To be filled.*)//g;
12132 $serial = $temp[1];
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;
12142 $main_locator = $locator;
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;
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]+).*/;
12155 $total_width =~ /(^[0-9]+).*/;
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;
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;
12177 elsif ($ref[0] < 17 ){
12180 elsif ($ref[0] > 17 ){
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;
12190 sub data_processor {
12191 eval $start if $b_log;
12194 my (@return,@temp);
12198 # because we use the actual array handle as the index,
12199 # there will be many undefined keys
12200 next if ! defined $_;
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
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";
12216 if (!$max_cap && $ref{'max-capacity-5'}) {
12217 $max_cap = $ref{'max-capacity-5'};
12220 print "2: mms: $ref{'max-module-size'} :dms: $ref{'derived-module-size'} :mc: $max_cap :uc: $ref{'used-capacity'}\n";
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'};
12229 print "3: dcf: $ref{'device-count-found'} :dms: $ref{'derived-module-size'} :mc: $max_cap :uc: $ref{'used-capacity'}\n";
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'};
12242 print "A\n" if $b_debug;
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'};
12248 print "B\n" if $b_debug;
12251 $max_cap = $ref{'used-capacity'};
12253 print "C\n" if $b_debug;
12257 # note that second case will never really activate except on virtual machines and maybe
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'};
12265 print "D\n" if $b_debug;
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'};
12270 print "E\n" if $b_debug;
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'};
12280 print "F\n" if $b_debug;
12285 print "4: mms: $ref{'max-module-size'} :dms: $ref{'derived-module-size'} :mc: $max_cap :uc: $ref{'used-capacity'}\n";
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;
12293 print "5: dms: $ref{'derived-module-size'} :s16: $ref{'slots-16'} :mc: $max_cap\n";
12296 # now prep for rebuilding the ram array data
12297 if (!$ref{'max-module-size'}){
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;
12303 if ($max_cap && ($ref{'slots-16'} || $ref{'slots-5'})){
12305 if ($ref{'slots-16'} && $ref{'slots-16'} >= $ref{'slots-5'}){
12306 $slots = $ref{'slots-16'};
12308 elsif ($ref{'slots-5'} && $ref{'slots-5'} > $ref{'slots-16'}){
12309 $slots = $ref{'slots-5'};
12311 if ($ref{'derived-module-size'} * $slots > $max_cap){
12312 $ref{'max-module-size'} = $ref{'derived-module-size'};
12315 $ref{'max-module-size'} = sprintf("%.f",$max_cap/$slots);
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
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;
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'},
12343 @return = (@return,@temp);
12345 eval $end if $b_log;
12350 my ($b_trim,$unit) = (0,'');
12351 return 'N/A' if ( ! $size );
12352 return $size if $size =~ /\D/;
12353 if ( $size < 1024 ){
12356 elsif ( $size < 1024000 ){
12357 $size = $size / 1024;
12361 elsif ( $size < 1024000000 ){
12362 $size = $size / 1024000;
12366 # we only want a max 2 decimal places, and only when it's
12368 $size = sprintf("%.2f",$size) if $b_trim;
12369 $size =~ s/\.[0]+$//;
12370 $size = "$size $unit";
12373 sub calculate_size {
12374 my ($data, $size) = @_;
12375 if ( $data =~ /^[0-9]+\s*[GMTP]B/) {
12376 if ( $data =~ /([0-9]+)\s*GB/ ) {
12379 elsif ( $data =~ /([0-9]+)\s*MB/ ) {
12382 elsif ( $data =~ /([0-9]+)\s*TB/ ) {
12383 $data = $1 * 1024 * 1000;
12385 elsif ( $data =~ /([0-9]+)\s*PB/ ) {
12386 $data = $1 * 1024 * 1000 * 1000;
12388 if ($data =~ /^[0-9][0-9]+$/ && $data > $size ) {
12403 # easier to keep these package global, but undef after done
12404 my (@dbg_files,$debugger_dir);
12407 eval $start if $b_log;
12408 ($debugger_dir) = @_;
12411 @rows = get_repos_bsd();
12414 @rows = get_repos_linux();
12416 if ($debugger_dir){
12417 @rows = @dbg_files;
12419 undef $debugger_dir;
12423 my $pm = (!$bsd_type) ? 'package manager': 'OS type';
12425 {main::key($num++,'Alert') => "No repo data detected. Does $self_name support your $pm?"},
12430 eval $end if $b_log;
12433 sub get_repos_linux {
12434 eval $start if $b_log;
12435 my (@content,@data,@data2,@data3,@files,$repo,@repos,@rows);
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/';
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);
12456 @files = main::globber('/etc/apt/sources.list.d/*.list');
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);
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;
12475 $b_apt_enabled = 1;
12476 foreach my $row (@data2){
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;
12493 #print "s1:$string\n";
12494 push @data3, $string;
12497 #print join "\n",@data3,"\n";
12498 @apt_urls = (@apt_urls,@data3);
12506 $apt_types = $type_holder;
12507 $b_apt_enabled = 1;
12509 if ($row =~ /^Enabled:\s*(.*)/){
12511 $b_apt_enabled = ($status =~ /no/i) ? 0: 1;
12513 if ($row =~ /:\//){
12515 $url =~ s/^URIs:\s*//;
12516 push @apt_working, $url if $url;
12518 if ($row =~ /^Suites:\s*(.*)/){
12521 if ($row =~ /^Components:\s*(.*)/){
12524 if ($row =~ /^Architectures:\s*(.*)/){
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;
12541 #print join "\n",@data3,"\n";
12542 @apt_urls = (@apt_urls,@data3);
12552 $key = repo_builder('active','apt');
12553 @apt_urls = url_cleaner(@apt_urls);
12556 $key = repo_builder('missing','apt');
12559 {main::key($num++,$key) => $file},
12562 @rows = (@rows,@data);
12566 # pacman: Arch and derived
12567 if (-f $pacman || -f $pacman_g2){
12569 if (-f $pacman_g2 ){
12570 $pacman = $pacman_g2;
12571 $repo = 'pacman-g2';
12573 @files = main::reader($pacman,'strip');
12575 @repos = grep {/^\s*Server/i} @files;
12576 @files = grep {/^\s*Include/i} @files;
12580 my @working = split( /\s+=\s+/, $_);
12584 @files = sort(@files);
12585 @files = main::uniq(@files);
12586 unshift @files, $pacman if @repos;
12589 @data = repo_builder($_,$repo,'^\s*Server','\s*=\s*',1);
12590 @rows = (@rows,@data);
12593 # set it so the debugger knows the file wasn't there
12594 push @dbg_files, $_ if $debugger_dir;
12596 {main::key($num++,'File listed in') => $pacman},
12597 [("$_ does not seem to exist.")],
12599 @rows = (@rows,@data);
12604 {main::key($num++,repo_builder('missing','no-files')) => $pacman },
12606 @rows = (@rows,@data);
12610 if (-f $slackpkg || -f $slackpkg_plus){
12611 #$slackpkg = "$ENV{HOME}/bin/scripts/inxi/data/repo/slackware/slackpkg-2.conf";
12613 @data = repo_builder($slackpkg,'slackpkg','^[[:space:]]*[^#]+');
12614 @rows = (@rows,@data);
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);
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]";
12640 $key = repo_builder('missing','slackpkg+');
12643 @content = url_cleaner(@content);
12644 $key = repo_builder('active','slackpkg+');
12647 {main::key($num++,$key) => $slackpkg_plus},
12650 @data = url_cleaner(@data);
12651 @rows = (@rows,@data);
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;
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;
12668 #push @files, "$ENV{'HOME'}/bin/scripts/inxi/data/repo/yum/rpmfusion-nonfree-1.repo";
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 =~ /^\[(.+)\]/){
12682 if ($url && $title && defined $enabled){
12684 push @content, "$title ~ $url";
12686 ($enabled,$url,$title) = (undef,'','');
12690 # Note: it looks like enabled comes before url
12691 elsif ($line =~ /^(metalink|mirrorlist|baseurl)\s*=\s*(.*)/){
12694 # note: enabled = 1. enabled = 0 means disabled
12695 elsif ($line =~ /^enabled\s*=\s*([01])/){
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){
12702 push @content, "$title ~ $url";
12704 ($enabled,$url,$title) = (0,'','');
12707 # print the last one if there is data for it
12708 if ($url && $title && $enabled){
12709 push @content, "$title ~ $url";
12713 $key = repo_builder('missing',$repo);
12716 @content = url_cleaner(@content);
12717 $key = repo_builder('active',$repo);
12720 {main::key($num++,$key) => $_},
12723 @rows = (@rows,@data);
12727 # print Data::Dumper::Dumper \@rows;
12730 if (-d $portage_dir && main::check_program('emerge')){
12731 @files = main::globber("$portage_dir*.conf");
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 =~ /^\[(.+)\]/){
12746 if ($url && $title && defined $enabled){
12748 push @content, "$title ~ $url";
12750 ($enabled,$url,$title) = (undef,'','');
12754 elsif ($line =~ /^(sync-uri)\s*=\s*(.*)/){
12757 # note: enabled = 1. enabled = 0 means disabled
12758 elsif ($line =~ /^auto-sync\s*=\s*([01])/){
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){
12765 push @content, "$title ~ $url";
12767 ($enabled,$url,$title) = (undef,'','');
12770 # print the last one if there is data for it
12771 if ($url && $title && $enabled){
12772 push @content, "$title ~ $url";
12775 $key = repo_builder('missing','portage');
12778 @content = url_cleaner(@content);
12779 $key = repo_builder('active','portage');
12782 {main::key($num++,$key) => $_},
12785 @rows = (@rows,@data);
12792 @data = repo_builder($apk,'apk','^\s*[^#]+');
12793 @rows = (@rows,@data);
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
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
12818 @content = url_cleaner(@content);
12822 {main::key($num++,'urpmq repo') => $repo},
12825 @rows = (@rows,@data);
12831 if ( (-d $pisi_dir && ( $path = main::check_program('pisi') ) ) ||
12832 (-d $eopkg_dir && ( $path = main::check_program('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
12848 # http://packages.pardus.org.tr/contrib-2009/pisi-index.xml.bz2
12850 # https://packages.solus-project.com/shannon/eopkg-index.xml.xz
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;
12857 push @content, $_ if $repo;
12859 # Local [inactive] Unstable [active]
12860 elsif ( /^(.*)\s\[([\S]+)\]/){
12862 $repo = ($2 =~ /^activ/i) ? $repo : '';
12864 if ($repo && @content){
12865 @content = url_cleaner(@content);
12866 $key = repo_builder('active',$which);
12868 {main::key($num++,$key) => $repo},
12871 @rows = (@rows,@data);
12876 # last one if present
12877 if ($repo && @content){
12878 @content = url_cleaner(@content);
12879 $key = repo_builder('active',$which);
12881 {main::key($num++,$key) => $repo},
12884 @rows = (@rows,@data);
12887 # print Dumper \@rows;
12888 eval $end if $b_log;
12891 sub get_repos_bsd {
12892 eval $start if $b_log;
12893 my (@content,@data,@data2,@data3,@files,@rows);
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);
12907 if ( -f $freebsd ){
12908 @data = repo_builder($freebsd,'freebsd','^\s*ServerName','\s+',1);
12909 @rows = (@rows,@data);
12911 # if ( -f $freebsd_pkg ){
12912 # @data = repo_builder($freebsd_pkg,'freebsd-pkg','^\s*url',':\s+',1);
12913 # @rows = (@rows,@data);
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;
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
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]";
12937 #print "url:$url\n" if $url;
12938 if ($data2[0] eq 'enabled'){
12939 if ($url && $data2[1] eq 'yes'){
12940 push @data3, "$url"
12947 $key = repo_builder('missing','bsd-package');
12950 @data3 = url_cleaner(@data3);
12951 $key = repo_builder('active','bsd-package');
12954 {main::key($num++,$key) => $_},
12957 @rows = (@rows,@data);
12963 elsif (-f $openbsd || -f $openbsd2) {
12965 @data = repo_builder($openbsd,'openbsd','^installpath','\s*=\s*',1);
12966 @rows = (@rows,@data);
12969 @data = repo_builder($openbsd2,'openbsd','^(http|ftp)','',1);
12970 @rows = (@rows,@data);
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);
12978 # BSDs do not default always to having repo files, so show correct error
12979 # mesage in that case
12981 if ($bsd_type eq 'freebsd'){
12982 $key = repo_builder('missing','freebsd-nf');
12984 elsif ($bsd_type eq 'openbsd'){
12985 $key = repo_builder('missing','openbsd-nf');
12987 elsif ($bsd_type eq 'netbsd'){
12988 $key = repo_builder('missing','netbsd-nf');
12991 $key = repo_builder('missing','bsd-nf');
12994 {main::key($num++,'Message') => $key},
12997 @rows = (@rows,@data);
12999 eval $start if $b_log;
13003 eval $start if $b_log;
13004 my ($file,$type,$search,$split,$count) = @_;
13005 my (@content,@data,$missing,$key);
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',
13030 $missing = $unfound{$type};
13031 return $missing if $file eq 'missing';
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',
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);
13059 my @inner = split (/$split/, $_);
13067 @content = url_cleaner(@content);
13070 {main::key($num++,$key) => $file},
13073 eval $end if $b_log;
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;
13084 my (@content) = @_;
13085 @content = map { $_ =~ s/:\//: \//; $_} @content if $b_irc;
13089 my ($filename,$dir) = @_;
13091 $working = $filename;
13092 $working =~ s/^\///;
13093 $working =~ s/\//-/g;
13094 $working = "$dir/file-repo-$working.txt";
13101 package SensorData;
13102 my (@sensors_data);
13103 my ($b_ipmi) = (0);
13105 eval $start if $b_log;
13106 my ($key1,$program,$val1,@data,@rows,%sensors);
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
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);
13120 $val1 = main::row_defaults('sensors-data-ipmi');
13121 #$val1 = main::row_defaults('dev');
13122 @data = ({main::key($num++,$key1) => $val1,});
13124 @rows = (@rows,@data);
13125 $source = 'lm-sensors'; # trips per sensor type output
13128 $key1 = 'Permissions';
13129 $val1 = main::row_defaults('sensors-ipmi-root');
13130 @data = ({main::key($num++,$key1) => $val1,});
13131 @rows = (@rows,@data);
13134 my $ref = $alerts{'sensors'};
13135 if ( $$ref{'action'} ne 'use'){
13137 $key1 = $$ref{'action'};
13138 $val1 = $$ref{$key1};
13139 $key1 = ucfirst($key1);
13140 @data = ({main::key($num++,$key1) => $val1,});
13141 @rows = (@rows,@data);
13144 %sensors = lm_sensors_data();
13145 @data = create_output($source,%sensors);
13149 $val1 = main::row_defaults('sensors-data-linux');
13150 @data = ({main::key($num++,$key1) => $val1,});
13152 @rows = (@rows,@data);
13154 undef @sensors_data;
13155 eval $end if $b_log;
13158 sub create_output {
13159 eval $start if $b_log;
13160 my ($source,%sensors) = @_;
13161 # note: might revisit this, since gpu sensors data might be present
13162 return if ! %sensors;
13163 my (@gpu,@data,@rows,@fan_default,@fan_main);
13164 my ($data_source) = ('');
13165 my $fan_number = 0;
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');
13175 main::key($num++,'System Temperatures') => $data_source,
13176 main::key($num++,$cpu1_key) => $cpu_temp,
13178 @rows = (@rows,@data);
13179 if ($sensors{'cpu2-temp'}){
13180 $rows[$j]{main::key($num++,'cpu-2')} = $sensors{'cpu2-temp'} . $temp_unit;
13182 if ($sensors{'cpu3-temp'}){
13183 $rows[$j]{main::key($num++,'cpu-3')} = $sensors{'cpu3-temp'} . $temp_unit;
13185 if ($sensors{'cpu4-temp'}){
13186 $rows[$j]{main::key($num++,'cpu-4')} = $sensors{'cpu4-temp'} . $temp_unit;
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;
13193 if (defined $sensors{'psu-temp'}){
13194 my $psu_temp = $sensors{'psu-temp'} . $temp_unit;
13195 $rows[$j]{main::key($num++,'psu')} = $psu_temp;
13197 if (defined $sensors{'ambient-temp'}){
13198 my $ambient_temp = $sensors{'ambient-temp'} . $temp_unit;
13199 $rows[$j]{main::key($num++,'ambient')} = $ambient_temp;
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;
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';
13217 $rows[$j]{main::key($num++,'Fan Speeds (RPM)')} = $fan_def;
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];
13226 elsif ($i == 2 && $b_cpu){
13227 $rows[$j]{main::key($num++,'mobo')} = $fan_main[$i];
13230 $rows[$j]{main::key($num++,'psu')} = $fan_main[$i];
13233 $rows[$j]{main::key($num++,'sodimm')} = $fan_main[$i];
13236 $fan_number = $i - 4;
13237 $rows[$j]{main::key($num++,"case-$fan_number")} = $fan_main[$i];
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];
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;
13257 if (scalar @gpu > 1){
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){
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'};
13271 $rows[$j]{main::key($num++,'temp')} = $gpu_temp;
13272 if (defined $gpu_fan){
13273 $rows[$j]{main::key($num++,'fan')} = $gpu_fan;
13277 if ($extra > 0 && ($source eq 'ipmi' ||
13278 ($sensors{'volts-12'} || $sensors{'volts-5'} || $sensors{'volts-3.3'} || $sensors{'volts-vbat'}))){
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'};
13298 eval $end if $b_log;
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$/){
13310 ($b_ipmitool,$i_key,$i_value,$i_unit) = (0,1,3,4);
13313 $cmd = "$program sensors";
13314 ($b_ipmitool,$i_key,$i_value,$i_unit) = (1,0,1,2);
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);
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;
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;
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;
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;
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;
13369 $sensors{'temp-unit'} = set_temp_unit($sensors{'temp-unit'},$working_unit) if $working_unit;
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;
13378 $sensors{'temp-unit'} = set_temp_unit($sensors{'temp-unit'},$working_unit) if $working_unit;
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;
13388 $sensors{'temp-unit'} = set_temp_unit($sensors{'temp-unit'},$working_unit) if $working_unit;
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;
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]);
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;
13417 $sensors{'fan-default'}[$sys_fan_nu] = $fan_working;
13421 elsif ($row[$i_key] =~ /^(FAN PSU|PSU FAN)$/i) {
13422 $sensors{'fan-psu'} = int($row[$i_value]);
13424 elsif ($row[$i_key] =~ /^(FAN PSU1|PSU1 FAN)$/i) {
13425 $sensors{'fan-psu-1'} = int($row[$i_value]);
13427 elsif ($row[$i_key] =~ /^(FAN PSU2|PSU2 FAN)$/i) {
13428 $sensors{'fan-psu-2'} = int($row[$i_value]);
13431 if ($row[$i_key] =~ /^(MAIN\s|P[_]?)?12V$/i) {
13432 $sensors{'volts-12'} = $row[$i_value];
13434 elsif ($row[$i_key] =~ /^(MAIN\s5V|P5V|5VCC|5V PG)$/i) {
13435 $sensors{'volts-5'} = $row[$i_value];
13437 elsif ($row[$i_key] =~ /^(MAIN\s3.3V|P3V3|3.3VCC|3.3V PG)$/i) {
13438 $sensors{'volts-3.3'} = $row[$i_value];
13440 elsif ($row[$i_key] =~ /^((P_)?VBAT|CMOS Battery|BATT 3.0V)$/i) {
13441 $sensors{'volts-vbat'} = $row[$i_value];
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];
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];
13450 elsif (!$sensors{'volts-soc-p1'} && $row[$i_key] =~ /^(P1_SOC_RUN$)/i) {
13451 $sensors{'volts-soc-p1'} = $row[$i_value];
13453 elsif (! $sensors{'volts-soc-p2'} && $row[$i_key] =~ /^(P2_SOC_RUN$)/i) {
13454 $sensors{'volts-soc-p2'} = $row[$i_value];
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;
13465 sub lm_sensors_data {
13466 eval $start if $b_log;
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/){
13486 if (/^(?:(?!amdgpu|intel|nouveau|radeon|.*hwmon).)*-(isa|pci|virtual)-/){
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;
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;
13523 $sensors{'temp-unit'} = set_temp_unit($sensors{'temp-unit'},$working_unit) if $working_unit;
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;
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;
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;
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;
13548 $sensors{'temp-unit'} = set_temp_unit($sensors{'temp-unit'},$working_unit) if $working_unit;
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;
13557 $sensors{'temp-unit'} = set_temp_unit($sensors{'temp-unit'},$working_unit) if $working_unit;
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;
13567 $sensors{'temp-unit'} = set_temp_unit($sensors{'temp-unit'},$working_unit) if $working_unit;
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;
13578 $sensors{'temp-unit'} = set_temp_unit($sensors{'temp-unit'},$working_unit) if $working_unit;
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;
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;
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;
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;
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;
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;
13616 elsif ($_ =~ /^FAN([2-9]|1[0-9]).*:([0-9]+)[\s]RPM/i) {
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;
13628 $sensors{'fan-default'}[$sys_fan_nu] = $fan_working;
13633 if ($_ =~ /^[+]?(12 Volt|12V).*:([0-9\.]+)\sV/i) {
13634 $sensors{'volts-12'} = $2;
13636 # note: 5VSB is a field name
13637 elsif ($_ =~ /^[+]?(5 Volt|5V):([0-9\.]+)\sV/i) {
13638 $sensors{'volts-5'} = $2;
13640 elsif ($_ =~ /^[+]?(3\.3 Volt|3\.3V).*:([0-9\.]+)\sV/i) {
13641 $sensors{'volts-3.3'} = $2;
13643 elsif ($_ =~ /^(Vbat).*:([0-9\.]+)\sV/i) {
13644 $sensors{'volts-vbat'} = $2;
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;
13656 # oddly, openbsd sysctl actually has hw.sensors 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])/){
13665 my @working = split /:/, $_;
13667 last if /^(hw.cpuspeed|hw.vendor|hw.physmem)/;
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;
13676 sub set_temp_unit {
13677 my ($sensors,$working) = @_;
13678 my $return_unit = '';
13680 if ( !$sensors && $working ){
13681 $return_unit = $working;
13684 $return_unit = $sensors;
13686 return $return_unit;
13689 sub data_processor {
13690 eval $start if $b_log;
13691 my (%sensors) = @_;
13692 my ($cpu_temp,$cpu2_temp,$cpu3_temp,$cpu4_temp,$index_count_fan_default,
13693 $index_count_fan_main,$mobo_temp,$psu_temp) = (0,0,0,0,0,0,0,0);
13694 my ($fan_type,$i,$j) = (0,0,0);
13695 my $temp_diff = 20; # for C, handled for F after that is determined
13696 my (@fan_main,@fan_default);
13697 # first we need to handle the case where we have to determine which temp/fan to use for cpu and mobo:
13698 # note, for rare cases of weird cool cpus, user can override in their prefs and force the assignment
13699 # this is wrong for systems with > 2 tempX readings, but the logic is too complex with 3 variables
13700 # so have to accept that it will be wrong in some cases, particularly for motherboard temp readings.
13701 if ( $sensors{'temp1'} && $sensors{'temp2'} ){
13702 if ( $sensors_cpu_nu ) {
13703 $fan_type = $sensors_cpu_nu;
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 ) {
13712 elsif ( $sensors{'temp2'} >= $sensors{'temp1'} &&
13713 defined $fan_default[1] && defined $fan_default[2] && $fan_default[2] == 0 && $fan_default[1] > 0 ) {
13716 # then handle the standard case if these fringe cases are false
13717 elsif ( $sensors{'temp1'} >= $sensors{'temp2'} ) {
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'} ){
13730 elsif ( $sensors{'temp1'} && !$sensors{'mobo-temp'} ){
13733 elsif ( $sensors{'temp1'} && $sensors{'mobo-temp'} ){
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
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'};
13746 # then get the real cpu temp, best guess is hottest is real, though only within narrowed diff range
13748 $cpu_temp = $sensors{'cpu-temp'};
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'};
13759 $cpu_temp = $sensors{'temp1'};
13763 if ( $sensors{'temp1'} && $sensors{'temp2'} && $sensors{'temp1'} > $sensors{'temp2'} ) {
13764 $cpu_temp = $sensors{'temp1'};
13767 $cpu_temp = $sensors{'temp2'};
13772 $cpu_temp = $sensors{'temp1'}; # can be null, that is ok
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'};
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'};
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'};
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'};
13797 # then the real mobo temp
13798 if ( $sensors{'mobo-temp'} ){
13799 $mobo_temp = $sensors{'mobo-temp'};
13801 elsif ( $fan_type ){
13802 if ( $fan_type == 1 ) {
13803 if ( $sensors{'temp1'} && $sensors{'temp2'} && $sensors{'temp2'} > $sensors{'temp1'} ) {
13804 $mobo_temp = $sensors{'temp1'};
13807 $mobo_temp = $sensors{'temp2'};
13811 if ( $sensors{'temp1'} && $sensors{'temp2'} && $sensors{'temp1'} > $sensors{'temp2'} ) {
13812 $mobo_temp = $sensors{'temp2'};
13815 $mobo_temp = $sensors{'temp1'};
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'};
13824 $mobo_temp = $sensors{'temp2'};
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;
13838 elsif ( $fan_type == 2 && defined $fan_default[2] ) {
13839 $fan_main[1] = $fan_default[2];
13840 $fan_default[2] = undef;
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;
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;
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 ) {
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
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'};
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,
13916 $sensors{'psu-temp'} = $psu_temp;
13919 $sensors{'sodimm-temp'} = $sodimm_temp;
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;
13932 eval $end if $b_log;
13936 eval $start if $b_log;
13937 return @gpudata if $b_gpudata;
13938 my ($cmd,@data,@data2,$path,@screens,$temp);
13940 if ($path = main::check_program('nvidia-settings')){
13941 # first get the number of screens. This only work if you are in X
13943 @data = main::grabber("$path -q screens 2>/dev/null");
13945 if ( /(:[0-9]\.[0-9])/ ) {
13950 # do a guess, this will work for most users, it's better than nothing for out of X
13952 $screens[0] = ':0.0';
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
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
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;
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;
13991 elsif (!$gpudata[$j]{'ram'} && $attribute eq 'VideoRam'){
13992 $gpudata[$j]{'ram'} = $value;
13994 elsif (!$gpudata[$j]{'clock'} && $attribute eq 'GPUCurrentClockFreqs'){
13995 $gpudata[$j]{'clock'} = $value;
13997 elsif (!$gpudata[$j]{'bus'} && $attribute eq 'PCIBus'){
13998 $gpudata[$j]{'bus'} = $value;
14000 elsif (!$gpudata[$j]{'bus-id'} && $attribute eq 'PCIDevice'){
14001 $gpudata[$j]{'bus-id'} = $value;
14003 elsif (!$gpudata[$j]{'fan-speed'} && $attribute eq 'GPUCurrentFanSpeed'){
14004 $gpudata[$j]{'fan-speed'} = $value;
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");
14014 if (/Sensor [^0-9]*([0-9\.]+) /){
14015 $j = scalar @gpudata;
14016 $gpudata[$j] = ({});
14018 $gpudata[$j]{'type'} = 'amd';
14019 $gpudata[$j]{'temp'} = $value;
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-(.*)/){
14030 $j = scalar @gpudata;
14032 if (/^(?:(?!amdgpu|.*hwmon|intel|nouveau|radeon).)*-(pci|virtual|isa)-(.*)/){
14037 if (/^temp.*:([0-9]+).*(C|F)/){
14038 $gpudata[$j]{'temp'} = $1;
14039 $gpudata[$j]{'type'} = $holder;
14040 $gpudata[$j]{'unit'} = $2;
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'} = '';
14047 main::log_data('dump','sensors output: video: @gpudata',\@gpudata);
14051 # we'll probably use this data elsewhere so make it a one time call
14053 # print Data::Dumper::Dumper \@gpudata;
14054 eval $end if $b_log;
14064 eval $start if $b_log;
14065 my (@data,@rows,$key1,$val1);
14067 my $ref = $alerts{'dmidecode'};
14068 if ( $$ref{'action'} eq 'use' && (!$b_arm || $b_slot_tool )){
14069 @rows = slot_data();
14071 elsif ($b_arm && !$b_slot_tool){
14073 $val1 = main::row_defaults('arm-pci','');
14074 @rows = ({main::key($num++,$key1) => $val1,});
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,});
14082 eval $end if $b_log;
14086 eval $start if $b_log;
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'){
14103 if ($value[0] eq 'Designation'){
14104 $designation = $value[1];
14106 if ($value[0] eq 'Current Usage'){
14107 $usage = $value[1];
14110 if ($value[0] eq 'ID'){
14113 if ($extra > 1 && $value[0] eq 'Length'){
14114 $length = $value[1];
14119 $id = 'N/A' if ($id eq '' );
14120 if ($type eq 'Other' && $designation){
14121 $type = $designation;
14123 elsif ($type && $designation) {
14124 $type = "$type $designation";
14128 main::key($num++,'Slot') => $id,
14129 main::key($num++,'type') => $type,
14130 main::key($num++,'status') => $usage,
14133 @rows = (@rows,@data);
14135 $rows[$j]{main::key($num++,'length')} = $length;
14141 my $key = 'Message';
14143 main::key($num++,$key) => main::row_defaults('pci-slot-data',''),
14145 @rows = (@rows,@data);
14147 eval $end if $b_log;
14154 package UnmountedData;
14157 eval $start if $b_log;
14158 my (@data,@rows,$key1,$val1);
14162 $val1 = main::row_defaults('unmounted-data-bsd');
14165 if (my $file = main::system_files('partitions')){
14166 @data = unmounted_data($file);
14169 $val1 = main::row_defaults('unmounted-data');
14172 @rows = create_output(@data);
14177 $val1 = main::row_defaults('unmounted-file');
14180 if (!@rows && $key1){
14181 @rows = ({main::key($num++,$key1) => $val1,});
14183 eval $end if $b_log;
14186 sub create_output {
14187 eval $start if $b_log;
14188 my (@unmounted) = @_;
14189 my (@data,@rows,$fs);
14191 @unmounted = sort { $a->{'dev-base'} cmp $b->{'dev-base'} } @unmounted;
14192 foreach my $ref (@unmounted){
14195 my @data2 = main::get_size($row{'size'}) if (defined $row{'size'});
14196 my $size = (@data2) ? $data2[0] . ' ' . $data2[1]: 'N/A';
14198 $fs = lc($row{'fs'});
14201 if (main::check_program('file')){
14202 $fs = ($b_root) ? 'N/A' : main::row_defaults('root-required');
14205 $fs = 'requires file';
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'},
14215 @rows = (@rows,@data);
14217 eval $end if $b_log;
14220 sub unmounted_data {
14221 eval $start if $b_log;
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');
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);
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]);
14248 $label = $part{'label'};
14249 $uuid = $part{'uuid'};
14250 $size = $part{'size'} if $part{'size'} && !$working[2];
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;
14257 'dev-base' => $working[-1],
14263 @unmounted = (@unmounted,@data);
14266 # print Data::Dumper::Dumper @unmounted;
14267 main::log_data('dump','@unmounted',\@unmounted) if $b_log;
14268 eval $end if $b_log;
14272 eval $start if $b_log;
14273 my (@mounted) = @_;
14274 foreach my $ref (@partitions){
14276 push @mounted, $row{'dev-base'} if $row{'dev-base'};
14278 foreach my $ref (@raid){
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];
14295 eval $end if $b_log;
14298 sub unmounted_filesystem {
14299 eval $start if $b_log;
14302 my ($file,$fs,$path) = ('','','');
14303 if ($path = main::check_program('file')) {
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');
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];
14317 foreach (@filesystems){
14318 if ($data =~ /($_)[\s,]/i){
14320 $fs = main::trimmer($fs);
14326 main::log_data('data',"fs: $fs") if $b_log;
14327 eval $end if $b_log;
14337 eval $start if $b_log;
14338 my (@data,@rows,$key1,$val1);
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};
14348 $key1 = $$ref2{'action'};
14349 $val1 = $$ref2{$key1};
14351 $key1 = ucfirst($key1);
14352 @rows = ({main::key($num++,$key1) => $val1,});
14355 @rows = usb_data();
14357 my $key = 'Message';
14359 main::key($num++,$key) => main::row_defaults('usb-data',''),
14361 @rows = (@rows,@data);
14364 eval $end if $b_log;
14368 eval $start if $b_log;
14370 my (@data,@row,@rows,$bus_id,$chip_id,$speed,$protocol,$class,$vendor,$product);
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){
14379 $bus_id = "$id[0]:$id[1]";
14384 foreach my $line (@id){
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];
14391 elsif ($row[0] eq '~bInterfaceProtocol' && $row[2] ){
14392 $protocol = $row[2];
14395 $protocol ||= 'N/A';
14397 #print "pt0:$protocol\n";
14399 main::key($num++,'Hub') => $bus_id,
14400 main::key($num++,'usb') => $speed,
14401 main::key($num++,'type') => $protocol,
14403 @rows = (@rows,@data);
14405 $rows[$j]{main::key($num++,'chip ID')} = $chip_id;
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]);
14417 elsif ($row[0] eq 'bDeviceClass' && defined $row[1] && $row[1] == 9){
14420 elsif ($row[0] eq 'idVendor' && $row[2]){
14421 $vendor = main::cleaner($row[2]);
14423 elsif ($row[0] eq 'idProduct' && $row[2]){
14424 $product = main::cleaner($row[2]);
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]);
14430 elsif ($row[0] eq '~bInterfaceProtocol' && defined $row[2]){
14431 $protocol = $row[2];
14432 $protocol =~ s/none//i if $protocol;
14437 if ($vendor && $product){
14438 $protocol = "$vendor $product";
14440 elsif (!$product && $protocol && $vendor){
14441 $protocol = "$vendor $protocol";
14444 $protocol ||= 'N/A';
14445 #print "pt2:$protocol\n";
14447 main::key($num++,'Hub') => $bus_id,
14448 main::key($num++,'usb') => $speed,
14449 main::key($num++,'type') => $protocol,
14451 @rows = (@rows,@data);
14454 if ($vendor && $product){
14455 if ($product !~ /$vendor/){
14456 $product = "$vendor $product";
14459 elsif (!$product && !$vendor && $protocol){
14460 $product = $protocol;
14463 $product = $vendor;
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;
14474 #print "pt3:$class:$product\n";
14475 $product ||= 'N/A';
14477 $rows[$j]{main::key($num++,'Device')} = $product;
14478 $rows[$j]{main::key($num++,'bus ID')} = $bus_id;
14480 $rows[$j]{main::key($num++,'usb')} = $speed;
14482 $rows[$j]{main::key($num++,'type')} = $class;
14485 $rows[$j]{main::key($num++,'chip ID')} = $chip_id;
14489 #print Data::Dumper::Dumper \@rows;
14490 eval $end if $b_log;
14493 sub protocol_filter {
14494 eval $start if $b_log;
14496 $string =~ s/Bulk-Only|streaming|Bidirectional|None//i if $string;
14497 eval $end if $b_log;
14502 ## add metric / imperial (us) switch
14505 package WeatherData;
14508 eval $start if $b_log;
14509 my (@rows,$key1,$val1);
14511 @rows = create_output();
14512 eval $end if $b_log;
14515 sub create_output {
14516 eval $start if $b_log;
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;
14530 $string .= $sep . $_;
14533 $location_string = $string;
14535 $location_string = main::apply_filter($location_string);
14536 @location = ($show{'weather-location'},$location_string,'');
14539 @location = get_location();
14540 if (!$location[0]) {
14542 main::key($num++,'Message') => main::row_defaults('weather-null','current location'),
14546 %weather = get_weather(@location);
14547 if (!$weather{'weather'}) {
14549 main::key($num++,'Message') => main::row_defaults('weather-null','weather data'),
14552 $conditions = "$weather{'weather'}";
14553 my $temp = unit_output($weather{'temp'},$weather{'temp-c'},'C',$weather{'temp-f'},'F');
14555 main::key($num++,'Temperature') => $temp,
14556 main::key($num++,'Conditions') => $conditions,
14558 @rows = (@rows,@data);
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;
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;
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 ;
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;
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'});
14587 $rows[0]{main::key($num++,'Current Time')} = $weather{'date-time'};
14589 $rows[0]{main::key($num++,'Observation Time')} = $weather{'observation-time-local'};
14591 eval $end if $b_log;
14594 sub elevation_output {
14595 eval $start if $b_log;
14596 my ($meters,$feet) = @_;
14597 my ($result,$i_unit,$m_unit) = ('','ft','m');
14598 $feet = sprintf("%.0f", 3.28 * $meters) if defined $meters && !$feet;
14599 $meters = sprintf("%.1f", $feet / 3.28 ) if defined $feet && !$meters;
14600 $meters = sprintf("%.0f", $meters) if $meters;
14601 if ( defined $meters && $weather_unit eq 'mi' ){
14602 $result = "$meters $m_unit ($feet $i_unit)";
14604 elsif (defined $meters && $weather_unit eq 'im' ){
14605 $result = "$feet $i_unit ($meters $m_unit)";
14607 elsif (defined $meters && $weather_unit eq 'm' ){
14608 $result = "$meters $m_unit";
14610 elsif (defined $feet && $weather_unit eq 'i' ){
14611 $result = "$feet $i_unit";
14616 eval $end if $b_log;
14620 eval $start if $b_log;
14621 my ($primary,$metric,$m_unit,$imperial,$i_unit) = @_;
14623 if ($metric && $imperial && $weather_unit eq 'mi' ){
14624 $result = "$metric $m_unit ($imperial $i_unit)";
14626 elsif ($metric && $imperial && $weather_unit eq 'im' ){
14627 $result = "$imperial $i_unit ($metric $m_unit)";
14629 elsif ($metric && $weather_unit eq 'm' ){
14630 $result = "$metric $m_unit";
14632 elsif ($imperial && $weather_unit eq 'i' ){
14633 $result = "$imperial $i_unit";
14636 $result = $primary;
14641 eval $end if $b_log;
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;
14666 elsif ($mph && $direction ){
14667 if ( $weather_unit eq 'mi' ){
14668 $result = "from $direction at $ms $m_unit ($kmh $km_unit, $mph $i_unit)";
14670 elsif ( $weather_unit eq 'im' ){
14671 $result = "from $direction at $mph $i_unit ($ms $m_unit, $kmh $km_unit)";
14673 elsif ( $weather_unit eq 'm' ){
14674 $result = "from $direction at $ms $m_unit ($kmh $km_unit)";
14676 elsif ( $weather_unit eq 'i' ){
14677 $result = "from $direction at $mph $i_unit";
14680 if ( $weather_unit eq 'mi' ){
14681 $result .= ". Gusting to $ms $m_unit ($kmh $km_unit, $mph $i_unit)";
14683 elsif ( $weather_unit eq 'im' ){
14684 $result .= ". Gusting to $mph $i_unit ($ms $m_unit, $kmh $km_unit)";
14686 elsif ( $weather_unit eq 'm' ){
14687 $result .= ". Gusting to $ms $m_unit ($kmh $km_unit)";
14689 elsif ( $weather_unit eq 'i' ){
14690 $result .= ". Gusting to $mph $i_unit";
14695 $result = $primary;
14700 eval $end if $b_log;
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";
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]";
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";
14725 # my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/weather/weather-1.xml";
14726 # open my $fh, '<', $file or die "can't open $file: $!";
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){
14734 $_ =~ s/<\/[^>]+>//;
14735 $_ =~ s/.*icon.*|\r//g;
14737 $_ =~ s/^\s+|\s+$//g;
14740 $_ =~ s/^(current|credit|terms|image|title|link|.*_url).*//;
14741 push @weather_data, $_ if $_ !~ /^\s*$/;
14743 unshift (@weather_data,("timestamp^^$now"));
14744 main::writer($file_cached,\@weather_data);
14745 #print "$file_cached: download/cleaned\n";
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;;
14758 elsif ( $working[0] eq 'dewpoint_c' ){
14759 $weather{'dewpoint-c'} = $working[1];
14761 elsif ( $working[0] eq 'dewpoint_f' ){
14762 $weather{'dewpoint-f'} = $working[1];
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).*$//;
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;
14776 elsif ( $working[0] eq 'heat_index_c' ){
14777 $weather{'heat-index-c'} = $working[1];
14779 elsif ( $working[0] eq 'heat_index_f' ){
14780 $weather{'heat-index-f'} = $working[1];
14782 elsif ( $working[0] eq 'relative_humidity' ){
14783 $weather{'humidity'} = $working[1];
14785 elsif ( $working[0] eq 'local_time' ){
14786 $weather{'local-time'} = $working[1];
14788 elsif ( $working[0] eq 'local_epoch' ){
14789 $weather{'local-epoch'} = $working[1];
14791 elsif ( $working[0] eq 'observation_time_rfc822' ){
14792 $weather{'observation-time-gmt'} = $working[1];
14794 elsif ( $working[0] eq 'observation_epoch' ){
14795 $weather{'observation-epoch'} = $working[1];
14797 elsif ( $working[0] eq 'observation_time' ){
14798 $weather{'observation-time-local'} = $working[1];
14799 $weather{'observation-time-local'} =~ s/Last Updated on //;
14801 elsif ( $working[0] eq 'pressure_string' ){
14802 $weather{'pressure'} = $working[1];
14804 elsif ( $working[0] eq 'pressure_mb' ){
14805 $weather{'pressure-mb'} = $working[1];
14807 elsif ( $working[0] eq 'pressure_in' ){
14808 $weather{'pressure-in'} = $working[1];
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}/;
14819 elsif ( $working[0] eq 'temp_f' ){
14820 $weather{'temp-f'} = $working[1];
14822 elsif ( $working[0] eq 'temp_c' ){
14823 $weather{'temp-c'} = $working[1];
14825 elsif ( $working[0] eq 'visibility' ){
14826 $weather{'visibility'} = $working[1];
14828 elsif ( $working[0] eq 'visibility_km' ){
14829 $weather{'visibility-km'} = $working[1];
14831 elsif ( $working[0] eq 'visibility_mi' ){
14832 $weather{'visibility-mi'} = $working[1];
14834 elsif ( $working[0] eq 'weather' ){
14835 $weather{'weather'} = $working[1];
14837 elsif ( $working[0] eq 'wind_degrees' ){
14838 $weather{'wind-degrees'} = $working[1];
14840 elsif ( $working[0] eq 'wind_dir' ){
14841 $weather{'wind-direction'} = $working[1];
14843 elsif ( $working[0] eq 'wind_mph' ){
14844 $weather{'wind-mph'} = $working[1];
14846 elsif ( $working[0] eq 'wind_gust_mph' ){
14847 $weather{'wind-gust-mph'} = $working[1];
14849 elsif ( $working[0] eq 'wind_gust_ms' ){
14850 $weather{'wind-gust-ms'} = $working[1];
14852 elsif ( $working[0] eq 'wind_ms' ){
14853 $weather{'wind-ms'} = $working[1];
14855 elsif ( $working[0] eq 'wind_string' ){
14856 $weather{'wind'} = $working[1];
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;
14864 elsif ( $working[0] eq 'windchill_c' ){
14865 $weather{'windchill-c'} = $working[1];
14867 elsif ( $working[0] eq 'windchill_f' ){
14868 $weather{'windchill_f'} = $working[1];
14871 if ($show{'weather-location'}){
14872 $weather{'observation-time-local'} =~ /^(.*)\s([\S]+)$/;
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;
14881 $date_time = POSIX::strftime "%c", localtime;
14882 $tz = ( $location[2] ) ? " ($location[2])" : '';
14883 $weather{'date-time'} = $date_time . $tz;
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'});
14890 eval $end if $b_log;
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];
14901 if (!$freshness || $freshness < $now - 90) {
14903 my $url = "http://geoip.ubuntu.com/lookup";
14906 # my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/weather/location-1.xml";
14907 # open my $fh, '<', $file or die "can't open $file: $!";
14910 $temp = main::download_file('stdout',$url);
14911 @loc_data = split /\n/, $temp;
14913 s/<\?.*<Response>//;
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";
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];
14930 elsif ($working[0] eq 'CountryCode' ) {
14931 $loc{'country'} = $working[1];
14933 elsif ($working[0] eq 'CountryName' ) {
14934 $loc{'country2'} = $working[1];
14936 elsif ($working[0] eq 'RegionCode' ) {
14937 $loc{'region-id'} = $working[1];
14939 elsif ($working[0] eq 'RegionName' ) {
14940 $loc{'region'} = $working[1];
14942 elsif ($working[0] eq 'City' ) {
14943 $loc{'city'} = $working[1];
14945 elsif ($working[0] eq 'ZipPostalCode' ) {
14946 $loc{'zip'} = $working[1];
14948 elsif ($working[0] eq 'Latitude' ) {
14949 $loc{'lat'} = $working[1];
14951 elsif ($working[0] eq 'Longitude' ) {
14952 $loc{'long'} = $working[1];
14954 elsif ($working[0] eq 'TimeZone' ) {
14955 $loc{'tz'} = $working[1];
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'}";
14965 elsif ($loc{'city'} && $loc{'region-id'}){
14966 $loc_arg = "$loc{'city'},$loc{'region-id'}";
14968 # postal code last, that can be a very large region
14969 elsif ($loc{'zip'}){
14970 $loc_arg = $loc{'zip'};
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;
14983 #### -------------------------------------------------------------------
14984 #### UTILITIES FOR DATA LINES
14985 #### -------------------------------------------------------------------
14987 sub get_compiler_version {
14988 eval $start if $b_log;
14990 if (my $file = system_files('version') ) {
14991 @compiler = get_compiler_version_linux($file);
14994 @compiler = get_compiler_version_bsd();
14996 eval $end if $b_log;
15000 sub get_compiler_version_bsd {
15001 eval $start if $b_log;
15002 my (@compiler,@working);
15003 if ($alerts{'sysctl'}{'action'} eq 'use'){
15004 # for dragonfly, we will use free mem, not used because free is 0
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
15011 if (/^kern.compiler_version/){
15012 @working = split /:\s*/, $_;
15013 $working[1] =~ /.*(gcc|clang)\sversion\s([\S]+)\s.*/;
15014 @compiler = ($1,$2);
15020 @compiler = ('N/A','');
15022 log_data('dump','@compiler',\@compiler) if $b_log;
15023 eval $end if $b_log;
15027 sub get_compiler_version_linux {
15028 eval $start if $b_log;
15030 my (@compiler,$type);
15031 my @data = reader($file);
15032 my $result = $data[0] if @data;
15034 $result =~ /(gcc|clang).*version\s([\S]+)/;
15035 # $result = $result =~ /\*(gcc|clang)\*eval\*/;
15038 $type ||= 'N/A'; # we don't really know what linux clang looks like!
15039 @compiler = ($1,$type);
15042 log_data('dump','@compiler',\@compiler) if $b_log;
15044 eval $end if $b_log;
15048 ## Get DesktopEnvironment
15053 # 3 - toolkit version
15054 # 4 - info extra desktop data
15058 package DesktopEnvironment;
15059 my ($b_xprop,$desktop_session,$kde_session_version,$xdg_desktop,@desktop,@data,@xprop);
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'} : '';
15071 get_env_xprop_de_data();
15073 if (!@desktop && $b_xprop ){
15074 get_xprop_de_data();
15079 if ($extra > 2 && @desktop){
15082 if ($b_display && !$b_force_display && $extra > 1){
15085 main::log_data('dump','@desktop', \@desktop) if $b_log;
15086 # ($b_xprop,$kde_session_version,$xdg_desktop,@data,@xprop) = undef;
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");
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");
15109 $desktop[0] = 'KDE' if !$desktop[0];
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
15116 # KDE Frameworks: 5.11.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");
15122 if (!@version_data && ($program = main::check_program("kded$kde_session_version"))){
15123 @version_data = main::grabber("$program --version 2>/dev/null");
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+');
15129 $desktop[0] = 'KDE Plasma';
15132 $desktop[1] = ($kde_session_version) ? $kde_session_version: main::row_defaults('unknown-desktop-version');
15134 # print Data::Dumper::Dumper \@version_data;
15136 if (@version_data){
15137 $desktop[3] = main::awk(\@version_data,'^Qt:', 2,'\s+');
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;
15147 $desktop[2] = 'Qt';
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;
15156 $desktop[1] = '3.5';
15158 if ($extra > 1 && @version_data){
15159 $desktop[2] = 'Qt';
15160 $desktop[3] = main::awk(\@version_data,'^Qt:',2,'\s+') if @version_data;
15163 eval $end if $b_log;
15165 sub get_env_de_data {
15166 eval $start if $b_log;
15167 my ($program,@version_data);
15168 main::set_ps_gui() if ! $b_ps_gui;
15169 if ($desktop_session eq 'trinity' || $xdg_desktop eq 'trinity' || (grep {/^tde/} @ps_gui) ){
15170 $desktop[0] = 'Trinity';
15171 if ($program = main::check_program('kdesktop')){
15172 @version_data = main::grabber("$program --version 2>/dev/null");
15173 $desktop[1] = main::awk(\@version_data,'^TDE:',2,'\s+') if @version_data;
15175 if ($extra > 1 && @version_data){
15176 $desktop[2] = 'Qt';
15177 $desktop[3] = main::awk(\@version_data,'^Qt:',2,'\s+') if @version_data;
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;
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]);
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]);
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]);
15209 elsif (grep {/^razor-session$/} @ps_gui){
15210 $desktop[0] = 'Razor-Qt';
15213 $desktop[0] = 'LX-Qt-Variant';
15215 set_qt_data() if $extra > 1;
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;
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;
15232 eval $end if $b_log;
15234 sub get_env_xprop_de_data {
15235 eval $start if $b_log;
15236 my ($program,$value,@version_data);
15237 # NOTE: Always add to set_prop the search term if you add an item!!
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';
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';
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]);
15262 #set_gtk_data() if $extra > 1;
15263 $desktop[0] ||= 'MATE';
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]);
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]);
15278 # set_gtk_data() if $extra > 1;
15279 $desktop[0] = ( $data[3] ) ? $data[3] : 'Gnome';
15281 eval $end if $b_log;
15283 sub get_xprop_de_data {
15284 eval $start if $b_log;
15285 my ($program,@version_data,$version);
15286 #print join "\n", @xprop, "\n";
15287 # String: "This is xfdesktop version 4.2.12"
15288 # alternate: xfce4-about --version > xfce4-about 4.10.0 (Xfce 4.10)
15289 # note: some distros/wm (e.g. bunsen) set xdg to xfce to solve some other
15290 # issues so don't test for that. $xdg_desktop eq 'xfce'
15291 # the sequence here matters, some desktops like icewm, razor, let you set different
15292 # wm, so we want to get the main controlling desktop first, then fall back to the wm
15293 # detections. get_wm() will handle alternate wm detections.
15294 if ((main::check_program('xfdesktop')) && main::awk(\@xprop,'^(xfdesktop|xfce)' )){
15295 # this is a very expensive test that doesn't usually result in a find
15296 # talk to xfce to see what id they will be using for xfce 5
15297 # if (main::awk(\@xprop, 'xfce4')){
15300 if (main::awk(\@xprop, 'xfce5')){
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]\./;
15322 $desktop[0] ||= 'Xfce';
15323 $desktop[1] ||= ''; # xfce isn't going to be 4 forever
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];
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];
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]);
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]);
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]);
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]);
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]);
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]);
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]);
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]);
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]);
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]);
15394 # need to check starts line because it's so short
15395 eval $end if $b_log;
15397 sub get_ps_de_data {
15398 eval $start if $b_log;
15399 my ($program,@version_data);
15400 main::set_ps_gui() if !$b_ps_gui;
15402 # 1 check program; 2 search; 3 values; 4 version; 5 -optional: print value
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'],
15436 foreach my $ref (@desktops){
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]);
15450 eval $end if $b_log;
15454 eval $start if $b_log;
15455 my ($program,@data,@version_data);
15456 my $kde_version = $kde_session_version;
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 = '';}
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;
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];
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;
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;
15486 eval $end if $b_log;
15490 eval $start if $b_log;
15494 if ( (!$desktop[5] || $b_wmctrl) && (my $program = main::check_program('wmctrl'))){
15495 get_wm_wmctrl($program);
15497 eval $end if $b_log;
15500 eval $start if $b_log;
15501 my ($wms,$working);
15502 # xprop is set only if not kde/gnome/cinnamon/mate/budgie/lx..
15505 $wms = 'blackbox|compiz|kwin_wayland|kwin_x11|kwin|marco|muffin|';
15506 $wms .= 'openbox|herbstluftwm|twin|wm2|windowmaker|i3';
15510 $working = 'wmaker' if $working eq 'windowmaker';
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';
15530 get_wm_version('manual',$working) if $working;
15531 $desktop[5] = $working if !$desktop[5] && $working;
15532 eval $end if $b_log;
15534 sub get_wm_wmctrl {
15535 eval $start if $b_log;
15536 my ($program) = @_;
15537 my $cmd = "$program -m 2>/dev/null";
15538 my @data = main::grabber($cmd,'','strip');
15539 main::log_data('dump','@data',\@data) if $b_log;
15540 $desktop[5] = main::awk(\@data,'^Name',2,'\s*:\s*');
15541 $desktop[5] = '' if $desktop[5] && $desktop[5] eq 'N/A';
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]);
15553 eval $end if $b_log;
15555 sub get_wm_version {
15556 eval $start if $b_log;
15557 my ($type,$wm) = @_;
15558 # we don't want the gnome-shell version, and the others have no --version
15559 # we also don't want to run --version again on stuff we already have tested
15560 return if ! $wm || $wm =~ /^(budgie-wm|gnome-shell)$/ || ($desktop[0] && lc($desktop[0]) eq lc($wm) );
15561 my $temp = (split /\s+/, $wm)[0];
15563 $temp = (split /\s+/, $temp)[0];
15565 $temp = 'wmaker' if $temp eq 'windowmaker';
15566 my @data = main::program_values($temp);
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;
15576 eval $end if $b_log;
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
15589 @data = main::grabber("$program --modversion gtk+-3.0 2>/dev/null");
15590 $version = main::awk(\@data,'\S');
15593 @data = main::grabber("$program --modversion gtk+-2.0 2>/dev/null");
15594 $version = main::awk(\@data,'\S');
15597 # now let's go to more specific version tests, this will never cover everything and that's fine.
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
15607 @data = main::grabber("$program -s libgtk-4-0 2>/dev/null");
15608 $version = main::awk(\@data,'^\s*Version',2,'\s+');
15611 @data = main::grabber("$program -s libgtk2.0-0 2>/dev/null");
15612 $version = main::awk(\@data,'^\s*Version',2,'\s+');
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
15620 @data = main::grabber("$program -Qi gtk4 2>/dev/null");
15621 $version = main::awk(\@data,'^\s*Version',2,'\s*:\s*');
15624 @data = main::grabber("$program -Qi gtk2 2>/dev/null");
15625 $version = main::awk(\@data,'^\s*Version',2,'\s*:\s*');
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
15633 @data = main::grabber("$program -qi libgtk-4-0 2>/dev/null");
15634 $version = main::awk(\@data,'^\s*Version',2,'\s*:\s*');
15637 @data = main::grabber("$program -qi libgtk-3-0 2>/dev/null");
15638 $version = main::awk(\@data,'^\s*Version',2,'\s*:\s*');
15642 $desktop[2] = 'Gtk';
15643 eval $end if $b_log;
15645 sub set_info_data {
15646 eval $start if $b_log;
15647 my (@data,@info,$item);
15648 my $pattern = 'gnome-panel|kicker|lxpanel|lxqt-panel|matchbox-panel|';
15649 $pattern .= 'mate-panel|plasma-desktop|plasma-netbook|razor-panel|razorqt-panel|';
15650 $pattern .= 'wingpanel|xfce4-panel|xfce5-panel';
15651 if (@data = grep {/^($pattern)$/} @ps_gui ) {
15652 # only one entry per type, can be multiple
15653 foreach $item (@data){
15654 if (! grep {$item =~ /$_/} @info){
15655 $item = main::trimmer($item);
15657 push @info, (split /\s+/, $item)[0];
15661 $desktop[4] = join (',', @info) if @info;
15662 eval $end if $b_log;
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");
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;
15681 # print "@xprop\n";
15682 eval $end if $b_log;
15687 sub get_display_manager {
15688 eval $start if $b_log;
15689 my (@data,@found,$temp,$working,$b_run,$b_vrun,$b_vrunrc);
15690 # ldm - LTSP display manager. Note that sddm does not appear to have a .pid
15691 # extension in Arch note: to avoid positives with directories, test for -f
15692 # explicitly, not -e
15693 my @dms = qw(entranced.pid gdm.pid gdm3.pid kdm.pid ldm.pid
15694 lightdm.pid lxdm.pid mdm.pid nodm.pid pcdm.pid sddm.pid slim.lock
15695 tint2.pid wdm.pid xdm.pid xenodm.pid);
15696 # this is the only one I know of so far that has --version
15697 # lightdm outputs to stderr, so it has to be redirected
15698 my @dms_version = qw(lightdm);
15699 $b_run = 1 if -d "/run";
15700 # in most linux, /var/run is a sym link to /run, so no need to check it twice
15701 if ( -d "/var/run" ){
15702 my $rdlink = readlink('/var/run');
15703 $b_vrun = 1 if !$rdlink || ($rdlink && $rdlink ne '/run');
15704 $b_vrunrc = 1 if -d "/var/run/rc.d";
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.
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;
15724 push @found, $working;
15727 if (!@found && grep {/\/usr.*\/x/ && !/\/xprt/} @ps_cmd){
15728 if (awk (\@ps_cmd, 'startx') ){
15729 $found[0] = 'startx';
15731 elsif (awk (\@ps_cmd, 'xinit') ){
15732 $found[0] = 'xinit';
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;
15744 package DistroData;
15745 my (@distro_data,@osr);
15747 eval $start if $b_log;
15752 get_linux_distro();
15754 eval $end if $b_log;
15755 return @distro_data;
15759 eval $start if $b_log;
15760 my ($distro) = ('');
15761 if ($bsd_type eq 'darwin'){
15762 my $file = '/System/Library/CoreServices/SystemVersion.plist';
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);
15772 $distro = "$uname[0] $uname[2]";
15774 @distro_data = ($distro,'');
15775 eval $end if $b_log;
15778 sub get_linux_distro {
15779 eval $start if $b_log;
15780 my ($distro,$distro_id,$distro_file,$system_base) = ('','','','');
15781 my ($b_issue,$b_osr,$b_use_issue,@working);
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
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
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)
15813 $lc_issue = lc($etc_issue) if $etc_issue;
15814 if ($lc_issue =~ /(antergos|grml|linux lite)/){
15818 elsif ($lc_issue =~ /(raspbian|peppermint)/){
15820 $distro_file = $os_release if @osr;
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';
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];
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';
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;
15856 elsif ($b_lsb && $file =~ /$lsb_good_s/){
15857 $distro_file = $lsb_release;
15860 $distro_file = "/etc/$file";
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;
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();
15881 elsif ($distro_file && $distro_file eq $os_release){
15882 $distro = get_os_release();
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
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');
15899 $distro = (main::reader($distro_file))[0];
15901 $distro = main::clean_characters($distro) if $distro;
15903 # otherwise try the default debian/ubuntu /etc/issue file
15905 if ( !$distro_id && $etc_issue && $lc_issue =~ /(mint|lmde)/ ){
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();
15915 elsif (!$b_use_issue && $b_lsb){
15916 $distro = get_lsb_release();
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';
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();
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.
15941 if (!$b_osr && @osr){
15942 $distro = get_os_release();
15946 $distro = get_lsb_release();
15949 # now some final null tries
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?
15955 $distro_file =~ s/\/etc\/|[-_]|release|version//g;
15956 $distro = $distro_file;
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){
15974 @osr = @osr_working;
15975 $system_base = get_os_release();
15976 @osr = @osr_temp if !$system_base;
15977 (@osr_temp,@osr_working) = (undef,undef);
15980 elsif ( -r $base_upstream_lsb){
15981 $system_base = get_lsb_release($base_upstream_lsb);
15983 if (!$system_base && @osr){
15984 my ($base_type) = ('');
15985 if ($etc_issue && (grep {/($base_issue)/i} @osr)){
15986 $system_base = $etc_issue;
15988 # more tests added here for other ubuntu derived distros
15989 elsif ( @distro_files && (grep {/($base_default)/} @distro_files) ){
15990 $base_type = 'default';
15992 elsif ($distro_id && $distro_id =~ /(mint)/){
15993 $base_type = 'ubuntu';
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();
16000 if (!$system_base && $base_type){
16001 $system_base = get_os_release($base_type);
16004 if (!$system_base && $lc_issue && $lc_issue =~ /($base_manual)/){
16007 'kali' => 'Debian testing',
16009 $system_base = $manual{$id};
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;
16019 sub get_lsb_release {
16020 eval $start if $b_log;
16021 my ($lsb_file) = @_;
16022 $lsb_file ||= '/etc/lsb-release';
16023 my ($distro,$id,$release,$codename,$description) = ('','','','','');
16024 my @content = main::reader($lsb_file);
16025 main::log_data('dump','@content',\@content) if $b_log;
16026 @content = map {s/,|\*|\\||\"|[:\47]|^\s+|\s+$|n\/a//ig; $_} @content if @content;
16027 foreach (@content){
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';
16035 # in the old days, arch used lsb_release
16036 # elsif ($working[1] =~ /^Arch$/i){
16037 # $id = 'Arch Linux';
16043 elsif ($working[0] eq 'DISTRIB_RELEASE' && $working[1]){
16044 $release = $working[1];
16046 elsif ($working[0] eq 'DISTRIB_CODENAME' && $working[1]){
16047 $codename = $working[1];
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];
16055 if (!$id && !$release && !$codename && $description){
16056 $distro = $description;
16059 $distro = "$id $release $codename";
16060 $distro =~ s/^\s+|\s\s+|\s+$//g; # get rid of double and trailing spaces
16062 eval $end if $b_log;
16065 sub get_os_release {
16066 eval $start if $b_log;
16067 my ($base_type) = @_;
16068 my ($base_id,$base_name,$base_version,$distro,$distro_name,$pretty_name,
16069 $lc_name,$name,$version_name,$version_id) = ('','','','','','','','','','');
16070 my @content = @osr;
16071 main::log_data('dump','@content',\@content) if $b_log;
16072 @content = map {s/\\||\"|[:\47]|^\s+|\s+$|n\/a//ig; $_} @content if @content;
16073 foreach (@content){
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];
16080 elsif ($working[0] eq 'NAME' && $working[1]){
16081 $name = $working[1];
16082 $lc_name = lc($name);
16084 elsif ($working[0] eq 'VERSION' && $working[1]){
16085 $version_name = $working[1];
16086 $version_name =~ s/,//g;
16088 elsif ($working[0] eq 'VERSION_ID' && $working[1]){
16089 $version_id = $working[1];
16091 # for mint system base
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';
16098 $base_name = ucfirst($working[1]);
16100 elsif ($base_type eq 'ubuntu' && $working[0] eq 'UBUNTU_CODENAME' && $working[1]){
16101 $base_version = ucfirst($working[1]);
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
16109 if ($name && $version_name){
16111 $distro = 'Arco Linux' if $lc_name =~ /^arco/;
16112 if ($version_id && $version_name !~ /$version_id/){
16113 $distro .= ' ' . $version_id;
16115 $distro .= " $version_name";
16117 elsif ($pretty_name && ($pretty_name !~ /tumbleweed/i && $lc_name ne 'arcolinux') ){
16118 $distro = $pretty_name;
16123 $distro .= ' ' . $version_id;
16127 # note: mint has varying formats here, some have ubuntu as name, 17 and earlier
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";
16136 elsif ($base_type eq 'default' && ($pretty_name || ($name && $version_name) ) ){
16137 $distro = ($name && $version_name) ? "$name $version_name" : $pretty_name;
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;
16144 eval $end if $b_log;
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.
16151 eval $start if $b_log;
16152 my ($codename) = @_;
16153 $codename = lc($codename);
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',
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 ',
16171 $id = $codenames{$codename} if defined $codenames{$codename};
16172 eval $end if $b_log;
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');
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);
16192 # glob /usr/bin for gccs, strip out all non numeric values
16193 @temp = globber('/usr/bin/gcc-*');
16195 if (/\/gcc-([0-9.]+)$/){
16200 unshift @gccs, $gcc;
16201 log_data('dump','@gccs',\@gccs) if $b_log;
16202 eval $end if $b_log;
16206 sub get_gpu_ram_arm {
16207 eval $start if $b_log;
16208 my ($gpu_ram) = (0);
16209 if (my $program = check_program('vcgencmd')){
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;
16216 log_data('data',"gpu ram: $gpu_ram") if $b_log;
16217 eval $end if $b_log;
16222 eval $start if $b_log;
16223 my ($gpu_ram) = (0);
16224 eval $end if $b_log;
16229 eval $start if $b_log;
16231 if ( $ENV{'HOSTNAME'} ){
16232 $hostname = $ENV{'HOSTNAME'};
16234 elsif ( !$bsd_type && -f "/proc/sys/kernel/hostname" ){
16235 $hostname = (reader('/proc/sys/kernel/hostname'))[0];
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();
16243 elsif (my $program = check_program('hostname')) {
16244 $hostname = (grabber("$program 2>/dev/null"))[0];
16246 $hostname ||= 'N/A';
16247 eval $end if $b_log;
16251 sub get_init_data {
16252 eval $start if $b_log;
16253 my $runlevel = get_runlevel_data();
16254 my $default = ($extra > 1) ? get_runlevel_default() : '';
16255 my ($init,$init_version,$rc,$rc_version,$program) = ('','','','','');
16256 my $comm = ( -e '/proc/1/comm' ) ? (reader('/proc/1/comm'))[0] : '';
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.
16262 if ( $comm =~ /systemd/ ){
16264 if ( $program = check_program('systemd')){
16265 $init_version = program_version($program,'^systemd','2','--version');
16267 if (!$init_version && ($program = check_program('systemctl') ) ){
16268 $init_version = program_version($program,'^systemd','2','--version');
16271 # epoch version == Epoch Init System 1.0.1 "Sage"
16272 elsif ($comm =~ /epoch/){
16274 $init_version = program_version('epoch', '^Epoch', '4','version');
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/){
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')){
16290 elsif (check_program('launchctl')){
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;
16301 elsif ( -f '/etc/ttys' ){
16302 $init = 'init (BSD)';
16305 if ( grep { /openrc/ } globber('/run/*openrc*') ){
16307 # /sbin/openrc --version == openrc (OpenRC) 0.13
16308 if ($program = check_program('openrc')){
16309 $rc_version = program_version($program, '^openrc', '3','--version');
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');
16315 if ( -e '/run/openrc/softlevel' ){
16316 $runlevel = (reader('/run/openrc/softlevel'))[0];
16318 elsif ( -e '/var/run/openrc/softlevel'){
16319 $runlevel = (reader('/var/run/openrc/softlevel'))[0];
16321 elsif ( $program = check_program('rc-status')){
16322 $runlevel = (grabber("$program -r 2>/dev/null"))[0];
16326 'init-type' => $init,
16327 'init-version' => $init_version,
16329 'rc-version' => $rc_version,
16330 'runlevel' => $runlevel,
16331 'default' => $default,
16333 eval $end if $b_log;
16337 sub get_kernel_data {
16338 eval $start if $b_log;
16339 my ($kernel,$ksplice) = ('','');
16340 # Linux; yawn; 4.9.0-3.1-liquorix-686-pae; #1 ZEN SMP PREEMPT liquorix 4.9-4 (2017-01-14); i686
16341 # FreeBSD; siwi.pair.com; 8.2-STABLE; FreeBSD 8.2-STABLE #0: Tue May 31 14:36:14 EDT 2016 erik5@iddhi.pair.com:/usr/obj/usr/src/sys/82PAIRx-AMD64; amd64
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;
16349 $kernel .= ' ' . $uname[-1];
16350 $kernel = ($bsd_type) ? $uname[0] . ' ' . $kernel : $kernel;
16353 log_data('data',"kernel: $kernel ksplice: $ksplice") if $b_log;
16354 eval $end if $b_log;
16358 sub get_kernel_bits {
16359 eval $start if $b_log;
16362 $bits = $uname[-1];
16363 $bits = ($bits =~ /64/ ) ? 64 : 32;
16366 eval $end if $b_log;
16370 sub get_memory_data {
16371 eval $start if $b_log;
16374 if (my $file = system_files('meminfo') ) {
16375 $memory = get_memory_data_linux($type,$file);
16378 $memory = get_memory_data_bsd($type);
16380 eval $end if $b_log;
16384 sub get_memory_data_linux {
16385 eval $start if $b_log;
16386 my ($type,$file) = @_;
16387 my ($gpu,$memory,$not_used,$total) = (0,'',0,0);
16388 my @data = reader($file);
16390 if ($_ =~ /^MemTotal:/){
16391 $total = get_piece($_,2);
16393 elsif ($_ =~ /^(MemFree|Buffers|Cached):/){
16394 $not_used += get_piece($_,2);
16397 $gpu = get_gpu_ram_arm() if $b_arm;
16398 #$gpu = translate_size('128M');
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;
16407 $memory = "$total:$used:$percent:$gpu";
16409 log_data('data',"memory: $memory") if $b_log;
16410 eval $end if $b_log;
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
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
16423 # 2 0 0 14925812 936448 36 13 10 0 84 35 0 0 84 30 42 11 3 86
16425 # procs memory page disks faults cpu
16426 # r b w avm fre flt re pi po fr sr ad0 ad1 in sy cs us sy id
16427 # 0 0 0 0 84060 30273993 2845 12742 1164 407498171 320960902 0 0 ....
16428 sub get_memory_data_bsd {
16429 eval $start if $b_log;
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
16438 my $row = (grabber("vmstat $arg 2>/dev/null",'\n','strip'))[-1];
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];
16445 elsif ($data[4] != 0){
16446 $free_mem = sprintf ('%.1f',$data[4]);
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
16456 # freebsd seems to use bytes here
16457 if (!$real_mem && /^hw.physmem:/){
16458 @working = split /:\s*/,$_;
16460 $working[1] =~ s/^[^0-9]+|[^0-9]+$//g;
16461 $real_mem = sprintf("%.1f", $working[1]/1024);
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]);
16476 $message = "sysctl $$ref{'action'}"
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";
16489 $memory = "$error:$used:";
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;
16503 $memory = "$real_mem:$used:$percent:0";
16506 eval $end if $b_log;
16510 sub get_module_version {
16511 eval $start if $b_log;
16513 return if ! $module;
16515 my $path = "/sys/module/$module/version";
16517 $version = (reader($path))[0];
16519 elsif (-f "/sys/module/$module/uevent"){
16520 $version = 'kernel';
16522 #print "version:$version\n";
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;
16530 eval $end if $b_log;
16534 # args: 1 - pci device string; 2 - pci cleaned subsystem string
16535 sub get_pci_vendor {
16536 eval $start if $b_log;
16537 my ($device, $subsystem) = @_;
16538 return if !$subsystem;
16539 my ($vendor,$sep) = ('','');
16540 my @data = split /\s+/, $subsystem;
16542 if ($device !~ !/\b$_\b/){
16543 $vendor .= $sep . $_;
16550 eval $end if $b_log;
16554 # # check? /var/run/nologin for bsds?
16555 sub get_runlevel_data {
16556 eval $start if $b_log;
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 . ";;");
16563 eval $end if $b_log;
16567 # note: it appears that at least as of 2014-01-13, /etc/inittab is going
16568 # to be used for default runlevel in upstart/sysvinit. systemd default is
16569 # not always set so check to see if it's linked.
16570 sub get_runlevel_default {
16571 eval $start if $b_log;
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
16580 $default = readlink($systemd);
16581 $default =~ s/.*\/// if $default;
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,'=');
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,':');
16597 eval $end if $b_log;
16601 sub get_self_version {
16602 eval $start if $b_log;
16603 my $patch = $self_patch;
16604 if ( $patch ne '' ){
16605 # for cases where it was for example: 00-b1 clean to -b1
16606 $patch =~ s/^[0]+-?//;
16607 $patch = "-$patch" if $patch;
16609 eval $end if $b_log;
16610 return $self_version . $patch;
16613 sub get_shell_data {
16614 eval $start if $b_log;
16616 my $cmd = "ps -p $ppid -o comm= 2>/dev/null";
16617 my $shell = qx($cmd);
16618 log_data('cmd',$cmd) if $b_log;
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');
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));
16639 $client{'version'} = main::program_version($shell,$app[0],$app[1],$app[2],$app[5],$app[6]);
16641 # guess that it's two and --version
16643 # we're just guessing at the search phrase and position
16645 $client{'version'} = main::program_version($shell,$shell,2,'');
16648 $client{'version'} = row_defaults('unknown-shell');
16651 $client{'version'} =~ s/(\(.*|-release|-version)//;
16653 $client{'name'} = lc($shell);
16654 $client{'name-print'} = $shell;
16657 $client{'name'} = 'shell';
16658 $client{'name-print'} = 'Unknown Shell';
16660 $client{'su-start'} = 'sudo' if (!$client{'su-start'} && $ENV{'SUDO_USER'});
16661 eval $end if $b_log;
16664 sub get_shell_source {
16665 eval $start if $b_log;
16667 my ($msg,$self_parent,$shell_parent) = ('','','');
16668 my $ppid = getppid();
16669 $self_parent = get_start_parent($ppid);
16671 $msg = ($ppid) ? "self parent: $self_parent ppid: $ppid": "self parent: undefined";
16672 log_data('data',$msg);
16674 #print "self parent: $self_parent ppid: $ppid\n";
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";
16680 $msg = ($shell_parent) ? "shell parent 1: $shell_parent": "shell parent 1: undefined";
16681 log_data('data',$msg);
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
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";
16693 $msg = ($shell_parent) ? "shell parent $i: $shell_parent": "shell parent $i: undefined";
16694 log_data('data',$msg);
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;
16706 $self_parent ||= '';
16707 $shell_parent ||= '';
16708 log_data('data',"parents: self: $self_parent shell: $shell_parent");
16710 eval $end if $b_log;
16711 return $shell_parent;
16714 # utilities for get_shell_source
16715 # arg: 1 - parent id
16716 sub get_start_parent {
16717 eval $start if $b_log;
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;
16729 # arg: 1 - parent id
16730 sub get_shell_parent {
16731 eval $start if $b_log;
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;
16742 # this will test against default IP like: (:0) vs full IP to determine
16743 # ssh status. Surprisingly easy test? Cross platform
16744 sub get_ssh_status {
16745 eval $start if $b_log;
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,})\)$/){
16756 eval $end if $b_log;
16760 sub get_tty_console_irc {
16761 eval $start if $b_log;
16763 return $tty_session if defined $tty_session;
16764 if ( $type eq 'vtrn' && defined $ENV{'XDG_VTNR'} ){
16765 $tty_session = $ENV{'XDG_VTNR'};
16768 my $ppid = getppid();
16769 $tty_session = awk(\@ps_aux,".*$ppid.*$client{'name'}",7,'\s+');
16770 $tty_session =~ s/^[^[0-9]+// if $tty_session;
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;
16778 sub get_tty_number {
16779 eval $start if $b_log;
16781 if ( defined $ENV{'XDG_VTNR'} ){
16782 $tty = $ENV{'XDG_VTNR'};
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;
16789 $tty = '' if ! defined $tty;
16790 log_data('data',"tty:$tty") if $b_log;
16791 eval $end if $b_log;
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
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';
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));
16812 $hours = $4 . 'h ';
16813 $minutes = $5 . 'm';
16816 $minutes = $6 . 'm';
16819 $uptime = $days . $hours . $minutes;
16823 eval $end if $b_log;
16827 # NOTE: annoyingly, /sys does NOT actually use the id, it uses
16828 # the count of physical devices, starting at 0 for hub, on the bus.
16829 # args: $1 - $bus number; $2 - vendor:chip id
16830 sub get_usb_drivers {
16831 eval $start if $b_log;
16832 my ($bus,$id) = @_;
16833 return if !$bus || !$id;# these will be > 0
16834 my ($chip,$driver,$file,$path,$vendor,$working,$working2,@drivers,@temp);
16835 @temp = split /:/, $id;
16836 $vendor = $temp[0];
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-*/");
16841 $path = get_usb_path($vendor,$chip,$_);
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;
16854 @temp = main::globber("$path$bus-*/");
16857 #print "p2:". $_ . "driver\n";
16858 $file = $_ . 'driver';
16859 #print "f:$file\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;
16872 #print join "\n", @drivers, "\n";
16873 $driver = join ',', @drivers if @drivers;
16875 @temp = ($driver,$path);
16876 eval $end if $b_log;
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
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){
16899 eval $end if $b_log;
16904 #### -------------------------------------------------------------------
16905 #### SET DATA VALUES
16906 #### -------------------------------------------------------------------
16908 sub set_dmesg_boot_data {
16909 eval $start if $b_log;
16911 my ($counter) = (0);
16912 $b_dmesg_boot_check = 1;
16913 if (!$b_fake_dboot){
16914 $file = system_files('dmesg-boot');
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";
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*/:/;
16940 $_ =~ s/^(\S+)\sat\s/$1:at /; # ada0 at ahcich0
16942 if (/^bios[0-9]:(at|vendor)/){
16943 push @sysctl_machine, $_;
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];
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];
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;
16964 # note, all actual tests have already been run in check_tools so if we
16965 # got here, we're good.
16967 eval $start if $b_log;
16968 if ($alerts{'dmidecode'}{'action'} eq 'use' ){
16969 set_dmidecode_data();
16971 eval $end if $b_log;
16974 sub set_dmidecode_data {
16975 eval $start if $b_log;
16976 my ($content,@data,@working,$type,$handle);
16977 #my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/dmidecode/pci-freebsd-8.2-2";
16978 #open my $fh, '<', $file or die "can't open $file: $!";
16979 #chomp(@data = <$fh>);
16980 my $path = check_program('dmidecode');
16981 $content = qx($path 2>/dev/null) if $path;
16982 @data = split /\n/, $content;
16983 # we don't need the opener lines of dmidecode output
16984 # but we do want to preserve the indentation. Empty lines
16985 # won't matter, they will be skipped, so no need to handle them.
16986 # some dmidecodes do not use empty line separators
16987 splice @data, 0, 5 if @data;
16995 $_ =~ s/\s(information)//;
17000 $_ =~ s/^\t|\s+$//g;
17004 elsif (/^Handle\s(0x[0-9A-Fa-f]+).*DMI\stype\s([0-9]+),.*/){
17008 $b_slot_tool = 1 if $type && $type == 9;
17009 $b_skip = ( $type > 126 )? 1 : 0;
17011 # we don't need 32, system boot, or 127, end of table
17013 if ($working[0] != 32 && $working[0] < 127){
17019 @working = ($type,$handle);
17022 if (@working && $working[0] != 32 && $working[0] != 127){
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;
17038 eval $start if $b_log;
17039 if ($alerts{'ip'}{'action'} eq 'use' ){
17042 elsif ($alerts{'ifconfig'}{'action'} eq 'use'){
17045 eval $end if $b_log;
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);
17059 @temp = ($if,[@ips]);
17060 @ifs = (@ifs,@temp);
17063 @temp = split /:\s+/,$_;
17073 elsif (!$b_skip && /^inet/){
17075 @temp = split /\s+/, $_;
17076 ($broadcast,$ip,$scope,$if_id,$type) = ('','','','','');
17078 $type = ($temp[0] eq 'inet') ? 4 : 6 ;
17079 if ($temp[2] eq 'brd'){
17080 $broadcast = $temp[3];
17082 if (/scope\s([^\s]+)(\s(.+))?/){
17086 @temp = ($type,$ip,$broadcast,$scope,$if_id);
17087 @ips = (@ips,[@temp]);
17088 #print Dumper \@ips;
17091 #print Dumper \@ips if $test[4];
17093 @temp = ($if,[@ips]);
17094 @ifs = (@ifs,@temp);
17096 main::log_data('dump','@ifs',\@ifs) if $b_log;
17097 print Dumper \@ifs if $test[3];
17098 eval $end if $b_log;
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);
17113 @temp = ($if,[@ips]);
17114 @ifs = (@ifs,@temp);
17118 @temp = ($if,[($state,$speed,$duplex,$mac)]);
17119 @ifs_bsd = (@ifs_bsd,@temp);
17120 ($state,$speed,$duplex,$mac,$if_id) = ('','','','','');
17122 $if = (split /\s+/,$_)[0];
17123 $if =~ s/:$//; # em0: flags=8843
17125 $if = (split /:/, $if)[0] if $if;
17135 elsif (!$b_skip && $bsd_type && /^\s+(ether|media|status|lladdr)/){
17137 # media: Ethernet 100baseTX <full-duplex> freebsd 7.3
17138 # media: Ethernet autoselect (1000baseT <full-duplex>) Freebsd 8.2
17141 # openbsd: media: Ethernet autoselect (1000baseT full-duplex)
17142 if ($bsd_type && $bsd_type eq 'openbsd'){
17143 $_ =~ /\s\([\S]+\s([\S]+)\)/;
17150 $_ =~ /\s\(([1-9][\S]+\s)/;
17152 $speed =~ s/\s+$// if $speed;
17154 elsif (!$mac && /^ether|lladdr/){
17155 $mac = (split /\s+/, $_)[1];
17158 $state = (split /\s+/, $_)[1];
17161 elsif (!$b_skip && /^\s+inet/){
17164 $_ =~ s/addr:\s/addr:/;
17165 @temp = split /\s+/, $_;
17166 ($broadcast,$ip,$scope,$type) = ('','','','');
17168 # fe80::225:90ff:fe13:77ce%em0
17169 # $ip =~ s/^addr:|%([\S]+)//;
17170 if ($1 && $1 ne $if_id){
17173 $type = ($temp[0] eq 'inet') ? 4 : 6 ;
17174 if (/(Bcast:|broadcast\s)([\S]+)/){
17177 if (/(scopeid\s[^<]+<|Scope:|scopeid\s)([^>]+)[>]?/){
17180 $scope = 'link' if $ip =~ /^fe80/;
17181 @temp = ($type,$ip,$broadcast,$scope,$if_id);
17182 @ips = (@ips,[@temp]);
17183 #print Dumper \@ips;
17187 @temp = ($if,[@ips]);
17188 @ifs = (@ifs,@temp);
17191 @temp = ($if,[($state,$speed,$duplex,$mac)]);
17192 @ifs_bsd = (@ifs_bsd,@temp);
17193 ($state,$speed,$duplex,$mac) = ('','','','');
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;
17203 eval $start if $b_log;
17206 if ($alerts{'lspci'}{'action'} eq 'use' ){
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){
17218 if ($alerts{'pciconf'}{'action'} eq 'use'){
17219 set_pciconf_data();
17223 eval $end if $b_log;
17237 # 11 driver_nu [bsd, like: em0 - driver em; nu 0. Used to match IF in -n
17238 # 12 subsystem/vendor
17239 # 13 subsystem vendor:chip id
17240 sub set_lspci_data {
17241 eval $start if $b_log;
17242 my ($busid,$busid_nu,$content,$port,$driver,$modules,$device,$vendor_id,$chip_id,$rev,
17243 $subsystem,$subsystem_id,$type,$type_id,@pcis,@temp,@working);
17244 # my @pcis = grabber('lspci -nnv','\n','strip');
17245 my $path = check_program('lspci');
17246 $content = qx($path -nnv 2>/dev/null) if $path;
17247 @pcis = split /\n/, $content if $content;
17248 #my $file = "$ENV{HOME}/bin/scripts/inxi/data/lspci/racermach-1-knnv.txt";
17249 #my $file = "$ENV{HOME}/bin/scripts/inxi/data/lspci/rk016013-knnv.txt";
17250 #@pcis = reader($file);
17251 #print scalar @pcis;
17252 @pcis = map {$_ =~ s/^\s+//; $_} @pcis if @pcis;
17253 $b_pci_tool = 1 if @pcis && scalar @pcis > 10;
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]);
17262 #print "$busid $device_id r:$rev p: $port\n$type\n$device\n";
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";
17273 elsif ($_ =~ /^I\/O\sports/){
17274 $port = (split /\s+/,$_)[3];
17275 #print "p:$port\n";
17277 elsif ($_ =~ /^Kernel\sdriver\sin\suse/){
17278 $driver = (split /:\s*/,$_)[1];
17280 elsif ($_ =~ /^Kernel\smodules/i){
17281 $modules = (split /:\s*/,$_)[1];
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([^\)]+)\))?/){
17288 $busid_nu = hex($3);
17289 @working = split /:\s+/, $4;
17290 $device = $working[1];
17291 $type = $working[0];
17294 $rev = ($8)? $8 : '';
17295 $device = cleaner($device);
17296 $working[0] =~ /\[([^\]]+)\]$/;
17298 $b_hardware_raid = 1 if $type_id eq '0104';
17300 $type = pci_cleaner($type,'pci');
17306 $subsystem_id = '';
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]);
17315 print Dumper \@pci if $test[4];
17316 main::log_data('dump','@pci',\@pci) if $b_log;
17317 eval $end if $b_log;
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)'
17324 # subclass = ethernet
17325 sub set_pciconf_data {
17326 eval $start if $b_log;
17327 my ($busid,$busid_nu,$content,$port,$driver,$driver_nu,$modules,$device,$vendor,
17328 $vendor_id,$chip_id,$rev,$type,$type_id,@data,@temp,@working);
17329 # my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/pciconf/pci-freebsd-8.2-2";
17330 # open my $fh, '<', $file or die "can't open $file: $!";
17331 # chomp(@data = <$fh>);
17332 my $path = check_program('pciconf');
17333 $content = qx($path -lv 2>/dev/null) if $path;
17334 @data = split /\n/, $content if $content;
17335 $b_pci_tool = 1 if @data && scalar @data > 10;
17337 if ($_ =~ /^[^@]+\@pci/){
17343 foreach (@working){
17345 if ($_ =~ /^\s*$/) {
17346 $vendor = cleaner($vendor);
17347 $device = cleaner($device);
17348 if ($vendor && $device){
17349 if ($vendor !~ /$device/i){
17350 $device = "$vendor $device";
17356 @temp = ($type,$type_id,$busid,$busid_nu,$device,$vendor_id,$chip_id,
17357 $rev,$port,$driver,$modules,$driver_nu);
17358 @pci = (@pci,[@temp]);
17360 #print "$busid $device_id r:$rev p: $port\n$type\n$device\n";
17362 elsif ($_ =~ /^vendor/){
17363 $vendor = (split /\s+=\s+/,$_)[1];
17364 #print "p:$port\n";
17366 elsif ($_ =~ /^device/){
17367 $device = (split /\s+=\s+/,$_)[1];
17369 elsif ($_ =~ /^class/i){
17370 $type = (split /\s+=\s+/,$_)[1];
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]+)/){
17379 $vendor_id = substr($6,6,4);
17380 $chip_id = substr($6,2,4);
17385 $driver =~ /(^[a-z]+)([0-9]+$)/;
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]);
17398 print Dumper \@pci if $test[4];
17399 main::log_data('dump','@pci',\@pci) if $b_log;
17400 eval $end if $b_log;
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"]
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"]
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"]
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"]
17419 # /sys/devices/platform/soc/soc:internal-regs/d0018180.gpio/uevent
17421 # /sys/devices/soc.0/1180000001800.mdio/8001180000001800:05/uevent
17422 # ["DRIVER=AR8035", "OF_NAME=ethernet-phy"
17424 # /sys/devices/soc.0/1c30000.eth/uevent
17426 # /sys/devices/wlan.26/uevent [from pine64]
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;
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;
17441 @temp2 = globber('/sys/devices/*/uevent'); # see case 8
17442 @files = (@files,@temp2) if @temp2;
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){
17448 my ($busid,$busid_nu,$chip_id,$device,$driver,$modules,$port,$rev,
17449 $temp,$type,$type_id,$vendor_id,@working);
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$/;
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
17463 elsif ($temp2[0] eq 'OF_NAME'){
17466 elsif ($temp2[0] eq 'OF_COMPATIBLE_0'){
17467 @temp3 = split /,/, $temp2[1];
17468 $device = $temp3[-1];
17469 $vendor_id = $temp3[0];
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;
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]);
17488 print Dumper \@pci if $test[4];
17489 main::log_data('dump','@pci',\@pci) if $b_log;
17490 eval $end if $b_log;
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 ];
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;
17516 eval $start if $b_log;
17518 my ($working,@match,@temp);
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);
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
17536 @match = (@match,@temp);
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);
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);
17552 @match = uniq(@match);
17553 my $matches = join '|', @match;
17555 if (/^[\S]*\b($matches)(\s|$)/){
17557 push @ps_gui, $working; # deal with duplicates with uniq
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;
17566 sub set_sysctl_data {
17567 eval $start if $b_log;
17568 return if $alerts{'sysctl'}{'action'} ne 'use';
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");
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);
17585 $_ =~ s/\s*=\s*|:\s+/:/;
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, $_;
17593 elsif (/^hw\.(vendor|product|version|serialno|uuid)/){
17594 push @sysctl_machine, $_;
17596 elsif (/^hw\.sensors\.acpi(bat|cmb)/){
17597 push @sysctl_battery, $_;
17600 print Dumper \@sysctl if $test[7];
17601 # this thing can get really long.
17603 #main::log_data('dump','@sysctl',\@sysctl);
17605 eval $end if $b_log;
17608 # http://www.usb.org/developers/defined_class
17610 eval $start if $b_log;
17611 if ($alerts{'lsusb'}{'action'} eq 'use' ){
17613 # NOTE: we can't get reliable usb network device with short
17614 if ($usb_level == 2){
17615 set_lsusb_data_long();
17618 set_lsusb_data_short();
17621 elsif ( $alerts{'usbdevs'}{'action'} eq 'use'){
17622 set_usbdevs_data();
17624 eval $end if $b_log;
17627 sub set_lsusb_data_short {
17628 eval $start if $b_log;
17629 my ($content,@data);
17632 my $path = check_program('lsusb');
17633 $content = qx($path 2>/dev/null) if $path;
17634 @data = split /\n/, $content if $content;
17637 open my $fh, '<', "$ENV{'HOME'}/bin/scripts/inxi/data/lsusb/mdmarmer-lsusb.txt" or die $!;
17638 chomp(@data = <$fh>);
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]);
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]);
17655 print Dumper \@usb if $test[6];
17656 main::log_data('dump','@usb: short',\@usb) if $b_log;
17657 eval $end if $b_log;
17660 sub set_lsusb_data_long {
17661 eval $start if $b_log;
17662 my ($content,@data,@working,$bus_id,$device_id,$id,$b_skip);
17666 my $path = check_program('lsusb');
17667 $content = qx($path -v 2>/dev/null) if $path;
17668 @data = split /\n/, $content if $content;
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>);
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";
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: '';
17697 $b_skip = 1 if $one eq '~bInterfaceProtocol';
17699 if (/([\S]+):([0-9]+|0x[0-9a-f]+)\s(.*)/){
17701 #$b_skip = 1 if $1 eq '~bInterfaceProtocol';
17707 elsif (/^Bus\s([0-9]+)\sDevice\s([0-9]+):\sID\s(([0-9a-f]{4}):([0-9a-f]{4})).*/){
17709 #if (/^Bus\s([0-9]+)\sDevice\s([0-9]+):\sID\s(([0-9a-f]{4}):([0-9a-f]{4})).*/){
17712 $device_id = int($2);
17715 # we don't need 32, system boot, or 127, end of table
17717 if ($working[0] != 32 && $working[0] != 127){
17723 @working = ($bus_id,$device_id,$id);
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;
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
17745 sub set_usbdevs_data {
17746 eval $start if $b_log;
17747 my (@data,@working,$class,$bus_id,$addr_id,$id,$speed,$protocol);
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;
17756 open my $fh, '<', "$ENV{'HOME'}/bin/scripts/inxi/data/lsusb/bsd-usbdevs-v-1.txt" or die $!;
17757 chomp(@data = <$fh>);
17760 if (/^Controller\s\/dev\/usb([0-9]+)/){
17766 elsif (/^addr\s([0-9]+):\s([^,]+),[^,]+,[^,]+,\s?([^,]+)\(0x([0-9a-f]{4})\),\s?([^,]+)\s?\(0x([0-9a-f]{4})\)/){
17769 $speed = "bcdUSB:$2";
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);
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})\)/){
17785 $speed = "bcdUSB:$3";
17787 $protocol="~bInterfaceProtocol:0:$6 $4";
17788 #print "p2:$protocol\n";
17790 @working = ($bus_id,$addr_id,$id,$speed,$protocol);
17798 elsif (/^\s+port\s([0-9]+)\spowered/){
17808 main::log_data('dump','@usb: usbdevs',\@usb) if $b_log;
17809 print Dumper \@usb if $test[6];
17810 eval $end if $b_log;
17813 ########################################################################
17814 #### GENERATE LINES
17815 ########################################################################
17817 #### -------------------------------------------------------------------
17818 #### LINE CONTROLLERS
17819 #### -------------------------------------------------------------------
17824 if ($output_type eq 'screen'){
17828 %rows = (%rows,%row);
17832 sub generate_lines {
17833 eval $start if $b_log;
17834 my (%row,$b_pci_check,$b_dmi_check);
17835 set_ps_aux() if ! @ps_aux;
17836 set_sysctl_data() if $b_sysctl;
17837 # note: ps aux loads before logging starts, so create debugger data here
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);
17843 if ( $show{'short'} ){
17844 set_dmesg_boot_data() if ($bsd_type && !$b_dmesg_boot_check);
17845 %row = generate_short_data();
17849 if ( $show{'system'} ){
17850 %row = generate_system_data();
17853 if ( $show{'machine'} ){
17854 if ($b_dmi && !$b_dmi_check ){
17858 set_dmesg_boot_data() if ($bsd_type && !$b_dmesg_boot_check);
17859 %row = line_handler('Machine','machine');
17862 if ( $show{'battery'} ){
17863 set_dmi_data() if $b_dmi && !$b_dmi_check;
17865 %row = line_handler('Battery','battery');
17866 if (%row || $show{'battery-forced'}){
17870 if ( $show{'ram'} ){
17871 set_dmi_data() if $b_dmi && !$b_dmi_check;
17873 %row = line_handler('Memory','ram');
17876 if ( $show{'slot'} ){
17877 set_dmi_data() if $b_dmi && !$b_dmi_check;
17879 %row = line_handler('PCI Slots','slot');
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);
17888 if ( $show{'graphic'} ){
17889 set_pci_data() if !$b_pci_check;
17891 %row = line_handler('Graphics','graphic');
17894 if ( $show{'audio'} ){
17895 set_pci_data() if !$b_pci_check;
17897 %row = line_handler('Audio','audio');
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'}));
17906 %row = line_handler('Network','network');
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');
17914 if ( $show{'raid'} ){
17915 set_pci_data() if !$b_pci_check;
17916 %row = line_handler('RAID','raid');
17919 if ( $show{'partition'} || $show{'partition-full'}){
17920 %row = line_handler('Partition','partition');
17923 if ( $show{'unmounted'} ){
17924 %row = line_handler('Unmounted','unmounted');
17927 if ( $show{'usb'} ){
17928 set_usb_data() if !$b_usb_check;
17929 %row = line_handler('USB','usb');
17933 if ( $show{'sensor'} ){
17934 %row = line_handler('Sensors','sensor');
17937 if ( $show{'repo'} ){
17938 %row = line_handler('Repos','repo');
17941 if ( $show{'process'} ){
17942 %row = line_handler('Processes','process');
17945 if ( $show{'weather'} ){
17946 %row = line_handler('Weather','weather');
17949 if ( $show{'info'} ){
17950 %row = generate_info_data();
17954 if ( $output_type ne 'screen' ){
17955 output_handler(%rows);
17957 eval $end if $b_log;
17961 eval $start if $b_log;
17962 my ($key,$sub,$arg) = @_;
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,
17983 my $data_name = main::key($prefix++,$key);
17984 my @rows = $subs{$sub}->($arg);
17986 %data = ($data_name => \@rows,);
17988 eval $end if $b_log;
17992 #### -------------------------------------------------------------------
17994 #### -------------------------------------------------------------------
17996 sub generate_short_data {
17997 eval $start if $b_log;
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'};
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) = ('','');
18012 $speed_key = "$cpu[3]/$cpu[5]";
18013 $cpu[4] =~ s/ MHz//;
18014 $speed = "$cpu[4]/$cpu[6]";
18017 $speed_key = $cpu[3];
18020 $cpu[1] ||= row_defaults('cpu-model-null');
18021 $cpu_string = $cpu[0] . ' ' . $cpu[1] . $type;
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'}";
18030 $cpu_string = 'bsd support coming';
18031 $speed = 'bsd support coming';
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);
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);
18046 $size_type = " $temp[1]";
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);
18053 $used_type = " $temp[1]";
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";
18061 $size ||= row_defaults('disk-size-0');
18062 $disk_string = "$used$used_type/$size$size_type";
18065 #print join '; ', @cpu, " sleep: $cpu_sleep\n";
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(),
18080 main::key($prefix,'SHORT') => [(@data),],
18082 eval $end if $b_log;
18086 #### -------------------------------------------------------------------
18087 #### CONSTRUCTED LINES
18088 #### -------------------------------------------------------------------
18090 sub generate_info_data {
18091 eval $start if $b_log;
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();
18102 $gcc = shift @gccs;
18103 if ($extra > 1 && @gccs){
18104 $gcc_alt = join '/', @gccs;
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();
18115 $parent = get_tty_number();
18116 $parent = "tty $parent" if $parent ne '';
18118 if ($parent eq 'login'){
18119 $client{'su-start'} = $parent if !$client{'su-start'};
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)';
18128 my $memory = get_memory_data('splits');
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];
18138 @temp2 = get_size($gpu_ram);
18139 $gpu_ram = $temp2[0] . ' ' . $temp2[1] if $temp2[1];
18145 main::key($num++,'Processes') => scalar @ps_aux,
18146 main::key($num++,'Uptime') => &get_uptime(),
18147 main::key($num++,'Memory') => $total,
18150 $index = scalar(@{ $data{$data_name} } ) - 1;
18151 $data{$data_name}[$index]{main::key($num++,'used')} = $used;
18153 $data{$data_name}[$index]{main::key($num++,'gpu')} = $gpu_ram;
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;
18160 my $init_version = ($init{'init-version'}) ? $init{'init-version'}: 'N/A';
18161 $data{$data_name}[$index]{main::key($num++,'v')} = $init_version;
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'};
18169 if ($init{'runlevel'}){
18170 $data{$data_name}[$index]{main::key($num++,'runlevel')} = $init{'runlevel'};
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'};
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';
18187 my $compiler = ($b_gcc || $b_clang) ? '': 'N/A';
18188 $data{$data_name}[$index]{main::key($num++,'Compilers')} = $compiler;
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;
18196 $data{$data_name}[$index]{main::key($num++,'clang')} = $clang_version;
18199 if ($extra > 2 && $client{'su-start'}){
18200 $client .= " ($client{'su-start'})";
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'};
18206 if ( $running_in ){
18207 $data{$data_name}[$index]{main::key($num++,'running in')} = $running_in;
18209 $data{$data_name}[$index]{main::key($num++,$self_name)} = &get_self_version();
18211 eval $end if $b_log;
18215 sub generate_system_data {
18216 eval $start if $b_log;
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);
18224 $data_name => [{}],
18226 $index = scalar(@{ $data{$data_name} } ) - 1;
18227 if ($show{'host'}){
18228 $data{$data_name}[$index]{main::key($num++,'Host')} = &get_hostname();
18230 $data{$data_name}[$index]{main::key($num++,'Kernel')} = &get_kernel_data();
18231 $data{$data_name}[$index]{main::key($num++,'bits')} = &get_kernel_bits;
18233 my @compiler = get_compiler_version(); # get compiler data
18234 if (scalar @compiler != 2){
18235 @compiler = ('N/A', '');
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];
18244 # note: tty can have the value of 0 but the two tools
18245 # return '' if undefined, so we test for explicit ''
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]";
18256 if ($extra > 2 && $desktop_data[4]){
18257 $desktop_info = $desktop_data[4];
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];
18267 if (!$b_display || ( !$desktop && $b_root)) {
18268 my $tty = get_tty_number();
18270 $desktop_info = '';
18272 # it is defined, as ''
18273 if ( $tty eq '' && $client{'console-irc'}){
18274 $tty = get_tty_console_irc('vtnr');
18276 $desktop = "tty $tty" if $tty ne '';
18277 $desktop_key = 'Console';
18279 $desktop ||= 'N/A';
18280 $data{$data_name}[$index]{main::key($num++,$desktop_key)} = $desktop;
18282 $data{$data_name}[$index]{main::key($num++,'tk')} = $toolkit;
18285 if ($desktop_info){
18286 $data{$data_name}[$index]{main::key($num++,'info')} = $desktop_info;
18290 $data{$data_name}[$index]{main::key($num++,'wm')} = $wm if $wm;
18291 my $dms = get_display_manager();
18293 $data{$data_name}[$index]{main::key($num++,'dm')} = $dms;
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 '';
18299 my $distro_key = ($bsd_type) ? 'OS': 'Distro';
18300 my @distro_data = DistroData::get();
18301 my $distro = $distro_data[0];
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];
18307 eval $end if $b_log;
18311 #######################################################################
18313 ########################################################################
18315 main(); ## From the End comes the Beginning
18317 ## note: this EOF is needed for smxi handling, this is what triggers the full download ok