client: Sort network name case-insensitively
[quassel.git] / data / scripts / inxi
1 #!/usr/bin/env perl
2 ## infobash: Copyright (C) 2005-2007  Michiel de Boer aka locsmif
3 ## inxi: Copyright (C) 2008-2018 Harald Hope
4 ##       Additional features (C) Scott Rogers - kde, cpu info
5 ## Further fixes (listed as known): Horst Tritremmel <hjt at sidux.com>
6 ## Steven Barrett (aka: damentz) - usb audio patch; swap percent used patch
7 ## Jarett.Stevens - dmidecode -M patch for older systems with the /sys
8 ##
9 ## License: GNU GPL v3 or greater
10 ##
11 ## You should have received a copy of the GNU General Public License
12 ## along with this program.  If not, see <http://www.gnu.org/licenses/>.
13 ##
14 ## If you don't understand what Free Software is, please read (or reread)
15 ## this page: http://www.gnu.org/philosophy/free-sw.html
16
17 use strict;
18 use warnings;
19 # use diagnostics;
20 use 5.008;
21
22 use Cwd qw(abs_path); # qw(abs_path);#abs_path realpath getcwd
23 use Data::Dumper qw(Dumper); # print_r
24 use File::Find;
25 use Getopt::Long qw(GetOptions);
26 # Note: default auto_abbrev is enabled, that's fine
27 Getopt::Long::Configure ('bundling', 'no_ignore_case', 
28 'no_getopt_compat', 'no_auto_abbrev','pass_through');
29 use POSIX qw(uname strftime ttyname);
30 # use feature qw(state);
31
32 ## INXI INFO ##
33 my $self_name='inxi';
34 my $self_version='3.0.18';
35 my $self_date='2018-07-16';
36 my $self_patch='00';
37 ## END INXI INFO ##
38
39 ### INITIALIZE VARIABLES ###
40
41 ## Self data
42 my ($self_path, $user_config_dir, $user_config_file,$user_data_dir);
43
44 ## Debuggers
45 my $debug=0;
46 my (@t0,$end,$start,$fh_l,$log_file); # log file handle, file
47 my ($b_hires,$t1,$t2,$t3) = (0,0,0,0);
48 # NOTE: redhat removed HiRes from Perl Core Modules. 
49 if (eval {require Time::HiRes}){
50         Time::HiRes->import('gettimeofday','tv_interval','usleep');
51         $b_hires = 1;
52 }
53 @t0 = eval 'Time::HiRes::gettimeofday()' if $b_hires; # let's start it right away
54 ## Hashes
55 my ( %alerts,%client,%colors,%dl,%files,%rows,%system_files,%use );
56
57 ## Arrays
58 # ps_aux is full output, ps_cmd is only the last 10 columns to last
59 my (@app,@dmesg_boot,@dmi,@gpudata,@ifs,@ifs_bsd,@paths,@pci,@ps_aux,
60 @ps_cmd,@ps_gui,@sysctl,@sysctl_battery,@sysctl_sensors,@sysctl_machine,
61 @uname,@usb);
62 ## Disk arrays 
63 my (@dm_boot_disk,@dm_boot_optical,@glabel,@gpart,@hardware_raid,@labels,
64 @lsblk,@partitions,@raid,@sysctl_disks,@uuids);
65 my @test = (0,0,0,0,0);
66
67 ## Booleans
68 my ($b_admin,$b_arm,$b_console_irc,$b_debug_gz,$b_debug_timers,
69 $b_display,$b_dmesg_boot_check,
70 $b_dmi,$b_dmidecode_force,$b_fake_bsd,$b_fake_dboot,$b_fake_pciconf,
71 $b_fake_sysctl,$b_fake_usbdevs,$b_force_display,$b_gpudata,$b_irc,
72 $b_log,$b_log_colors,$b_log_full,$b_man,$b_mem,$b_mips,$b_pci,$b_pci_tool,
73 $b_proc_debug,$b_ps_gui,$b_root,$b_running_in_display,$b_slot_tool,
74 $b_soc_audio,$b_soc_gfx,$b_soc_net,$b_sudo,$b_sysctl,$b_usb_check,$b_wmctrl);
75 ## Disk checks
76 my ($b_dm_boot_disk,$b_dm_boot_optical,$b_glabel,$b_hardware_raid,
77 $b_label_uuid,$b_lsblk,$b_partitions,$b_raid);
78 my ($b_sysctl_disk,$b_update,$b_weather) = (1,1,1);
79
80 ## System
81 my ($bsd_type,$language,$os) = ('','','');
82 my ($bits_sys,$cpu_arch);
83 my ($cpu_sleep,$dl_timeout,$limit,$ps_count,$usb_level) = (0.35,4,10,5,0);
84 my $sensors_cpu_nu = 0;
85 my $weather_unit='mi';
86
87 ## Tools
88 my ($display,$ftp_alt,$tty_session);
89 my ($display_opt,$sudo) = ('','');
90
91 ## Output
92 my $extra = 0;# supported values: 0-3
93 my $filter_string = '<filter>';
94 my $line1 = "----------------------------------------------------------------------\n";
95 my $line2 = "======================================================================\n";
96 my $line3 = "----------------------------------------\n";
97 my ($output_file,$output_type) = ('','screen');
98 my $prefix = 0; # for the primiary row hash key prefix
99
100 # these will assign a separator to non irc states. Important! Using ':' can 
101 # trigger stupid emoticon. Note: SEP1/SEP2 from short form not used anymore.
102 # behaviors in output on IRC, so do not use those.
103 my %sep = ( 
104 's1-irc' => ':',
105 's1-console' => ':',
106 's2-irc' => '',
107 's2-console' => ':',
108 );
109
110 my %show = ('host' => 1);
111
112 my %size = (
113 'console' => 115,
114 # Default indentation level. NOTE: actual indent is 1 greater to allow for 
115 # spacing
116 'indent' => 11,
117 'indent-min' => 90,
118 'irc' => 100, # shorter because IRC clients have nick  lists etc
119 'max' => 0,
120 'no-display' => 130,
121 # these will be set dynamically in set_display_width()
122 'term' => 80,
123 'term-lines' => 100,
124 );
125
126 ## debug temp tools
127 $client{'test-konvi'} = 0;
128
129 ########################################################################
130 #### STARTUP
131 ########################################################################
132
133 #### -------------------------------------------------------------------
134 #### MAIN
135 #### -------------------------------------------------------------------
136
137 sub main {
138 #       print Dumper \@ARGV;
139         eval $start if $b_log;
140         initialize();
141         ## use for start client debugging
142         # $debug = 3; # 3 prints timers
143         # set_debugger(); # for debugging of konvi issues
144         #my $ob_start = StartClient->new();
145         #$ob_start->get_client_data();
146         StartClient::get_client_data();
147         # print_line( Dumper \%client);
148         get_options();
149         set_debugger(); # right after so it's set
150         check_tools();
151         set_colors();
152         set_sep();
153         # print download_file('stdout','https://') . "\n";
154         generate_lines();
155         eval $end if $b_log;
156         cleanup();
157         # weechat's executor plugin forced me to do this, and rightfully so, 
158         # because else the exit code from the last command is taken..
159         exit 0;
160 }
161
162 #### -------------------------------------------------------------------
163 #### INITIALIZE
164 #### -------------------------------------------------------------------
165
166 sub initialize {
167         set_os();
168         set_path();
169         set_user_paths();
170         set_basics();
171         system_files('set');
172         get_configs();
173         # set_downloader();
174         set_display_width('live');
175 }
176
177 sub check_tools {
178         my ($action,$program,$message,@data,%commands,%hash);
179         if ( $b_dmi ){
180                 $action = 'use';
181                 if ($program = check_program('dmidecode')) {
182                         @data = grabber("$program -t chassis -t baseboard -t processor 2>&1");
183                         if (scalar @data < 15){
184                                 if ($b_root) {
185                                         foreach (@data){
186                                                 if ($_ =~ /No SMBIOS/i){
187                                                         $action = 'smbios';
188                                                         last;
189                                                 }
190                                                 elsif ($_ =~ /^\/dev\/mem: Operation/i){
191                                                         $action = 'no-data';
192                                                         last;
193                                                 }
194                                                 else {
195                                                         $action = 'unknown-error';
196                                                         last;
197                                                 }
198                                         }
199                                 }
200                                 else {
201                                         if (grep { $_ =~ /^\/dev\/mem: Permission/i } @data){
202                                                 $action = 'permissions';
203                                         }
204                                         else {
205                                                 $action = 'unknown-error';
206                                         }
207                                 }
208                         }
209                 }
210                 else {
211                         $action = 'missing';
212                 }
213                 %hash = (
214                 'dmidecode' => {
215                 'action' => $action,
216                 'missing' => 'Required program dmidecode not available',
217                 'permissions' => 'Unable to run dmidecode. Are you root?',
218                 'smbios' => 'No SMBIOS data for dmidecode to process',
219                 'no-data' => 'dmidecode is not allowed to read /dev/mem',
220                 'unknown-error' => 'dmidecode was unable to generate data',
221                 },
222                 );
223                 %alerts = (%alerts, %hash);
224         }
225         # note: gnu/linux has sysctl so it may be used that for something if present
226         # there is lspci for bsds so doesn't hurt to check it
227         if ($b_pci || $b_sysctl){
228                 if (!$bsd_type){
229                         if ($b_pci ){
230                                 %hash = ('lspci' => '-n',);
231                                 %commands = (%commands,%hash);
232                         }
233                 }
234                 else {
235                         if ($b_pci ){
236                                 %hash = ('pciconf' => '-l',);
237                                 %commands = (%commands,%hash);
238                         }
239                         if ($b_sysctl ){
240                                 # note: there is a case of kernel.osrelease but it's a linux distro
241                                 %hash = ('sysctl' => 'kern.osrelease',);
242                                 %commands = (%commands,%hash);
243                         }
244                 }
245                 foreach ( keys %commands ){
246                         $action = 'use';
247                         if ($program = check_program($_)) {
248                                 # > 0 means error in shell
249                                 #my $cmd = "$program $commands{$_} >/dev/null";
250                                 #print "$cmd\n";
251                                 $action = 'permissions' if system("$program $commands{$_} >/dev/null 2>&1");
252                         }
253                         else {
254                                 $action = 'missing';
255                         }
256                         %hash = (
257                         $_ => {
258                         'action' => $action,
259                         'missing' => "Missing system tool: $_. Output will be incomplete",
260                         'permissions' => "Unable to run $_. Root required?",
261                         },
262                         );
263                         %alerts = (%alerts, %hash);
264                 }
265         }
266         %commands = ();
267         if ( $show{'sensor'} ){
268                 %commands = ('sensors' => 'linux',);
269         }
270         # note: lsusb ships in FreeBSD ports sysutils/usbutils
271         if ( $usb_level ){
272                 %hash = ('lsusb' => 'all',);
273                 %commands = (%commands,%hash);
274                 %hash = ('usbdevs' => 'bsd',);
275                 %commands = (%commands,%hash);
276         }
277         if ($show{'ip'} || ($bsd_type && $show{'network-advanced'})){
278                 %hash = (
279                 'ip' => 'linux',
280                 'ifconfig' => 'all',
281                 );
282                 %commands = (%commands,%hash);
283         }
284         foreach ( keys %commands ){
285                 $action = 'use';
286                 $message = 'Present and working';
287                 if ( ($commands{$_} eq 'linux' && $os ne 'linux' ) || ($commands{$_} eq 'bsd' && $os eq 'linux' ) ){
288                         $message = "No " . ucfirst($os) . " support. Is a comparable $_ tool available?";
289                         $action = 'platform';
290                 }
291                 elsif (!check_program($_)){
292                         $message = "Required tool $_ not installed. Check --recommends";
293                         $action = 'missing';
294                 }
295                 %hash = (
296                 $_ => {
297                 'action' => $action,
298                 'missing' => $message,
299                 'platform' => $message,
300                 },
301                 );
302                 %alerts = (%alerts, %hash);
303         }
304         # print Dumper \%alerts;
305         # only use sudo if not root, -n option requires sudo -V 1.7 or greater. 
306         # for some reason sudo -n with < 1.7 in Perl does not print to stderr
307         # sudo will just error out which is the safest course here for now,
308         # otherwise that interactive sudo password thing is too annoying
309         # important: -n makes it non interactive, no prompt for password
310         if (!$b_root && $b_sudo && (my $path = main::check_program('sudo') )) {
311                 my @data = program_values('sudo');
312                 my $version = program_version($path,$data[0],$data[1],$data[2],$data[5]);
313                 $version =~ s/^([0-9]+\.[0-9]+).*/$1/;
314                 $sudo = "$path -n " if $version >= 1.7;
315         }
316         set_fake_tools() if $b_fake_bsd;
317 }
318
319 # args: 1 - desktop/app command for --version; 2 - search string; 
320 # 3 - space print number; 4 - [optional] version arg: -v, version, etc
321 # 5 - [optional] exit first find 0/1; 6 - [optional] 0/1 stderr output
322 sub set_basics {
323         ### LOCALIZATION - DO NOT CHANGE! ###
324         # set to default LANG to avoid locales errors with , or .
325         # Make sure every program speaks English.
326         $ENV{'LANG'}='C';
327         $ENV{'LC_ALL'}='C';
328         # remember, perl uses the opposite t/f return as shell!!!
329         $b_irc = ( system('tty >/dev/null') ) ? 1 : 0;
330         # print "birc: $b_irc\n";
331         $b_display = ( $ENV{'DISPLAY'} ) ? 1 : 0;
332         $b_root = ( $ENV{'HOME'} eq '/root' ) ? 1 : 0;
333         $dl{'dl'} = 'curl';
334         $dl{'curl'} = 1;
335         $dl{'tiny'} = 1; # note: two modules needed, tested for in set_downloader
336         $dl{'wget'} = 1;
337         $dl{'fetch'} = 1;
338         $client{'console-irc'} = 0;
339         $client{'dcop'} = (check_program('dcop')) ? 1 : 0;
340         $client{'qdbus'} = (check_program('qdbus')) ? 1 : 0;
341         $client{'konvi'} = 0;
342         $client{'name'} = '';
343         $client{'name-print'} = '';
344         $client{'su-start'} = ''; # shows sudo/su
345         $client{'version'} = '';
346         $colors{'default'} = 2;
347 }
348
349 # args: $1 - default OR override default cols max integer count. $_[0]
350 # is the display width override.
351 sub set_display_width {
352         my ($width) = @_;
353         if ( $width eq 'live' ){
354                 ## sometimes tput will trigger an error (mageia) if irc client
355                 if ( ! $b_irc ){
356                         if ( check_program('tput') ) {
357                                 # trips error if use qx()...
358                                 chomp($size{'term'}=qx{tput cols});
359                                 chomp($size{'term-lines'}=qx{tput lines});
360                                 $size{'term-cols'} = $size{'term'};
361                         }
362                         # print "tc: $size{'term'} cmc: $size{'console'}\n";
363                         # double check, just in case it's missing functionality or whatever
364                         if ( $size{'term'} == 0 || $size{'term'} !~ /\d/ ){ 
365                                 $size{'term'}=80;
366                                 # we'll be using this for terminal dimensions later so don't set default.
367                                 # $size{'term-lines'}=100;
368                         }
369                 }
370                 # this lets you set different size for in or out of display server
371                 # if ( ! $b_running_in_display && $configs{'COLS_MAX_NO_DISPLAY'} != 0 ){
372                 #       $size{'console'}=$configs{'COLS_MAX_NO_DISPLAY'};
373                 # }
374                 # term_cols is set in top globals, using tput cols
375                 # print "tc: $size{'term'} cmc: $size{'console'}\n";
376                 if ( $size{'term'} < $size{'console'} ){
377                         $size{'console'}=$size{'term'};
378                 }
379                 # adjust, some terminals will wrap if output cols == term cols
380                 $size{'console'}=( $size{'console'} - 2 );
381                 # echo cmc: $size{'console'}
382                 # comes after source for user set stuff
383                 if ( ! $b_irc ){
384                         $size{'max'}=$size{'console'};
385                 }
386                 else {
387                         $size{'max'}=$size{'irc'};
388                 }
389         }
390         else {
391                 $size{'max'}=$width;
392         }
393         # print "tc: $size{'term'} cmc: $size{'console'} cm: $size{'max'}\n";
394 }
395
396 # only for dev/debugging BSD 
397 sub set_fake_tools {
398         $system_files{'dmesg-boot'} = '/var/run/dmesg.boot' if $b_fake_dboot;
399         $alerts{'pciconf'} = ({'action' => 'use'}) if $b_fake_pciconf;
400         $alerts{'sysctl'} = ({'action' => 'use'}) if $b_fake_sysctl;
401         if ($b_fake_usbdevs ){
402                 $alerts{'usbdevs'} = ({'action' => 'use'});
403                 $alerts{'lsusb'} = ({
404                 'action' => 'missing',
405                 'missing' => 'Required program lsusb not available',
406                 });
407         }
408 }
409
410 # NOTE: most tests internally are against !$bsd_type
411 sub set_os {
412         @uname = uname();
413         $os = lc($uname[0]);
414         $cpu_arch = lc($uname[-1]);
415         if ($cpu_arch =~ /arm|aarch/){$b_arm = 1}
416         elsif ($cpu_arch =~ /mips/) {$b_mips = 1}
417         # aarch32 mips32 intel/amd handled in cpu
418         if ($cpu_arch =~ /(armv[1-7]|32|sparc_v9)/){
419                 $bits_sys = 32;
420         }
421         elsif ($cpu_arch =~ /(alpha|64)/){
422                 $bits_sys = 64;
423         }
424         if ( $os =~ /(bsd|dragonfly|darwin)/ ){
425                 if ( $os =~ /openbsd/ ){
426                         $os = 'openbsd';
427                 }
428                 elsif ($os =~ /darwin/){
429                         $os = 'darwin';
430                 }
431                 if ($os =~ /kfreebsd/){
432                         $bsd_type = 'debian-bsd';
433                 }
434                 else {
435                         $bsd_type = $os;
436                 }
437         }
438 }
439
440 # This data is hard set top of program but due to a specific project's
441 # foolish idea that ignoring the FSH totally is somehow a positive step
442 # forwards for free software, we also have to padd the results with PATH.
443 sub set_path {
444         # Extra path variable to make execute failures less likely, merged below
445         my (@path);
446         @paths = qw(/sbin /bin /usr/sbin /usr/bin /usr/local/sbin /usr/local/bin /usr/X11R6/bin);
447         @path = split /:/, $ENV{'PATH'} if $ENV{'PATH'};
448         # print "paths: @paths\nPATH: $ENV{'PATH'}\n";
449         # Create a difference of $PATH and $extra_paths and add that to $PATH:
450         foreach my $id (@path) {
451                 if ( !(grep { /^$id$/ } @paths) && $id !~ /(game)/ ){
452                         push @paths, $id;
453                 }
454         }
455         # print "paths: @paths\n";
456 }
457
458 sub set_sep {
459         if ( $b_irc ){
460                 # too hard to read if no colors, so force that for users on irc
461                 if ($colors{'scheme'} == 0 ){
462                         $sep{'s1'} = $sep{'s1-console'};
463                         $sep{'s2'} = $sep{'s2-console'};
464                 }
465                 else {
466                         $sep{'s1'} = $sep{'s1-irc'};
467                         $sep{'s2'} = $sep{'s2-irc'};
468                 }
469         }
470         else {
471                 $sep{'s1'} = $sep{'s1-console'};
472                 $sep{'s2'} = $sep{'s2-console'};
473         }
474 }
475
476 sub set_user_paths {
477         my ( $b_conf, $b_data );
478         # this needs to be set here because various options call the parent 
479         # initialize function directly.
480         $self_path = $0;
481         $self_path =~ s/[^\/]+$//;
482         # print "0: $0 sp: $self_path\n";
483         
484         if ( defined $ENV{'XDG_CONFIG_HOME'} && $ENV{'XDG_CONFIG_HOME'} ){
485                 $user_config_dir=$ENV{'XDG_CONFIG_HOME'};
486                 $b_conf=1;
487         }
488         elsif ( -d "$ENV{'HOME'}/.config" ){
489                 $user_config_dir="$ENV{'HOME'}/.config";
490                 $b_conf=1;
491         }
492         else {
493                 $user_config_dir="$ENV{'HOME'}/.$self_name";
494         }
495         if ( defined $ENV{'XDG_DATA_HOME'} && $ENV{'XDG_DATA_HOME'} ){
496                 $user_data_dir="$ENV{'XDG_DATA_HOME'}/$self_name";
497                 $b_data=1;
498         }
499         elsif ( -d "$ENV{'HOME'}/.local/share" ){
500                 $user_data_dir="$ENV{'HOME'}/.local/share/$self_name";
501                 $b_data=1;
502         }
503         else {
504                 $user_data_dir="$ENV{'HOME'}/.$self_name";
505         }
506         # note, this used to be created/checked in specific instance, but we'll just do it
507         # universally so it's done at script start.
508         if ( ! -d $user_data_dir ){
509                 mkdir $user_data_dir;
510                 # system "echo", "Made: $user_data_dir";
511         }
512         if ( $b_conf && -f "$ENV{'HOME'}/.$self_name/$self_name.conf" ){
513                 #system 'mv', "-f $ENV{'HOME'}/.$self_name/$self_name.conf", $user_config_dir;
514                 # print "WOULD: Moved $self_name.conf from $ENV{'HOME'}/.$self_name to $user_config_dir\n";
515         }
516         if ( $b_data && -d "$ENV{'HOME'}/.$self_name" ){
517                 #system 'mv', '-f', "$ENV{'HOME'}/.$self_name/*", $user_data_dir;
518                 #system 'rm', '-Rf', "$ENV{'HOME'}/.$self_name";
519                 # print "WOULD: Moved data dir $ENV{'HOME'}/.$self_name to $user_data_dir\n";
520         }
521         $log_file="$user_data_dir/$self_name.log";
522         #system 'echo', "$ENV{'HOME'}/.$self_name/* $user_data_dir";
523         # print "scd: $user_config_dir sdd: $user_data_dir \n";
524 }
525
526 # args: 1: set|hash key to return either null or path
527 sub system_files {
528         my ($file) = @_;
529         if ( $file eq 'set'){
530                 %files = (
531                 'asound-cards' => '/proc/asound/cards',
532                 'asound-modules' => '/proc/asound/modules',
533                 'asound-version' => '/proc/asound/version',
534                 'cpuinfo' => '/proc/cpuinfo',
535                 'dmesg-boot' => '/var/run/dmesg.boot',
536                 'lsb-release' => '/etc/lsb-release',
537                 'mdstat' => '/proc/mdstat',
538                 'meminfo' => '/proc/meminfo',
539                 'modules' => '/proc/modules',
540                 'mounts' => '/proc/mounts',
541                 'os-release' => '/etc/os-release',
542                 'partitions' => '/proc/partitions',
543                 'scsi' => '/proc/scsi/scsi',
544                 'version' => '/proc/version',
545                 'xorg-log' => '/var/log/Xorg.0.log'
546                 );
547                 foreach ( keys %files ){
548                         $system_files{$_} = ( -e $files{$_} ) ? $files{$_} : '';
549                 }
550                 if ( ! $system_files{'xorg-log'} && check_program('xset') ){
551                         my $data = qx(xset q 2>/dev/null);
552                         foreach ( split /\n/, $data){
553                                 if ($_ =~ /Log file/i){
554                                         $system_files{'xorg-log'} = get_piece($_,3);
555                                         last;
556                                 }
557                         }
558                 }
559         }
560         else {
561                 return $system_files{$file};
562         }
563 }
564
565 ########################################################################
566 #### UTILITIES
567 ########################################################################
568
569 #### -------------------------------------------------------------------
570 #### COLORS
571 #### -------------------------------------------------------------------
572
573 ## arg: 1 - the type of action, either integer, count, or full
574 sub get_color_scheme {
575         my ($type) = @_;
576         eval $start if $b_log;
577         my @color_schemes = (
578         [qw(EMPTY EMPTY EMPTY )],
579         [qw(NORMAL NORMAL NORMAL )],
580         # for dark OR light backgrounds
581         [qw(BLUE NORMAL NORMAL)],
582         [qw(BLUE RED NORMAL )],
583         [qw(CYAN BLUE NORMAL )],
584         [qw(DCYAN NORMAL NORMAL)],
585         [qw(DCYAN BLUE NORMAL )],
586         [qw(DGREEN NORMAL NORMAL )],
587         [qw(DYELLOW NORMAL NORMAL )],
588         [qw(GREEN DGREEN NORMAL )],
589         [qw(GREEN NORMAL NORMAL )],
590         [qw(MAGENTA NORMAL NORMAL)],
591         [qw(RED NORMAL NORMAL)],
592         # for light backgrounds
593         [qw(BLACK DGREY NORMAL)],
594         [qw(DBLUE DGREY NORMAL )],
595         [qw(DBLUE DMAGENTA NORMAL)],
596         [qw(DBLUE DRED NORMAL )],
597         [qw(DBLUE BLACK NORMAL)],
598         [qw(DGREEN DYELLOW NORMAL )],
599         [qw(DYELLOW BLACK NORMAL)],
600         [qw(DMAGENTA BLACK NORMAL)],
601         [qw(DCYAN DBLUE NORMAL)],
602         # for dark backgrounds
603         [qw(WHITE GREY NORMAL)],
604         [qw(GREY WHITE NORMAL)],
605         [qw(CYAN GREY NORMAL )],
606         [qw(GREEN WHITE NORMAL )],
607         [qw(GREEN YELLOW NORMAL )],
608         [qw(YELLOW WHITE NORMAL )],
609         [qw(MAGENTA CYAN NORMAL )],
610         [qw(MAGENTA YELLOW NORMAL)],
611         [qw(RED CYAN NORMAL)],
612         [qw(RED WHITE NORMAL )],
613         [qw(BLUE WHITE NORMAL)],
614         # miscellaneous
615         [qw(RED BLUE NORMAL )],
616         [qw(RED DBLUE NORMAL)],
617         [qw(BLACK BLUE NORMAL)],
618         [qw(BLACK DBLUE NORMAL)],
619         [qw(NORMAL BLUE NORMAL)],
620         [qw(BLUE MAGENTA NORMAL)],
621         [qw(DBLUE MAGENTA NORMAL)],
622         [qw(BLACK MAGENTA NORMAL)],
623         [qw(MAGENTA BLUE NORMAL)],
624         [qw(MAGENTA DBLUE NORMAL)],
625         );
626         if ($type eq 'count' ){
627                 return scalar @color_schemes;
628         }
629         if ($type eq 'full' ){
630                 return @color_schemes;
631         }
632         else {
633                 return @{$color_schemes[$type]};
634                 # print Dumper $color_schemes[$scheme_nu];
635         }
636         eval $end if $b_log;
637 }
638
639 sub set_color_scheme {
640         eval $start if $b_log;
641         my ($scheme) = @_;
642         $colors{'scheme'} = $scheme;
643         my $index = ( $b_irc ) ? 1 : 0; # defaults to non irc
644         
645         # NOTE: qw(...) kills the escape, it is NOT the same as using 
646         # Literal "..", ".." despite docs saying it is.
647         my %color_palette = (
648         'EMPTY' => [ '', '' ],
649         'DGREY' => [ "\e[1;30m", "\x0314" ],
650         'BLACK' => [ "\e[0;30m", "\x0301" ],
651         'RED' => [ "\e[1;31m", "\x0304" ],
652         'DRED' => [ "\e[0;31m", "\x0305" ],
653         'GREEN' => [ "\e[1;32m", "\x0309" ],
654         'DGREEN' => [ "\e[0;32m", "\x0303" ],
655         'YELLOW' => [ "\e[1;33m", "\x0308" ],
656         'DYELLOW' => [ "\e[0;33m", "\x0307" ],
657         'BLUE' => [ "\e[1;34m", "\x0312" ],
658         'DBLUE' => [ "\e[0;34m", "\x0302" ],
659         'MAGENTA' => [ "\e[1;35m", "\x0313" ],
660         'DMAGENTA' => [ "\e[0;35m", "\x0306" ],
661         'CYAN' => [ "\e[1;36m", "\x0311" ],
662         'DCYAN' => [ "\e[0;36m", "\x0310" ],
663         'WHITE' => [ "\e[1;37m", "\x0300" ],
664         'GREY' => [ "\e[0;37m", "\x0315" ],
665         'NORMAL' => [ "\e[0m", "\x03" ],
666         );
667         my @scheme = get_color_scheme($colors{'scheme'});
668         $colors{'c1'} = $color_palette{$scheme[0]}[$index];
669         $colors{'c2'} = $color_palette{$scheme[1]}[$index];
670         $colors{'cn'} = $color_palette{$scheme[2]}[$index];
671         # print Dumper \@scheme;
672         # print "$colors{'c1'}here$colors{'c2'} we are!$colors{'cn'}\n";
673         eval $end if $b_log;
674 }
675
676 sub set_colors {
677         eval $start if $b_log;
678         # it's already been set with -c 0-43
679         if ( exists $colors{'c1'} ){
680                 return 1;
681         }
682         # This let's user pick their color scheme. For IRC, only shows the color schemes, 
683         # no interactive. The override value only will be placed in user config files. 
684         # /etc/inxi.conf can also override
685         if (exists $colors{'selector'}){
686                 my $ob_selector = SelectColors->new($colors{'selector'});
687                 $ob_selector->select_schema();
688                 return 1;
689         }
690         # set the default, then override as required
691         my $color_scheme = $colors{'default'};
692         # these are set in user configs
693         if (defined $colors{'global'}){
694                 $color_scheme = $colors{'global'};
695         }
696         else {
697                 if ( $b_irc ){
698                         if (defined $colors{'irc-virt-term'} && $b_display && $client{'console-irc'}){
699                                 $color_scheme = $colors{'irc-virt-term'};
700                         }
701                         elsif (defined $colors{'irc-console'} && !$b_display){
702                                 $color_scheme = $colors{'irc-console'};
703                         }
704                         elsif ( defined $colors{'irc-gui'}) {
705                                 $color_scheme = $colors{'irc-gui'};
706                         }
707                 }
708                 else {
709                         if (defined $colors{'console'} && !$b_display){
710                                 $color_scheme = $colors{'console'};
711                         }
712                         elsif (defined $colors{'virt-term'}){
713                                 $color_scheme = $colors{'virt-term'};
714                         }
715                 }
716         }
717         # force 0 for | or > output, all others prints to irc or screen
718         if (!$b_irc && ! -t STDOUT ){
719                 $color_scheme = 0;
720         }
721         set_color_scheme($color_scheme);
722         eval $end if $b_log;
723 }
724
725 ## SelectColors
726 {
727 package SelectColors;
728
729 # use warnings;
730 # use strict;
731 # use diagnostics;
732 # use 5.008;
733
734 my (@data,@rows,%configs,%status);
735 my ($type,$w_fh);
736 my $safe_color_count = 12; # null/normal + default color group
737 my $count = 0;
738
739 # args: 1 - type
740 sub new {
741         my $class = shift;
742         ($type) = @_;
743         my $self = {};
744         return bless $self, $class;
745 }
746 sub select_schema {
747         eval $start if $b_log;
748         assign_selectors();
749         main::set_color_scheme(0);
750         set_status();
751         start_selector();
752         create_color_selections();
753         if (! $b_irc ){
754                 main::check_config_file();
755                 get_selection();
756         }
757         else {
758                 print_irc_message();
759         }
760         eval $end if $b_log;
761 }
762
763 sub set_status {
764         $status{'console'} = (defined $colors{'console'}) ? "Set: $colors{'console'}" : 'Not Set';
765         $status{'virt-term'} = (defined $colors{'virt-term'}) ? "Set: $colors{'virt-term'}" : 'Not Set';
766         $status{'irc-console'} = (defined $colors{'irc-console'}) ? "Set: $colors{'irc-console'}" : 'Not Set';
767         $status{'irc-gui'} = (defined $colors{'irc-gui'}) ? "Set: $colors{'irc-gui'}" : 'Not Set';
768         $status{'irc-virt-term'} = (defined $colors{'irc-virt-term'}) ? "Set: $colors{'irc-virt-term'}" : 'Not Set';
769         $status{'global'} = (defined $colors{'global'}) ? "Set: $colors{'global'}" : 'Not Set';
770 }
771
772 sub assign_selectors {
773         if ($type == 94){
774                 $configs{'variable'} = 'CONSOLE_COLOR_SCHEME';
775                 $configs{'selection'} = 'console';
776         }
777         elsif ($type == 95){
778                 $configs{'variable'} = 'VIRT_TERM_COLOR_SCHEME';
779                 $configs{'selection'} = 'virt-term';
780         }
781         elsif ($type == 96){
782                 $configs{'variable'} = 'IRC_COLOR_SCHEME';
783                 $configs{'selection'} = 'irc-gui';
784         }
785         elsif ($type == 97){
786                 $configs{'variable'} = 'IRC_X_TERM_COLOR_SCHEME';
787                 $configs{'selection'} = 'irc-virt-term';
788         }
789         elsif ($type == 98){
790                 $configs{'variable'} = 'IRC_CONS_COLOR_SCHEME';
791                 $configs{'selection'} = 'irc-console';
792         }
793         elsif ($type == 99){
794                 $configs{'variable'} = 'GLOBAL_COLOR_SCHEME';
795                 $configs{'selection'} = 'global';
796         }
797 }
798 sub start_selector {
799         my $whoami = getpwuid($<) || "unknown???";
800         if ( ! $b_irc ){
801                 @data = (
802                 [ 0, '', '', "Welcome to $self_name! Please select the default 
803                 $configs{'selection'} color scheme."],
804                 );
805         }
806         @rows = (
807         [ 0, '', '', "Because there is no way to know your $configs{'selection'}
808         foreground/background colors, you can set your color preferences from 
809         color scheme option list below:"],
810         [ 0, '', '', "0 is no colors; 1 is neutral."],
811         [ 0, '', '', "After these, there are 4 sets:"],
812         [ 0, '', '', "1-dark^or^light^backgrounds; 2-light^backgrounds; 
813         3-dark^backgrounds; 4-miscellaneous"],
814         [ 0, '', '', ""],
815         );
816         push @data, @rows;
817         if ( ! $b_irc ){
818                 @rows = (
819                 [ 0, '', '', "Please note that this will set the $configs{'selection'} 
820                 preferences only for user: $whoami"],
821                 );
822                 push @data, @rows;
823         }
824         @rows = (
825         [ 0, '', '', "$line1"],
826         );
827         push @data, @rows;
828         main::print_basic(@data); 
829         @data = ();
830 }
831 sub create_color_selections {
832         my $spacer = '^^'; # printer removes double spaces, but replaces ^ with ' '
833         $count = ( main::get_color_scheme('count') - 1 );
834         for my $i (0 .. $count){
835                 if ($i > 9){
836                         $spacer = '^';
837                 }
838                 if ($configs{'selection'} =~ /^global|irc-gui|irc-console|irc-virt-term$/ && $i > $safe_color_count ){
839                         last;
840                 }
841                 main::set_color_scheme($i);
842                 @rows = (
843                 [0, '', '', "$i)$spacer$colors{'c1'}Card:$colors{'c2'}^nVidia^GT218 
844                 $colors{'c1'}Display^Server$colors{'c2'}^x11^(X.Org^1.7.7)$colors{'cn'}"],
845                 );
846                 push @data, @rows;
847         }
848         main::print_basic(@data); 
849         @data = ();
850         main::set_color_scheme(0);
851 }
852 sub get_selection {
853         my $number = $count + 1;
854         @data = (
855         [0, '', '', ($number++) . ")^Remove all color settings. Restore $self_name default."],
856         [0, '', '', ($number++) . ")^Continue, no changes or config file setting."],
857         [0, '', '', ($number++) . ")^Exit, use another terminal, or set manually."],
858         [0, '', '', "$line1"],
859         [0, '', '', "Simply type the number for the color scheme that looks best to your 
860         eyes for your $configs{'selection'} settings and hit <ENTER>. NOTE: You can bring this 
861         option list up by starting $self_name with option: -c plus one of these numbers:"],
862         [0, '', '', "94^-^console,^not^in^desktop^-^$status{'console'}"],
863         [0, '', '', "95^-^terminal,^desktop^-^$status{'virt-term'}"],
864         [0, '', '', "96^-^irc,^gui,^desktop^-^$status{'irc-gui'}"],
865         [0, '', '', "97^-^irc,^desktop,^in^terminal^-^$status{'irc-virt-term'}"],
866         [0, '', '', "98^-^irc,^not^in^desktop^-^$status{'irc-console'}"],
867         [0, '', '', "99^-^global^-^$status{'global'}"],
868         [0, '', '',  ""],
869         [0, '', '', "Your selection(s) will be stored here: $user_config_file"],
870         [0, '', '', "Global overrides all individual color schemes. Individual 
871         schemes remove the global setting."],
872         [0, '', '', "$line1"],
873         );
874         main::print_basic(@data); 
875         @data = ();
876         my $response = <STDIN>;
877         chomp $response;
878         if ($response =~ /([^0-9]|^$)/ || ( $response =~ /^[0-9]+$/ && $response > ($count + 3) )){
879                 @data = (
880                 [0, '', '', "Error - Invalid Selection. You entered this: $response. Hit <ENTER> to continue."],
881                 [0, '', '',  "$line1"],
882                 );
883                 main::print_basic(@data); 
884                 my $response = <STDIN>;
885                 start_selector();
886                 create_color_selections();
887                 get_selection();
888         }
889         else {
890                 process_selection($response);
891         }
892 }
893 sub process_selection {
894         my $response = shift;
895         if ($response == ($count + 3) ){
896                 @data = ([0, '', '', "Ok, exiting $self_name now. You can set the colors later."],);
897                 main::print_basic(@data); 
898                 exit 1;
899         }
900         elsif ($response == ($count + 2)){
901                 @data = (
902                 [0, '', '', "Ok, continuing $self_name unchanged."],
903                 [0, '', '',  "$line1"],
904                 );
905                 main::print_basic(@data); 
906                 if ( defined $colors{'console'} && !$b_display ){
907                         main::set_color_scheme($colors{'console'});
908                 }
909                 if ( defined $colors{'virt-term'} ){
910                         main::set_color_scheme($colors{'virt-term'});
911                 }
912                 else {
913                         main::set_color_scheme($colors{'default'});
914                 }
915         }
916         elsif ($response == ($count + 1)){
917                 @data = (
918                 [0, '', '', "Removing all color settings from config file now..."],
919                 [0, '', '',  "$line1"],
920                 );
921                 main::print_basic(@data); 
922                 delete_all_config_colors();
923                 main::set_color_scheme($colors{'default'});
924         }
925         else {
926                 main::set_color_scheme($response);
927                 @data = (
928                 [0, '', '', "Updating config file for $configs{'selection'} color scheme now..."],
929                 [0, '', '',  "$line1"],
930                 );
931                 main::print_basic(@data); 
932                 if ($configs{'selection'} eq 'global'){
933                         delete_all_config_colors();
934                 }
935                 set_config_color_scheme($response);
936         }
937 }
938 sub delete_all_config_colors {
939         my @file_lines = main::reader( $user_config_file );
940         open( $w_fh, '>', $user_config_file ) or error_handler('open', $user_config_file, $!);
941         foreach ( @file_lines ) { 
942                 if ( $_ !~ /^(CONSOLE_COLOR_SCHEME|GLOBAL_COLOR_SCHEME|IRC_COLOR_SCHEME|IRC_CONS_COLOR_SCHEME|IRC_X_TERM_COLOR_SCHEME|VIRT_TERM_COLOR_SCHEME)/){
943                         print {$w_fh} "$_"; 
944                 }
945         } 
946         close $w_fh;
947 }
948 sub set_config_color_scheme {
949         my $value = shift;
950         my @file_lines = main::reader( $user_config_file );
951         my $b_found = 0;
952         open( $w_fh, '>', $user_config_file ) or error_handler('open', $user_config_file, $!);
953         foreach ( @file_lines ) { 
954                 if ( $_ =~ /^$configs{'variable'}/ ){
955                         $_ = "$configs{'variable'}=$value";
956                         $b_found = 1;
957                 }
958                 print $w_fh "$_\n";
959         }
960         if (! $b_found ){
961                 print $w_fh "$configs{'variable'}=$value\n";
962         }
963         close $w_fh;
964 }
965
966 sub print_irc_message {
967         @data = (
968         [ 0, '', '', "$line1"],
969         [ 0, '', '', "After finding the scheme number you like, simply run this again
970         in a terminal to set the configuration data file for your irc client. You can 
971         set color schemes for the following: start inxi with -c plus:"],
972         [ 0, '', '', "94 (console,^not^in^desktop^-^$status{'console'})"],
973         [ 0, '', '', "95 (terminal, desktop^-^$status{'virt-term'})"],
974         [ 0, '', '', "96 (irc,^gui,^desktop^-^$status{'irc-gui'})"],
975         [ 0, '', '', "97 (irc,^desktop,^in terminal^-^$status{'irc-virt-term'})"],
976         [ 0, '', '', "98 (irc,^not^in^desktop^-^$status{'irc-console'})"],
977         [ 0, '', '', "99 (global^-^$status{'global'})"]
978         );
979         main::print_basic(@data); 
980         exit 1;
981 }
982
983 }
984
985 #### -------------------------------------------------------------------
986 #### CONFIGS
987 #### -------------------------------------------------------------------
988
989 sub check_config_file {
990         $user_config_file = "$user_config_dir/$self_name.conf";
991         if ( ! -f $user_config_file ){
992                 open( my $fh, '>', $user_config_file ) or error_handler('create', $user_config_file, $!);
993         }
994 }
995
996 sub get_configs {
997         my (@configs) = @_;
998         my ($key, $val,@config_files);
999         if (!@configs){
1000                 @config_files = (
1001                 qq(/etc/$self_name.conf), 
1002                 qq($user_config_dir/$self_name.conf)
1003                 );
1004         }
1005         else {
1006                 @config_files = (@configs);
1007         }
1008         # Config files should be passed in an array as a param to this function.
1009         # Default intended use: global @CONFIGS;
1010         foreach (@config_files) {
1011                 next unless open (my $fh, '<', "$_");
1012                 while (<$fh>) {
1013                         chomp;
1014                         s/#.*//;
1015                         s/^\s+//;
1016                         s/\s+$//;
1017                         s/'|"//g;
1018                         s/true/1/; # switch to 1/0 perl boolean
1019                         s/false/0/; # switch to 1/0 perl boolean
1020                         next unless length;
1021                         ($key, $val) = split(/\s*=\s*/, $_, 2);
1022                         get_config_item($key,$val);
1023                         # print "f: $file key: $key val: $val\n";
1024                 }
1025                 close $fh;
1026         }
1027 }
1028
1029 # args: 0: key; 1: value
1030 sub get_config_item {
1031         my ($key,$val) = @_;
1032         if ($key eq 'ALLOW_UPDATE' || $key eq 'B_ALLOW_UPDATE') {$b_update = int($val)}
1033         elsif ($key eq 'ALLOW_WEATHER' || $key eq 'B_ALLOW_WEATHER') {$b_weather = int($val)}
1034         elsif ($key eq 'CPU_SLEEP') {$cpu_sleep = $val if $val =~ /^[0-9\.]$/}
1035         elsif ($key eq 'DL_TIMEOUT') {$dl_timeout = int($val)}
1036         elsif ($key eq 'DOWNLOADER') {
1037                 if ($val =~ /^(curl|fetch|ftp|perl|wget)$/){
1038                         # this dumps all the other data and resets %dl for only the
1039                         # desired downloader.
1040                         $val = set_perl_downloader($val);
1041                         %dl = ('dl' => $val, $val => 1);
1042                 }}
1043         elsif ($key eq 'FILTER_STRING') {$filter_string = $val}
1044         elsif ($key eq 'LANGUAGE') {$language = $val if $val =~ /^(en)$/}
1045         elsif ($key eq 'LIMIT') {$limit = int($val)}
1046         elsif ($key eq 'OUTPUT_TYPE') {$output_type = $val if $val =~ /^json|screen|xml/}
1047         elsif ($key eq 'PS_COUNT') {$ps_count = int($val) }
1048         elsif ($key eq 'SENSORS_CPU_NO') {$sensors_cpu_nu = int($val)}
1049         elsif ($key eq 'SHOW_HOST' || $key eq 'B_SHOW_HOST') { $show{'host'} = int($val)}
1050         elsif ($key eq 'WEATHER_UNIT') { 
1051                 $val = lc($val) if $val;
1052                 if ($val && $val =~ /^(c|f|cf|fc|i|m|im|mi)$/){
1053                         my %units = ('c'=>'m','f'=>'i','cf'=>'mi','fc'=>'im');
1054                         $val = $units{$val} if defined $units{$val};
1055                         $weather_unit = $val;
1056                 }
1057         }
1058         # layout
1059         elsif ($key eq 'CONSOLE_COLOR_SCHEME') {$colors{'console'} = int($val)}
1060         elsif ($key eq 'GLOBAL_COLOR_SCHEME') {$colors{'global'} = int($val)}
1061         elsif ($key eq 'IRC_COLOR_SCHEME') {$colors{'irc-gui'} = int($val)}
1062         elsif ($key eq 'IRC_CONS_COLOR_SCHEME') {$colors{'irc-console'} = int($val)}
1063         elsif ($key eq 'IRC_X_TERM_COLOR_SCHEME') {$colors{'irc-virt-term'} = int($val)}
1064         elsif ($key eq 'VIRT_TERM_COLOR_SCHEME') {$colors{'virt-term'} = int($val)}
1065         # note: not using the old short SEP1/SEP2
1066         elsif ($key eq 'SEP1_IRC') {$sep{'s1-irc'} = $val}
1067         elsif ($key eq 'SEP1_CONSOLE') {$sep{'s1-console'} = $val}
1068         elsif ($key eq 'SEP[23]_IRC') {$sep{'s2-irc'} = $val}
1069         elsif ($key eq 'SEP[23]_CONSOLE') {$sep{'s2-console'} = $val}
1070         # size
1071         elsif ($key eq 'COLS_MAX_CONSOLE') {$size{'console'} = int($val)}
1072         elsif ($key eq 'COLS_MAX_IRC') {$size{'irc'} = int($val)}
1073         elsif ($key eq 'COLS_MAX_NO_DISPLAY') {$size{'no-display'} = int($val)}
1074         elsif ($key eq 'INDENT') {$size{'indent'} = int($val)}
1075         elsif ($key eq 'INDENT_MIN') {$size{'indent-min'} = int($val)}
1076         #  print "mc: key: $key val: $val\n";
1077         # print Dumper (keys %size) . "\n";
1078 }
1079
1080 #### -------------------------------------------------------------------
1081 #### DEBUGGERS
1082 #### -------------------------------------------------------------------
1083
1084 # called in the initial -@ 10 program args setting so we can get logging 
1085 # as soon as possible # will have max 3 files, inxi.log, inxi.1.log, 
1086 # inxi.2.log
1087 sub begin_logging {
1088         return 1 if $fh_l; # if we want to start logging for testing before options
1089         my $log_file_2="$user_data_dir/$self_name.1.log";
1090         my $log_file_3="$user_data_dir/$self_name.2.log";
1091         my $data = '';
1092         $end='main::log_data("fe", (caller(1))[3], "");';
1093         $start='main::log_data("fs", (caller(1))[3], \@_);';
1094         #$t3 = tv_interval ($t0, [gettimeofday]);
1095         $t3 = eval 'Time::HiRes::tv_interval (\@t0, [Time::HiRes::gettimeofday()]);' if $b_hires;
1096         #print Dumper $@;
1097         my $now = strftime "%Y-%m-%d %H:%M:%S", localtime;
1098         return if $b_debug_timers;
1099         # do the rotation if logfile exists
1100         if ( -f $log_file ){
1101                 # copy if present second to third
1102                 if ( -f $log_file_2 ){
1103                         rename $log_file_2, $log_file_3 or error_handler('rename', "$log_file_2 -> $log_file_3", "$!");
1104                 }
1105                 # then copy initial to second
1106                 rename $log_file, $log_file_2 or error_handler('rename', "$log_file -> $log_file_2", "$!");
1107         }
1108         # now create the logfile
1109         # print "Opening log file for reading: $log_file\n";
1110         open $fh_l, '>', $log_file or error_handler(4, $log_file, "$!");
1111         # and echo the start data
1112         $data = $line2;
1113         $data .= "START $self_name LOGGING:\n";
1114         $data .= "NOTE: HiRes timer not available.\n" if !$b_hires;
1115         $data .= "$now\n";
1116         $data .= "Elapsed since start: $t3\n";
1117         $data .= "n: $self_name v: $self_version p: $self_patch d: $self_date\n";
1118         $data .= '@paths:' . joiner(\@paths, '::', 'unset') . "\n";
1119         $data .= $line2;
1120         
1121         print $fh_l $data;
1122 }
1123
1124 # NOTE: no logging available until get_parameters is run, since that's what 
1125 # sets logging # in order to trigger earlier logging manually set $b_log
1126 # to true in top variables.
1127 # args: $1 - type [fs|fe|cat|dump|raw] OR data to log
1128 # arg: $2 - 
1129 # arg: $one type (fs/fe/cat/dump/raw) or logged data; 
1130 # [$two is function name; [$three - function args]]
1131 sub log_data {
1132         return if ! $b_log;
1133         my ($one, $two, $three) = @_;
1134         my ($args,$data,$timer) = ('','','');
1135         my $spacer = '   ';
1136         # print "1: $one 2: $two 3: $three\n";
1137         if ($one eq 'fs') {
1138                 if (ref $three eq 'ARRAY'){
1139                         my @temp = @$three;
1140                         # print Data::Dumper::Dumper \@$three;
1141                         $args = "\n${spacer}Args: " . joiner($three, '; ', 'unset');
1142                 }
1143                 else {
1144                         $args = "\n${spacer}Args: None";
1145                 }
1146                 # $t1 = [gettimeofday];
1147                 #$t3 = tv_interval ($t0, [gettimeofday]);
1148                 $t3 = eval 'Time::HiRes::tv_interval(\@t0, [Time::HiRes::gettimeofday()])' if $b_hires;
1149                 #print Dumper $@;
1150                 $data = "Start: Function: $two$args\n${spacer}Elapsed: $t3\n";
1151                 $spacer='';
1152                 $timer = $data if $b_debug_timers;
1153         }
1154         elsif ( $one eq 'fe') {
1155                 # print 'timer:', Time::HiRes::tv_interval(\@t0, [Time::HiRes::gettimeofday()]),"\n";
1156                 #$t3 = tv_interval ($t0, [gettimeofday]);
1157                 eval '$t3 = Time::HiRes::tv_interval(\@t0, [Time::HiRes::gettimeofday()])' if $b_hires;
1158                 #print Dumper $t3;
1159                 $data = "${spacer}Elapsed: $t3\nEnd: Function: $two\n";
1160                 $spacer='';
1161                 $timer = $data if $b_debug_timers;
1162         }
1163         elsif ( $one eq 'cat') {
1164                 if ( $b_log_full ){
1165                         for my $file ($two){
1166                                 my $contents = do { local( @ARGV, $/ ) = $file; <> }; # or: qx(cat $file)
1167                                 $data = "$data${line3}Full file data: $file\n\n$contents\n$line3\n";
1168                         }
1169                         $spacer='';
1170                 }
1171         }
1172         elsif ($one eq 'cmd'){
1173                 $data = "Command: $two\n";
1174                 $data .= qx($two);
1175         }
1176         elsif ($one eq 'data'){
1177                 $data = "$two\n";
1178         }
1179         elsif ( $one eq 'dump') {
1180                 $data = "$two:\n";
1181                 if (ref $three eq 'HASH'){
1182                         $data .= Data::Dumper::Dumper \%$three;
1183                 }
1184                 elsif (ref $three eq 'ARRAY'){
1185                         # print Data::Dumper::Dumper \@$three;
1186                         $data .= Data::Dumper::Dumper \@$three;
1187                 }
1188                 else {
1189                         $data .= Data::Dumper::Dumper $three;
1190                 }
1191                 $data .= "\n";
1192                 # print $data;
1193         }
1194         elsif ( $one eq 'raw') {
1195                 if ( $b_log_full ){
1196                         $data = "\n${line3}Raw System Data:\n\n$two\n$line3";
1197                         $spacer='';
1198                 }
1199         }
1200         else {
1201                 $data = "$two\n";
1202         }
1203         if ($b_debug_timers){
1204                 print $timer if $timer;
1205         }
1206         #print "d: $data";
1207         elsif ($data){
1208                 print $fh_l "$spacer$data";
1209         }
1210 }
1211
1212 sub set_debugger {
1213         if ( $debug >= 20){
1214                 error_handler('not-in-irc', 'debug data generator') if $b_irc;
1215                 my $option = ( $debug > 22 ) ? 'main-full' : 'main';
1216                 $b_debug_gz = 1 if ($debug == 22 || $debug == 24);
1217                 my $ob_sys = SystemDebugger->new($option);
1218                 $ob_sys->run_debugger();
1219                 $ob_sys->upload_file($ftp_alt) if $debug > 20;
1220                 exit 0;
1221         }
1222         elsif ($debug >= 10 && $debug <= 12){
1223                 $b_log = 1;
1224                 if ($debug == 11){
1225                         $b_log_full = 1;
1226                 }
1227                 elsif ($debug == 12){
1228                         $b_log_colors = 1;
1229                 }
1230                 begin_logging();
1231         }
1232         elsif ($debug <= 3){
1233                 if ($debug == 3){
1234                         $b_log = 1;
1235                         $b_debug_timers = 1;
1236                         begin_logging();
1237                 }
1238                 else {
1239                         $end = '';
1240                         $start = '';
1241                 }
1242         }
1243 }
1244
1245 ## SystemDebugger
1246 {
1247 package SystemDebugger;
1248
1249 # use File::Find q(find);
1250 #no warnings 'File::Find';
1251 # use File::Spec::Functions;
1252 #use File::Copy;
1253 #use POSIX qw(strftime);
1254
1255 my $option = 'main';
1256 my ($data_dir,$debug_dir,$debug_gz,$parse_src,$upload) = ('','','','','');
1257 my @content = (); 
1258 my $b_debug = 0;
1259 my $b_delete_dir = 1;
1260 # args: 1 - type
1261 # args: 2 - upload
1262 sub new {
1263         my $class = shift;
1264         ($option) = @_;
1265         my $self = {};
1266         # print "$f\n";
1267         # print "$option\n";
1268         return bless $self, $class;
1269 }
1270
1271 sub run_debugger {
1272         require File::Copy;
1273         import File::Copy;
1274         require File::Spec::Functions;
1275         import File::Spec::Functions;
1276         
1277         print "Starting $self_name debugging data collector...\n";
1278         create_debug_directory();
1279         print "Note: for dmidecode data you must be root.\n" if !$b_root;
1280         print $line3;
1281         if (!$b_debug){
1282                 audio_data();
1283                 disk_data();
1284                 display_data();
1285                 network_data();
1286                 perl_modules();
1287                 system_data();
1288         }
1289         system_files();
1290         print $line3;
1291         if (!$b_debug){
1292                 if ( -d '/sys' && main::count_dir_files('/sys') ){
1293                         build_tree('sys');
1294                         sys_traverse_data();
1295                 }
1296                 else {
1297                         print "Skipping /sys data collection. /sys not present, or empty.\n";
1298                 }
1299                 print $line3;
1300                 # note: proc has some files that are apparently kernel processes, I've tried 
1301                 # filtering them out but more keep appearing, so only run proc debugger if not root
1302                 if ( (!$b_root || $b_proc_debug ) && -d '/proc' && main::count_dir_files('/proc') ){
1303                         build_tree('proc');
1304                         proc_traverse_data();
1305                 }
1306                 else {
1307                         print "Skipping /proc data collection. /proc not present, or empty.\n";
1308                 }
1309                 print $line3;
1310         }
1311         run_self();
1312         print $line3;
1313         compress_dir();
1314 }
1315
1316 sub create_debug_directory {
1317         my $host = main::get_hostname();
1318         $host =~ s/ /-/g;
1319         $host = 'no-host' if !$host || $host eq 'N/A';
1320         my ($alt_string,$bsd_string,$root_string) = ('','','');
1321         # note: Time::Piece was introduced in perl 5.9.5
1322         my ($sec,$min,$hour,$mday,$mon,$year) = localtime;
1323         $year = $year+1900;
1324         $mon += 1;
1325         if (length($sec)  == 1) {$sec = "0$sec";}
1326         if (length($min)  == 1) {$min = "0$min";}
1327         if (length($hour) == 1) {$hour = "0$hour";}
1328         if (length($mon)  == 1) {$mon = "0$mon";}
1329         if (length($mday) == 1) {$mday = "0$mday";}
1330         
1331         my $today = "$year-$mon-${mday}_$hour$min$sec";
1332         # my $date = strftime "-%Y-%m-%d_", localtime;
1333         if ($b_root){
1334                 $root_string = '-root';
1335         }
1336         $bsd_string = "-BSD-$bsd_type" if $bsd_type;
1337         if ($b_arm ){$alt_string = '-ARM'}
1338         elsif ($b_mips) {$alt_string = '-MIPS'}
1339         $debug_dir = "$self_name$alt_string$bsd_string-$host-$today$root_string-$self_version";
1340         $debug_gz = "$debug_dir.tar.gz";
1341         $data_dir = "$user_data_dir/$debug_dir";
1342         if ( -d $data_dir ){
1343                 unlink $data_dir or main::error_handler('remove', "$data_dir", "$!");
1344         }
1345         mkdir $data_dir or main::error_handler('mkdir', "$data_dir", "$!");
1346         if ( -e "$user_data_dir/$debug_gz" ){
1347                 #rmdir "$user_data_dir$debug_gz" or main::error_handler('remove', "$user_data_dir/$debug_gz", "$!");
1348                 print "Failed removing leftover directory:\n$user_data_dir$debug_gz error: $?" if system('rm','-rf',"$user_data_dir$debug_gz");
1349         }
1350         print "Data going into:\n$data_dir\n";
1351 }
1352 sub compress_dir {
1353         print "Creating tar.gz compressed file of this material...\n";
1354         print "File: $debug_gz\n";
1355         system("cd $user_data_dir; tar -czf $debug_gz $debug_dir");
1356         print "Removing $data_dir...\n";
1357         #rmdir $data_dir or print "failed removing: $data_dir error: $!\n";
1358         return 1 if !$b_delete_dir;
1359         if (system('rm','-rf',$data_dir) ){
1360                 print "Failed removing: $data_dir\nError: $?\n";
1361         }
1362         else {
1363                 print "Directory removed.\n";
1364         }
1365 }
1366 # NOTE: incomplete, don't know how to ever find out 
1367 # what sound server is actually running, and is in control
1368 sub audio_data {
1369         my (%data,@files,@files2);
1370         print "Collecting audio data...\n";
1371         my @cmds = (
1372         ['aplay', '-l'], # alsa
1373         ['pactl', 'list'], # pulseaudio
1374         );
1375         run_commands(\@cmds,'audio');
1376         @files = main::globber('/proc/asound/card*/codec*');
1377         if (@files){
1378                 my $asound = qx(head -n 1 /proc/asound/card*/codec* 2>&1);
1379                 $data{'proc-asound-codecs'} = $asound;
1380         }
1381         else {
1382                 $data{'proc-asound-codecs'} = undef;
1383         }
1384         
1385         write_data(\%data,'audio');
1386         @files = (
1387         '/proc/asound/cards',
1388         '/proc/asound/version',
1389         );
1390         @files2 = main::globber('/proc/asound/*/usbid');
1391         @files = (@files,@files2) if @files2;
1392         copy_files(\@files,'audio');
1393 }
1394 ## NOTE: >/dev/null 2>&1 is sh, and &>/dev/null is bash, fix this
1395 # ls -w 1 /sysrs > tester 2>&1
1396 sub disk_data {
1397         my (%data,@files,@files2);
1398         print "Collecting dev, label, disk, uuid data, df...\n";
1399         @files = (
1400         '/etc/fstab',
1401         '/etc/mtab',
1402         '/proc/mdstat',
1403         '/proc/mounts',
1404         '/proc/partitions',
1405         '/proc/scsi/scsi',
1406         '/proc/sys/dev/cdrom/info',
1407         );
1408         # very old systems
1409         if (-d '/proc/ide/'){
1410                 my @ides = main::globber('/proc/ide/*/*');
1411                 @files = (@files, @ides) if @ides;
1412         }
1413         else {
1414                 push (@files, '/proc-ide-directory');
1415         }
1416         copy_files(\@files, 'disk');
1417         my @cmds = (
1418         ['btrfs', 'filesystem show'],
1419         ['btrfs', 'filesystem show --mounted'],
1420         # ['btrfs', 'filesystem show --all-devices'],
1421         ['df', '-h -T'],
1422         ['df', '-h'],
1423         ['df', '-k'],
1424         ['df', '-k -T'],
1425         ['df', '-k -T -P'],
1426         ['df', '-P'],
1427         ['lsblk', '-fs'],
1428         ['lsblk', '-fsr'],
1429         ['lsblk', '-fsP'],
1430         ['lsblk', '-a'],
1431         ['lsblk', '-aP'],
1432         ['lsblk', '-ar'],
1433         ['lsblk', '-p'],
1434         ['lsblk', '-pr'],
1435         ['lsblk', '-pP'],
1436         ['lsblk', '-r'],
1437         ['lsblk', '-r --output NAME,PKNAME,TYPE,RM,FSTYPE,SIZE,LABEL,UUID,MOUNTPOINT'],
1438         ['lsblk', '-rb --output NAME,PKNAME,TYPE,RM,FSTYPE,SIZE,LABEL,UUID,MOUNTPOINT'],
1439         ['lsblk', '-Pb --output NAME,PKNAME,TYPE,RM,FSTYPE,SIZE'],
1440         ['lsblk', '-Pb --output NAME,TYPE,RM,FSTYPE,SIZE,LABEL,UUID,SERIAL,MOUNTPOINT'],
1441         ['gpart', 'list'],
1442         ['gpart', 'show'],
1443         ['gpart', 'status'],
1444         ['ls', '-l /dev'],
1445         ['ls', '-l /dev/disk'],
1446         ['ls', '-l /dev/disk/by-id'],
1447         ['ls', '-l /dev/disk/by-label'],
1448         ['ls', '-l /dev/disk/by-uuid'],
1449         # http://comments.gmane.org/gmane.linux.file-systems.zfs.user/2032
1450         ['ls', '-l /dev/disk/by-wwn'],
1451         ['ls', '-l /dev/disk/by-path'],
1452         ['ls', '-l /dev/mapper'],
1453         # LSI raid https://hwraid.le-vert.net/wiki/LSIMegaRAIDSAS
1454         ['megacli', '-AdpAllInfo -aAll'],
1455         ['megacli', '-LDInfo -L0 -a0'],
1456         ['megacli', '-PDList -a0'],
1457         ['megaclisas-status', ''],
1458         ['megaraidsas-status', ''],
1459         ['megasasctl', ''],
1460         ['mount', ''],
1461         ['nvme', 'present'],
1462         ['readlink', '/dev/root'],
1463         ['swapon', '-s'],
1464         # 3ware-raid
1465         ['tw-cli', 'info'],
1466         ['zfs', 'list'],
1467         ['zpool', 'list'],
1468         ['zpool', 'list -v'],
1469         );
1470         run_commands(\@cmds,'disk');
1471         @cmds = (
1472         ['atacontrol', 'list'],
1473         ['camcontrol', 'devlist'], 
1474         ['glabel', 'status'], 
1475         ['swapctl', '-l -k'],
1476         ['swapctl', '-l -k'],
1477         ['vmstat', '-H'],
1478         );
1479         run_commands(\@cmds,'disk-bsd');
1480 }
1481 sub display_data {
1482         my (%data,@files,@files2);
1483         my $working = '';
1484         if ( ! $b_display ){
1485                 print "Warning: only some of the data collection can occur if you are not in X\n";
1486                 main::toucher("$data_dir/display-data-warning-user-not-in-x");
1487         }
1488         if ( $b_root ){
1489                 print "Warning: only some of the data collection can occur if you are running as Root user\n";
1490                 main::toucher("$data_dir/display-data-warning-root-user");
1491         }
1492         print "Collecting Xorg log and xorg.conf files...\n";
1493         if ( -d "/etc/X11/xorg.conf.d/" ){
1494                 @files = main::globber("/etc/X11/xorg.conf.d/*");
1495         }
1496         else {
1497                 @files = ('/xorg-conf-d');
1498         }
1499         push (@files, $files{'xorg-log'});
1500         push (@files, '/etc/X11/xorg.conf');
1501         copy_files(\@files,'display-xorg');
1502         print "Collecting X, xprop, glxinfo, xrandr, xdpyinfo data, wayland, weston...\n";
1503         %data = (
1504         'desktop-session' => $ENV{'DESKTOP_SESSION'},
1505         'gdmsession' => $ENV{'GDMSESSION'},
1506         'gnome-desktop-session-id' => $ENV{'GNOME_DESKTOP_SESSION_ID'},
1507         'kde-full-session' => $ENV{'KDE_FULL_SESSION'},
1508         'kde-session-version' => $ENV{'KDE_SESSION_VERSION'},
1509         'vdpau-driver' => $ENV{'VDPAU_DRIVER'},
1510         'xdg-current-desktop' => $ENV{'XDG_CURRENT_DESKTOP'},
1511         'xdg-session-desktop' => $ENV{'XDG_SESSION_DESKTOP'},
1512         'xdg-vtnr' => $ENV{'XDG_VTNR'},
1513         # wayland data collectors:
1514         'xdg-session-type' => $ENV{'XDG_SESSION_TYPE'},
1515         'wayland-display' =>  $ENV{'WAYLAND_DISPLAY'},
1516         'gdk-backend' => $ENV{'GDK_BACKEND'},
1517         'qt-qpa-platform' => $ENV{'QT_QPA_PLATFORM'},
1518         'clutter-backend' => $ENV{'CLUTTER_BACKEND'},
1519         'sdl-videodriver' => $ENV{'SDL_VIDEODRIVER'},
1520         # program display values
1521         'size-indent' => $size{'indent'},
1522         'size-indent-min' => $size{'indent-min'},
1523         'size-cols-max' => $size{'max'},
1524         );
1525         write_data(\%data,'display');
1526         my @cmds = (
1527         # kde 5/plasma desktop 5, this is maybe an extra package and won't be used
1528         ['about-distro',''],
1529         ['aticonfig','--adapter=all --od-gettemperature'],
1530         ['glxinfo',''],
1531         ['glxinfo','-B'],
1532         ['kded','--version'],
1533         ['kded1','--version'],
1534         ['kded2','--version'],
1535         ['kded3','--version'],
1536         ['kded4','--version'],
1537         ['kded5','--version'],
1538         ['kded6','--version'],
1539         ['kf4-config','--version'],
1540         ['kf5-config','--version'],
1541         ['kf6-config','--version'],
1542         ['kwin_x11','--version'],
1543         ['loginctl','--no-pager list-sessions'],
1544         ['nvidia-settings','-q screens'],
1545         ['nvidia-settings','-c :0.0 -q all'],
1546         ['nvidia-smi','-q'],
1547         ['nvidia-smi','-q -x'],
1548         ['plasmashell','--version'],
1549         ['vainfo',''],
1550         ['vdpauinfo',''],
1551         ['weston-info',''], 
1552         ['wmctrl','-m'],
1553         ['weston','--version'],
1554         ['xdpyinfo',''],
1555         ['Xorg','-version'],
1556         ['xprop','-root'],
1557         ['xrandr',''],
1558         );
1559         run_commands(\@cmds,'display');
1560 }
1561 sub network_data {
1562         print "Collecting networking data...\n";
1563 #       no warnings 'uninitialized';
1564         my @cmds = (
1565         ['ifconfig',''],
1566         ['ip','addr'],
1567         ['ip','-s link'],
1568         );
1569         run_commands(\@cmds,'network');
1570 }
1571 sub perl_modules {
1572         print "Collecting Perl module data (this can take a while)...\n";
1573         my @modules = ();
1574         my ($dirname,$holder,$mods,$value) = ('','','','');
1575         my $filename = 'perl-modules.txt';
1576         my @inc;
1577         foreach (sort @INC){
1578                 # some BSD installs have '.' n @INC path
1579                 if (-d $_ && $_ ne '.'){
1580                         $_ =~ s/\/$//; # just in case, trim off trailing slash
1581                         $value .= "EXISTS: $_\n";
1582                         push @inc, $_;
1583                 } 
1584                 else {
1585                         $value .= "ABSENT: $_\n";
1586                 }
1587         }
1588         main::writer("$data_dir/perl-inc-data.txt",$value);
1589         File::Find::find { wanted => sub { 
1590                 push @modules, File::Spec->canonpath($_) if /\.pm\z/  
1591         }, no_chdir => 1 }, @inc;
1592         @modules = sort(@modules);
1593         foreach (@modules){
1594                 my $dir = $_;
1595                 $dir =~ s/[^\/]+$//;
1596                 if (!$holder || $holder ne $dir ){
1597                         $holder = $dir;
1598                         $value = "DIR: $dir\n";
1599                         $_ =~ s/^$dir//;
1600                         $value .= " $_\n";
1601                 }
1602                 else {
1603                         $value = $_;
1604                         $value =~ s/^$dir//;
1605                         $value = " $value\n";
1606                 }
1607                 $mods .= $value;
1608         }
1609         open (my $fh, '>', "$data_dir/$filename");
1610         print $fh $mods;
1611         close $fh;
1612 }
1613 sub system_data {
1614         print "Collecting system data...\n";
1615         my %data = (
1616         'cc' => $ENV{'CC'},
1617         # @(#)MIRBSD KSH R56 2018/03/09: ksh and mksh
1618         'ksh-version' => system('echo -n $KSH_VERSION'), # shell, not env, variable
1619         'manpath' => $ENV{'MANPATH'},
1620         'path' => $ENV{'PATH'},
1621         'xdg-config-home' => $ENV{'XDG_CONFIG_HOME'},
1622         'xdg-config-dirs' => $ENV{'XDG_CONFIG_DIRS'},
1623         'xdg-data-home' => $ENV{'XDG_DATA_HOME'},
1624         'xdg-data-dirs' => $ENV{'XDG_DATA_DIRS'},
1625         );
1626         my @files = main::globber('/usr/bin/gcc*');
1627         if (@files){
1628                 $data{'gcc-versions'} = join "\n",@files;
1629         }
1630         else {
1631                 $data{'gcc-versions'} = undef;
1632         }
1633         @files = main::globber('/sys/*');
1634         if (@files){
1635                 $data{'sys-tree-ls-1-basic'} = join "\n", @files;
1636         }
1637         else {
1638                 $data{'sys-tree-ls-1-basic'} = undef;
1639         }
1640         write_data(\%data,'system');
1641         # bsd tools http://cb.vu/unixtoolbox.xhtml
1642         my @cmds = (
1643         # general
1644         ['sysctl', '-b kern.geom.conftxt'],
1645         ['sysctl', '-b kern.geom.confxml'],
1646         ['usbdevs','-v'],
1647         # freebsd
1648         ['pciconf','-l -cv'],
1649         ['pciconf','-vl'],
1650         ['pciconf','-l'],
1651         # openbsd
1652         ['pcidump',''],
1653         ['pcidump','-v'],
1654         # netbsd
1655         ['kldstat',''],
1656         ['pcictl','list'],
1657         ['pcictl','list -ns'],
1658         );
1659         run_commands(\@cmds,'system-bsd');
1660         # diskinfo -v <disk>
1661         # fdisk <disk>
1662         @cmds = (
1663         ['clang','--version'],
1664         ['dmidecode',''],
1665         ['dmesg',''],
1666         ['gcc','--version'],
1667         ['hciconfig','-a'],
1668         ['initctl','list'],
1669         ['ipmi-sensors',''],
1670         ['ipmi-sensors','--output-sensor-thresholds'],
1671         ['ipmitool','sensor'],
1672         ['lscpu',''],
1673         ['lspci',''],
1674         ['lspci','-k'],
1675         ['lspci','-n'],
1676         ['lspci','-nn'],
1677         ['lspci','-nnk'],
1678         ['lspci','-nnkv'],# returns ports
1679         ['lspci','-nnv'],
1680         ['lspci','-mm'],
1681         ['lspci','-mmk'],
1682         ['lspci','-mmkv'],
1683         ['lspci','-mmv'],
1684         ['lspci','-mmnn'],
1685         ['lspci','-v'],
1686         ['lsusb',''],
1687         ['lsusb','-v'],
1688         ['ps','aux'],
1689         ['ps','-e'],
1690         ['ps','-p 1'],
1691         ['runlevel',''],
1692         ['rc-status','-a'],
1693         ['rc-status','-l'],
1694         ['rc-status','-r'],
1695         ['sensors',''],
1696         # leaving this commented out to remind that some systems do not
1697         # support strings --version, but will just simply hang at that command
1698         # which you can duplicate by simply typing: strings then hitting enter.
1699         # ['strings','--version'],
1700         ['strings','present'],
1701         ['sysctl','-a'],
1702         ['systemctl','list-units'],
1703         ['systemctl','list-units --type=target'],
1704         ['systemd-detect-virt',''],
1705         ['upower','-e'],
1706         ['uptime',''],
1707         ['vcgencmd','get_mem arm'],
1708         ['vcgencmd','get_mem gpu'],
1709         );
1710         run_commands(\@cmds,'system');
1711         @files = main::globber('/dev/bus/usb/*/*');
1712         copy_files(\@files, 'system');
1713 }
1714 sub system_files {
1715         print "Collecting system files data...\n";
1716         my (%data,@files,@files2);
1717         @files = RepoData::get($data_dir);
1718         copy_files(\@files, 'repo');
1719         # chdir "/etc";
1720         @files = main::globber('/etc/*[-_]{[rR]elease,[vV]ersion,issue}*');
1721         push (@files, '/etc/issue');
1722         push (@files, '/etc/lsb-release');
1723         push (@files, '/etc/os-release');
1724         copy_files(\@files,'system-distro');
1725         @files = main::globber('/etc/upstream[-_]{[rR]elease,[vV]ersion}/*');
1726         copy_files(\@files,'system-distro');
1727         @files = (
1728         '/proc/1/comm',
1729         '/proc/cpuinfo',
1730         '/proc/meminfo',
1731         '/proc/modules',
1732         '/proc/net/arp',
1733         '/proc/version',
1734         );
1735         @files2=main::globber('/sys/class/power_supply/*/uevent');
1736         if (@files2){
1737                 @files = (@files,@files2);
1738         }
1739         else {
1740                 push (@files, '/sys-class-power-supply-empty');
1741         }
1742         copy_files(\@files, 'system');
1743         @files = (
1744         '/etc/make.conf',
1745         '/etc/src.conf',
1746         '/var/run/dmesg.boot',
1747         );
1748         copy_files(\@files,'system-bsd');
1749 }
1750 ## SELF EXECUTE FOR LOG/OUTPUT
1751 sub run_self {
1752         print "Creating $self_name output file now. This can take a few seconds...\n";
1753         print "Starting $self_name from: $self_path\n";
1754         my $i = ($option eq 'main-full')? ' -i' : '';
1755         my $cmd = "$self_path/$self_name -FRfrploudmxxx$i -c 0 --usb --slots --debug 10 -y 120 > $data_dir/$self_name-FRfrploudmxxxyusbslots120.txt 2>&1";
1756         system($cmd);
1757         copy($log_file, "$data_dir") or main::error_handler('copy-failed', "$log_file", "$!");
1758         system("$self_path/$self_name --recommends -y 120 > $data_dir/$self_name-recommends-120.txt 2>&1");
1759 }
1760
1761 ## UTILITIES COPY/CMD/WRITE
1762 sub copy_files {
1763         my ($files_ref,$type,$alt_dir) = @_;
1764         my ($absent,$error,$good,$name,$unreadable);
1765         my $directory = ($alt_dir) ? $alt_dir : $data_dir;
1766         my $working = ($type ne 'proc') ? "$type-file-": '';
1767         foreach (@$files_ref) {
1768                 $name = $_;
1769                 $name =~ s/^\///;
1770                 $name =~ s/\//~/g;
1771                 # print "$name\n" if $type eq 'proc';
1772                 $name = "$directory/$working$name";
1773                 $good = $name . '.txt';
1774                 $absent = $name . '-absent';
1775                 $error = $name . '-error';
1776                 $unreadable = $name . '-unreadable';
1777                 # proc have already been tested for readable/exists
1778                 if ($type eq 'proc' || -e $_ ) {
1779                         if ($type eq 'proc' || -r $_){
1780                                 copy($_,"$good") or main::toucher($error);
1781                         }
1782                         else {
1783                                 main::toucher($unreadable);
1784                         }
1785                 }
1786                 else {
1787                         main::toucher($absent);
1788                 }
1789         }
1790 }
1791 sub run_commands {
1792         my ($cmds,$type) = @_;
1793         my $holder = '';
1794         my ($name,$cmd,$args);
1795         foreach (@$cmds){
1796                 my @rows = @$_;
1797                 if (my $program = main::check_program($rows[0])){
1798                         if ($rows[1] eq 'present'){
1799                                 $name = "$data_dir/$type-cmd-$rows[0]-present";
1800                                 main::toucher($name);
1801                         }
1802                         else {
1803                                 $args = $rows[1];
1804                                 $args =~ s/\s|--|\/|=/-/g; # for:
1805                                 $args =~ s/--/-/g;# strip out -- that result from the above
1806                                 $args =~ s/^-//g;
1807                                 $args = "-$args" if $args;
1808                                 $name = "$data_dir/$type-cmd-$rows[0]$args.txt";
1809                                 $cmd = "$program $rows[1] >$name 2>&1";
1810                                 system($cmd);
1811                         }
1812                 }
1813                 else {
1814                         if ($holder ne $rows[0]){
1815                                 $name = "$data_dir/$type-cmd-$rows[0]-absent";
1816                                 main::toucher($name);
1817                                 $holder = $rows[0];
1818                         }
1819                 }
1820         }
1821 }
1822 sub write_data {
1823         my ($data_ref, $type) = @_;
1824         my ($empty,$error,$fh,$good,$name,$undefined,$value);
1825         foreach (keys %$data_ref) {
1826                 $value = $$data_ref{$_};
1827                 $name = "$data_dir/$type-data-$_";
1828                 $good = $name . '.txt';
1829                 $empty = $name . '-empty';
1830                 $error = $name . '-error';
1831                 $undefined = $name . '-undefined';
1832                 if (defined $value) {
1833                         if ($value || $value eq '0'){
1834                                 open($fh, '>', $good) or main::toucher($error);
1835                                 print $fh "$value";
1836                         }
1837                         else {
1838                                 main::toucher($empty);
1839                         }
1840                 }
1841                 else {
1842                         main::toucher($undefined);
1843                 }
1844         }
1845 }
1846 ## TOOLS FOR DIRECTORY TREE/LS/TRAVERSE; UPLOADER
1847 sub build_tree {
1848         my ($which) = @_;
1849         if ( $which eq 'sys' && main::check_program('tree') ){
1850                 print "Constructing /$which tree data...\n";
1851                 my $dirname = '/sys';
1852                 my $cmd;
1853                 system("tree -a -L 10 /sys > $data_dir/sys-data-tree-full-10.txt");
1854                 opendir my($dh), $dirname or main::error_handler('open-dir',"$dirname", "$!");
1855                 my @files = readdir $dh;
1856                 closedir $dh;
1857                 foreach (@files){
1858                         next if /^\./;
1859                         $cmd = "tree -a -L 10 $dirname/$_ > $data_dir/sys-data-tree-$_-10.txt";
1860                         #print "$cmd\n";
1861                         system($cmd);
1862                 }
1863         }
1864         print "Constructing /$which ls data...\n";
1865         if ($which eq 'sys'){
1866                 directory_ls($which,1);
1867                 directory_ls($which,2);
1868                 directory_ls($which,3);
1869                 directory_ls($which,4);
1870         }
1871         elsif ($which eq 'proc') {
1872                 directory_ls('proc',1);
1873                 directory_ls('proc',2,'[a-z]');
1874                 # don't want the /proc/self or /proc/thread-self directories, those are 
1875                 # too invasive
1876                 #directory_ls('proc',3,'[a-z]');
1877                 #directory_ls('proc',4,'[a-z]');
1878         }
1879 }
1880
1881 # include is basic regex for ls path syntax, like [a-z]
1882 sub directory_ls {
1883         my ( $dir,$depth,$include) = @_;
1884         $include ||= '';
1885         my ($exclude) = ('');
1886         # wd do NOT want to see anything in self or thread-self!!
1887         # $exclude = 'I self -I thread-self' if $dir eq 'proc';
1888         my $cmd = do {
1889                 if ( $depth == 1 ){ "ls -l $exclude /$dir/$include 2>/dev/null" }
1890                 elsif ( $depth == 2 ){ "ls -l $exclude /$dir/$include*/ 2>/dev/null" }
1891                 elsif ( $depth == 3 ){ "ls -l $exclude /$dir/$include*/*/ 2>/dev/null" }
1892                 elsif ( $depth == 4 ){ "ls -l $exclude /$dir/$include*/*/*/ 2>/dev/null" }
1893                 elsif ( $depth == 5 ){ "ls -l $exclude /$dir/$include*/*/*/*/ 2>/dev/null" }
1894                 elsif ( $depth == 5 ){ "ls -l $exclude /$dir/$include*/*/*/*/ 2>/dev/null" }
1895         };
1896         my @working = ();
1897         my $output = '';
1898         my ($type);
1899         my $result = qx($cmd);
1900         open my $ch, '<', \$result or main::error_handler('open-data',"$cmd", "$!");
1901         while ( my $line = <$ch> ){
1902                 chomp($line);
1903                 $line =~ s/^\s+|\s+$//g;
1904                 @working = split /\s+/, $line;
1905                 $working[0] ||= '';
1906                 if ( scalar @working > 7 ){
1907                         if ($working[0] =~ /^d/ ){
1908                                 $type = "d - ";
1909                         }
1910                         elsif ($working[0] =~ /^l/){
1911                                 $type = "l - ";
1912                         }
1913                         else {
1914                                 $type = "f - ";
1915                         }
1916                         $working[9] ||= '';
1917                         $working[10] ||= '';
1918                         $output = $output . "  $type$working[8] $working[9] $working[10]\n";
1919                 }
1920                 elsif ( $working[0] !~ /^total/ ){
1921                         $output = $output . $line . "\n";
1922                 }
1923         }
1924         close $ch;
1925         my $file = "$data_dir/$dir-data-ls-$depth.txt";
1926         open my $fh, '>', $file or main::error_handler('create',"$file", "$!");
1927         print $fh $output;
1928         close $fh;
1929         # print "$output\n";
1930 }
1931 sub proc_traverse_data {
1932         print "Building /proc file list...\n";
1933         # get rid pointless error:Can't cd to (/sys/kernel/) debug: Permission denied
1934         no warnings 'File::Find';
1935         $parse_src = 'proc';
1936         File::Find::find( \&wanted, "/proc");
1937         proc_traverse_processor();
1938         @content = ();
1939 }
1940 sub proc_traverse_processor {
1941         my ($data,$fh,$result,$row,$sep);
1942         my $proc_dir = "$data_dir/proc";
1943         print "Adding /proc files...\n";
1944         mkdir $proc_dir or main::error_handler('mkdir', "$proc_dir", "$!");
1945         # @content = sort @content; 
1946         copy_files(\@content,'proc',$proc_dir);
1947 #       foreach (@content){
1948 #               print "$_\n";
1949 #       }
1950 }
1951
1952 sub sys_traverse_data {
1953         print "Building /sys file list...\n";
1954         # get rid pointless error:Can't cd to (/sys/kernel/) debug: Permission denied
1955         no warnings 'File::Find';
1956         $parse_src = 'sys';
1957         File::Find::find( \&wanted, "/sys");
1958         sys_traverse_processsor();
1959         @content = ();
1960 }
1961 sub sys_traverse_processsor {
1962         my ($data,$fh,$result,$row,$sep);
1963         my $filename = "sys-data-parse.txt";
1964         print "Parsing /sys files...\n";
1965         # no sorts, we want the order it comes in
1966         # @content = sort @content; 
1967         foreach (@content){
1968                 $data='';
1969                 $sep='';
1970                 my $b_fh = 1;
1971                 open($fh, '<', $_) or $b_fh = 0;
1972                 # needed for removing -T test and root
1973                 if ($b_fh){
1974                         while ($row = <$fh>) {
1975                                 chomp $row;
1976                                 $data .= $sep . '"' . $row . '"';
1977                                 $sep=', ';
1978                         }
1979                 }
1980                 else {
1981                         $data = '<unreadable>';
1982                 }
1983                 $result .= "$_:[$data]\n";
1984                 # print "$_:[$data]\n"
1985         }
1986         # print scalar @content . "\n";
1987         open ($fh, '>', "$data_dir/$filename");
1988         print $fh $result;
1989         close $fh;
1990         # print $fh "$result";
1991 }
1992 sub wanted {
1993         return if -d; # not directory
1994         return unless -e; # Must exist
1995         return unless -f; # Must be file
1996         return unless -r; # Must be readable
1997         if ($parse_src eq 'sys'){
1998                 # note: a new file in 4.11 /sys can hang this, it is /parameter/ then
1999                 # a few variables. Since inxi does not need to see that file, we will
2000                 # not use it. Also do not need . files or __ starting files
2001                 # print $File::Find::name . "\n";
2002                 # block maybe: cfgroup\/
2003                 return if $File::Find::name =~ /\/(\.[a-z]|kernel\/|parameters\/|debug\/)/;
2004                 # comment this one out if you experience hangs or if 
2005                 # we discover syntax of foreign language characters
2006                 # Must be ascii like. This is questionable and might require further
2007                 # investigation, it is removing some characters that we might want
2008                 # NOTE: this made a bunch of files on arm systems unreadable so we handle 
2009                 # the readable tests in copy_files()
2010                 # return unless -T; 
2011         }
2012         elsif ($parse_src eq 'proc') {
2013                 return if $File::Find::name =~ /^\/proc\/[0-9]+\//;
2014                 return if $File::Find::name =~ /^\/proc\/bus\/pci\//;
2015                 return if $File::Find::name =~ /^\/proc\/(irq|spl|sys)\//;
2016                 # these choke on sudo/root: kmsg kcore kpage and we don't want keys or kallsyms
2017                 return if $File::Find::name =~ /^\/proc\/k/; 
2018                 return if $File::Find::name =~ /(\/mb_groups|debug)$/;
2019         }
2020         # print $File::Find::name . "\n";
2021         push (@content, $File::Find::name);
2022         return;
2023 }
2024 # args: 1 - path to file to be uploaded
2025 # args: 2 - optional: alternate ftp upload url
2026 # NOTE: must be in format: ftp.site.com/incoming
2027 sub upload_file {
2028         require Net::FTP;
2029         import Net::FTP;
2030         my ($self, $ftp_url) = @_;
2031         my ($ftp, $domain, $host, $user, $pass, $dir, $error);
2032         $ftp_url ||= main::get_defaults('ftp-upload');
2033         $ftp_url =~ s/\/$//g; # trim off trailing slash if present
2034         my @url = split(/\//, $ftp_url);
2035         my $file_path = "$user_data_dir/$debug_gz";
2036         $host = $url[0];
2037         $dir = $url[1];
2038         $domain = $host;
2039         $domain =~ s/^ftp\.//;
2040         $user = "anonymous";
2041         $pass = "anonymous\@$domain";
2042         
2043         print $line3;
2044         print "Uploading to: $ftp_url\n";
2045         # print "$host $domain $dir $user $pass\n";
2046         print "File to be uploaded:\n$file_path\n";
2047         
2048         if ($host && ( $file_path && -e $file_path ) ){
2049                 # NOTE: important: must explicitly set to passive true/1
2050                 $ftp = Net::FTP->new($host, Debug => 0, Passive => 1);
2051                 $ftp->login($user, $pass) || main::error_handler('ftp-login', $ftp->message);
2052                 $ftp->binary();
2053                 $ftp->cwd($dir);
2054                 print "Connected to FTP server.\n";
2055                 $ftp->put($file_path) || main::error_handler('ftp-upload', $ftp->message);
2056                 $ftp->quit;
2057                 print "Uploaded file successfully!\n";
2058                 print $ftp->message;
2059                 if ($b_debug_gz){
2060                         print "Removing debugger gz file:\n$file_path\n";
2061                         unlink $file_path or main::error_handler('remove',"$file_path", "$!");
2062                         print "File removed.\n";
2063                 }
2064                 print "Debugger data generation and upload completed. Thank you for your help.\n";
2065         }
2066         else {
2067                 main::error_handler('ftp-bad-path', "$file_path");
2068         }
2069 }
2070 }
2071
2072 #### -------------------------------------------------------------------
2073 #### DOWNLOADER
2074 #### -------------------------------------------------------------------
2075
2076 sub download_file {
2077         my ($type, $url, $file) = @_;
2078         my ($cmd,$args,$timeout) = ('','','');
2079         my $debug_data = '';
2080         my $result = 1;
2081         $dl{'no-ssl-opt'} ||= '';
2082         $dl{'spider'} ||= '';
2083         $file ||= 'N/A'; # to avoid debug error
2084         if ( ! $dl{'dl'} ){
2085                 return 0;
2086         }
2087         if ($dl{'timeout'}){
2088                 $timeout = "$dl{'timeout'}$dl_timeout";
2089         }
2090         # print "$dl{'no-ssl-opt'}\n";
2091         # print "$dl{'dl'}\n";
2092         # tiny supports spider sort of
2093         ## NOTE: 1 is success, 0 false for Perl
2094         if ($dl{'dl'} eq 'tiny' ){
2095                 $cmd = "Using tiny: type: $type \nurl: $url \nfile: $file";
2096                 $result = get_file($type, $url, $file);
2097                 $debug_data = ($type ne 'stdout') ? $result : 'Success: stdout data not null.';
2098         }
2099         # But: 0 is success, and 1 is false for these
2100         # when strings are returned, they will be taken as true
2101         else {
2102                 if ($type eq 'stdout'){
2103                         $args = $dl{'stdout'};
2104                         $cmd = "$dl{'dl'} $dl{'no-ssl-opt'} $timeout $args $url $dl{'null'}";
2105                         $result = qx($cmd);
2106                         $debug_data = ($result) ? 'Success: stdout data not null.' : 'Download resulted in null data!';
2107                 }
2108                 elsif ($type eq 'file') {
2109                         $args = $dl{'file'};
2110                         $cmd = "$dl{'dl'} $dl{'no-ssl-opt'} $timeout $args $file $url $dl{'null'}";
2111                         system($cmd);
2112                         $result = ($?) ? 0 : 1; # reverse these into Perl t/f
2113                         $debug_data = $result;
2114                 }
2115                 elsif ( $dl{'dl'} eq 'wget' && $type eq 'spider'){
2116                         $cmd = "$dl{'dl'} $dl{'no-ssl-opt'} $timeout $dl{'spider'} $url";
2117                         system($cmd);
2118                         $result = ($?) ? 0 : 1; # reverse these into Perl t/f
2119                         $debug_data = $result;
2120                 }
2121         }
2122         print "-------\nDownloader Data:\n$cmd\nResult: $debug_data\n" if $test[1];
2123         log_data('data',"$cmd\nResult: $result") if $b_log;
2124         return $result;
2125 }
2126
2127 sub get_file {
2128         my ($type, $url, $file) = @_;
2129         my $response = HTTP::Tiny->new->get($url);
2130         my $return = 1;
2131         my $debug = 0;
2132         my $fh;
2133         $file ||= 'N/A';
2134         log_data('dump','%{$response}',\%{$response}) if $b_log;
2135         # print Dumper \%{$response};
2136         if ( ! $response->{success} ){
2137                 my $content = $response->{content};
2138                 $content ||= "N/A\n";
2139                 my $msg = "Failed to connect to server/file!\n";
2140                 $msg .= "Response: ${content}Downloader: HTTP::Tiny URL: $url\nFile: $file";
2141                 log_data('data',$msg) if $b_log;
2142                 print error_defaults('download-error',$msg) if $test[1];
2143                 $return = 0;
2144         }
2145         else {
2146                 if ( $debug ){
2147                         print "$response->{success}\n";
2148                         print "$response->{status} $response->{reason}\n";
2149                         while (my ($key, $value) = each %{$response->{headers}}) {
2150                                 for (ref $value eq "ARRAY" ? @$value : $value) {
2151                                         print "$key: $_\n";
2152                                 }
2153                         }
2154                 }
2155                 if ( $type eq "stdout" || $type eq "ua-stdout" ){
2156                         $return = $response->{content};
2157                 }
2158                 elsif ($type eq "spider"){
2159                         # do nothing, just use the return value
2160                 }
2161                 elsif ($type eq "file"){
2162                         open($fh, ">", $file);
2163                         print $fh $response->{content}; # or die "can't write to file!\n";
2164                         close $fh;
2165                 }
2166         }
2167         return $return;
2168 }
2169
2170 sub set_downloader {
2171         eval $start if $b_log;
2172         $dl{'no-ssl'} = '';
2173         $dl{'null'} = '';
2174         $dl{'spider'} = '';
2175         # we only want to use HTTP::Tiny if it's present in user system.
2176         # It is NOT part of core modules. IO::Socket::SSL is also required 
2177         # For some https connections so only use tiny as option if both present
2178         if ($dl{'tiny'}){
2179                 if (check_module('HTTP::Tiny') && check_module('IO::Socket::SSL')){
2180                         import HTTP::Tiny;
2181                         import IO::Socket::SSL;
2182                         $dl{'tiny'} = 1;
2183                 }
2184                 else {
2185                         $dl{'tiny'} = 0;
2186                 }
2187         }
2188         #print $dl{'tiny'} . "\n";
2189         if ($dl{'tiny'}){
2190                 $dl{'dl'} = 'tiny';
2191                 $dl{'file'} = '';
2192                 $dl{'stdout'} = '';
2193                 $dl{'timeout'} = '';
2194         }
2195         elsif ( $dl{'curl'} && check_program('curl')  ){
2196                 $dl{'dl'} = 'curl';
2197                 $dl{'file'} = '  -L -s -o ';
2198                 $dl{'no-ssl'} = ' --insecure';
2199                 $dl{'stdout'} = ' -L -s ';
2200                 $dl{'timeout'} = ' -y ';
2201         }
2202         elsif ($dl{'wget'} && check_program('wget') ){
2203                 $dl{'dl'} = 'wget';
2204                 $dl{'file'} = ' -q -O ';
2205                 $dl{'no-ssl'} = ' --no-check-certificate';
2206                 $dl{'spider'} = ' -q --spider';
2207                 $dl{'stdout'} = '  -q -O -';
2208                 $dl{'timeout'} = ' -T ';
2209         }
2210         elsif ($dl{'fetch'} && check_program('fetch')){
2211                 $dl{'dl'} = 'fetch';
2212                 $dl{'file'} = ' -q -o ';
2213                 $dl{'no-ssl'} = ' --no-verify-peer';
2214                 $dl{'stdout'} = ' -q -o -';
2215                 $dl{'timeout'} = ' -T ';
2216         }
2217         elsif ( $bsd_type eq 'openbsd' && check_program('ftp') ){
2218                 $dl{'dl'} = 'ftp';
2219                 $dl{'file'} = ' -o ';
2220                 $dl{'null'} = ' 2>/dev/null';
2221                 $dl{'stdout'} = ' -o - ';
2222                 $dl{'timeout'} = '';
2223         }
2224         else {
2225                 $dl{'dl'} = '';
2226         }
2227         # no-ssl-opt is set to 1 with --no-ssl, so it is true, then assign
2228         $dl{'no-ssl-opt'} = $dl{'no-ssl'} if $dl{'no-ssl-opt'};
2229         eval $end if $b_log;
2230 }
2231
2232 sub set_perl_downloader {
2233         my ($downloader) = @_;
2234         $downloader =~ s/perl/tiny/;
2235         return $downloader;
2236 }
2237
2238 #### -------------------------------------------------------------------
2239 #### ERROR HANDLER
2240 #### -------------------------------------------------------------------
2241
2242 sub error_handler {
2243         eval $start if $b_log;
2244         my ( $err, $one, $two) = @_;
2245         my ($b_help,$b_recommends);
2246         my ($b_exit,$errno) = (1,0);
2247         my $message = do {
2248                 if ( $err eq 'empty' ) { 'empty value' }
2249                 ## Basic rules
2250                 elsif ( $err eq 'not-in-irc' ) { 
2251                         $errno=1; "You can't run option $one in an IRC client!" }
2252                 ## Internal/external options
2253                 elsif ( $err eq 'bad-arg' ) { 
2254                         $errno=10; $b_help=1; "Unsupported value: $two for option: $one" }
2255                 elsif ( $err eq 'bad-arg-int' ) { 
2256                         $errno=11; "Bad internal argument: $one" }
2257                 elsif ( $err eq 'distro-block' ) { 
2258                         $errno=20; "Option: $one has been disabled by the $self_name distribution maintainer." }
2259                 elsif ( $err eq 'option-feature-incomplete' ) { 
2260                         $errno=21; "Option: '$one' feature: '$two' has not been implemented yet." }
2261                 elsif ( $err eq 'unknown-option' ) { 
2262                         $errno=22; $b_help=1; "Unsupported option: $one" }
2263                 ## Data
2264                 elsif ( $err eq 'open-data' ) { 
2265                         $errno=32; "Error opening data for reading: $one \nError: $two" }
2266                 elsif ( $err eq 'download-error' ) { 
2267                         $errno=33; "Error downloading file with $dl{'dl'}: $one \nError: $two" }
2268                 ## Files:
2269                 elsif ( $err eq 'copy-failed' ) { 
2270                         $errno=40; "Error copying file: $one \nError: $two" }
2271                 elsif ( $err eq 'create' ) { 
2272                         $errno=41; "Error creating file: $one \nError: $two" }
2273                 elsif ( $err eq 'downloader-error' ) { 
2274                         $errno=42; "Error downloading file: $one \nfor download source: $two" }
2275                 elsif ( $err eq 'file-corrupt' ) { 
2276                         $errno=43; "Downloaded file is corrupted: $one" }
2277                 elsif ( $err eq 'mkdir' ) { 
2278                         $errno=44; "Error creating directory: $one \nError: $two" }
2279                 elsif ( $err eq 'open' ) { 
2280                         $errno=45; $b_exit=0; "Error opening file: $one \nError: $two" }
2281                 elsif ( $err eq 'open-dir' ) { 
2282                         $errno=46; "Error opening directory: $one \nError: $two" }
2283                 elsif ( $err eq 'output-file-bad' ) { 
2284                         $errno=47; "Value for --output-file must be full path, a writable directory, \nand include file name. Path: $two" }
2285                 elsif ( $err eq 'not-writable' ) { 
2286                         $errno=48; "The file: $one is not writable!" }
2287                 elsif ( $err eq 'open-dir-failed' ) { 
2288                         $errno=49; "The directory: $one failed to open with error: $two" }
2289                 elsif ( $err eq 'remove' ) { 
2290                         $errno=50; "Failed to remove file: $one Error: $two" }
2291                 elsif ( $err eq 'rename' ) { 
2292                         $errno=51; "There was an error moving files: $one\nError: $two" }
2293                 elsif ( $err eq 'write' ) { 
2294                         $errno=52; "Failed writing file: $one - Error: $two!" }
2295                 ## Downloaders
2296                 elsif ( $err eq 'missing-downloader' ) { 
2297                         $errno=60; "Downloader program $two could not be located on your system." }
2298                 elsif ( $err eq 'missing-perl-downloader' ) { 
2299                         $errno=61; $b_recommends=1; "Perl downloader missing required module." }
2300                 ## FTP
2301                 elsif ( $err eq 'ftp-bad-path' ) { 
2302                         $errno=70; "Unable to locate for FTP upload file:\n$one" }
2303                 elsif ( $err eq 'ftp-login' ) { 
2304                         $errno=71; "There was an error with login to ftp server: $one" }
2305                 elsif ( $err eq 'ftp-upload' ) { 
2306                         $errno=72; "There was an error with upload to ftp server: $one" }
2307                 ## Modules
2308                 elsif ( $err eq 'required-module' ) { 
2309                         $errno=80; $b_recommends=1; "The required $one Perl module is not installed:\n$two" }
2310                 ## DEFAULT
2311                 else {
2312                         $errno=255; "Error handler ERROR!! Unsupported options: $err!"}
2313         };
2314         print_line("Error $errno: $message\n");
2315         if ($b_help){
2316                 print_line("Check -h for correct parameters.\n");
2317         }
2318         if ($b_recommends){
2319                 print_line("See --recommends for more information.\n");
2320         }
2321         eval $end if $b_log;
2322         exit 0 if $b_exit;
2323 }
2324
2325 sub error_defaults {
2326         my ($type,$one) = @_;
2327         $one ||= '';
2328         my %errors = (
2329         'download-error' => "Download Failure:\n$one\n",
2330         );
2331         return $errors{$type};
2332 }
2333
2334 #### -------------------------------------------------------------------
2335 #### RECOMMENDS
2336 #### -------------------------------------------------------------------
2337
2338 ## CheckRecommends
2339 {
2340 package CheckRecommends;
2341 sub run {
2342         main::error_handler('not-in-irc', 'recommends') if $b_irc;
2343         my (@data,@rows);
2344         my $line = make_line();
2345         my $pm = get_pm();
2346         @data = basic_data($line);
2347         push @rows,@data;
2348         if (!$bsd_type){
2349                 @data = check_items('required system directories',$line,$pm);
2350                 push @rows,@data;
2351         }
2352         @data = check_items('recommended system programs',$line,$pm);
2353         push @rows,@data;
2354         @data = check_items('recommended display information programs',$line,$pm);
2355         push @rows,@data;
2356         @data = check_items('recommended downloader programs',$line,$pm);
2357         push @rows,@data;
2358         @data = check_items('recommended Perl modules',$line,$pm);
2359         push @rows,@data;
2360         @data = check_items('recommended directories',$line,'');
2361         push @rows,@data;
2362         @data = check_items('recommended files',$line,'');
2363         push @rows,@data;
2364         @data = (
2365         ['0', '', '', "$line"],
2366         ['0', '', '', "Ok, all done with the checks. Have a nice day."],
2367         ['0', '', '', " "],
2368         );
2369         push @rows,@data;
2370         #print Data::Dumper::Dumper \@rows;
2371         main::print_basic(@rows); 
2372         exit 1;
2373 }
2374
2375 sub basic_data {
2376         my ($line) = @_;
2377         my (@data,@rows);
2378         my $client = $client{'name-print'};
2379         $client .= ' ' . $client{'version'} if $client{'version'};
2380         my $default_shell = 'N/A';
2381         if ($ENV{'SHELL'}){
2382                 $default_shell = $ENV{'SHELL'};
2383                 $default_shell =~ s/.*\///;
2384         }
2385         my $sh = main::check_program('sh');
2386         my $sh_real = Cwd::abs_path($sh);
2387         @rows = (
2388         ['0', '', '', "$self_name will now begin checking for the programs it needs 
2389         to operate."],
2390         ['0', '', '', "" ],
2391         ['0', '', '', "Check $self_name --help or the man page (man $self_name) 
2392         to see what options are available." ],
2393         ['0', '', '', "$line" ],
2394         ['0', '', '', "Test: core tools:" ],
2395         ['0', '', '', "" ],
2396         ['0', '', '', "Perl version: ^$]" ],
2397         ['0', '', '', "Current shell: " . $client ],
2398         ['0', '', '', "Default shell: " . $default_shell ],
2399         ['0', '', '', "sh links to: $sh_real" ],
2400         );
2401         return @rows;
2402 }
2403 sub check_items {
2404         my ($type,$line,$pm) = @_;
2405         my (@data,%info,@missing,$row,@rows,$result,@unreadable);
2406         my ($b_dir,$b_file,$b_module,$b_program,$item);
2407         my ($about,$extra,$extra2,$extra3,$extra4,$info_os,$install) = ('','','','','','info','');
2408         if ($type eq 'required system directories'){
2409                 @data = qw(/proc /sys);
2410                 $b_dir = 1;
2411                 $item = 'Directory';
2412         }
2413         elsif ($type eq 'recommended system programs'){
2414                 if ($bsd_type){
2415                         @data = qw(camcontrol dig dmidecode fdisk file glabel gpart ifconfig ipmi-sensors 
2416                         ipmitool lsusb sudo smartctl sysctl tree upower uptime usbdevs);
2417                         $info_os = 'info-bsd';
2418                 }
2419                 else {
2420                         @data = qw(dig dmidecode fdisk file hddtemp ifconfig ip ipmitool ipmi-sensors
2421                         lsblk lsusb modinfo runlevel sensors strings sudo tree upower uptime);
2422                 }
2423                 $b_program = 1;
2424                 $item = 'Program';
2425                 $extra2 = "Note: IPMI sensors are generally only found on servers. To access 
2426                 that data, you only need one of the ipmi items.";
2427         }
2428         elsif ($type eq 'recommended display information programs'){
2429                 if ($bsd_type){
2430                         @data = qw(glxinfo wmctrl xdpyinfo xprop xrandr);
2431                         $info_os = 'info-bsd';
2432                 }
2433                 else {
2434                         @data = qw(glxinfo wmctrl xdpyinfo xprop xrandr);
2435                 }
2436                 $b_program = 1;
2437                 $item = 'Program';
2438         }
2439         elsif ($type eq 'recommended downloader programs'){
2440                 if ($bsd_type){
2441                         @data = qw(curl dig fetch ftp wget);
2442                         $info_os = 'info-bsd';
2443                 }
2444                 else {
2445                         @data = qw(curl dig wget);
2446                 }
2447                 $b_program = 1;
2448                 $extra = ' (You only need one of these)';
2449                 $extra2 = "Perl HTTP::Tiny is the default downloader tool if IO::Socket::SSL is present.
2450                 See --help --alt 40-44 options for how to override default downloader(s) in case of issues. ";
2451                 $extra3 = "If dig is installed, it is the default for WAN IP data. 
2452                 Strongly recommended. Dig is fast and accurate.";
2453                 $extra4 = ". However, you really only need dig in most cases. All systems should have ";
2454                 $extra4 .= "at least one of the downloader options present.";
2455                 $item = 'Program';
2456         }
2457         elsif ($type eq 'recommended Perl modules'){
2458                 @data = qw(HTTP::Tiny IO::Socket::SSL Time::HiRes Cpanel::JSON::XS JSON::XS XML::Dumper);
2459                 $b_module = 1;
2460                 $item = 'Perl Module';
2461                 $extra = ' (Optional)';
2462                 $extra2 = "None of these are strictly required, but if you have them all, you can eliminate
2463                 some recommended non Perl programs from the install. ";
2464                 $extra3 = "HTTP::Tiny and IO::Socket::SSL must both be present to use as a downloader option. 
2465                 For json export Cpanel::JSON::XS is preferred over JSON::XS.";
2466         }
2467         elsif ($type eq 'recommended directories'){
2468                 if ($bsd_type){
2469                         @data = qw(/dev);
2470                 }
2471                 else {
2472                         @data = qw(/dev /dev/disk/by-id /dev/disk/by-label /dev/disk/by-path 
2473                         /dev/disk/by-uuid /sys/class/dmi/id);
2474                 }
2475                 $b_dir = 1;
2476                 $item = 'Directory';
2477         }
2478         elsif ($type eq 'recommended files'){
2479                 if ($bsd_type){
2480                         @data = qw(/var/run/dmesg.boot /var/log/Xorg.0.log);
2481                 }
2482                 else {
2483                         @data = qw(/etc/lsb-release /etc/os-release /proc/asound/cards 
2484                         /proc/asound/version /proc/cpuinfo /proc/mdstat /proc/meminfo /proc/modules 
2485                         /proc/mounts /proc/scsi/scsi /var/log/Xorg.0.log );
2486                 }
2487                 $b_file = 1;
2488                 $item = 'File';
2489                 $extra2 = "Note that not all of these are used by every system, 
2490                 so if one is missing it's usually not a big deal.";
2491         }
2492         @rows = (
2493         ['0', '', '', "$line" ],
2494         ['0', '', '', "Test: $type$extra:" ],
2495         ['0', '', '', " " ],
2496         );
2497         if ($extra2){
2498                 $rows[scalar @rows] = (['0', '', '', $extra2]);
2499                 $rows[scalar @rows] = (['0', '', '', ' ']);
2500         }
2501         if ($extra3){
2502                 $rows[scalar @rows] = (['0', '', '', $extra3]);
2503                 $rows[scalar @rows] = (['0', '', '', ' ']);
2504         }
2505         foreach (@data){
2506                 $install = '';
2507                 $about = '';
2508                 %info = item_data($_);
2509                 $about = $info{$info_os};
2510                 if ( ( $b_dir && -d $_ ) || ( $b_file && -r $_ ) ||
2511                      ($b_program && main::check_program($_) ) || ($b_module && main::check_module($_)) ){
2512                         $result = 'Present';
2513                 }
2514                 elsif ($b_file && -f $_){
2515                         $result = 'Unreadable';
2516                         push @unreadable, "$_";
2517                 }
2518                 else {
2519                         $result = 'Missing';
2520                         $install = " ~ Install package: $info{$pm}" if (($b_program || $b_module) && $pm);
2521                         push @missing, "$_$install";
2522                 }
2523                 $row = make_row($_,$about,$result);
2524                 $rows[scalar @rows] = (['0', '', '', $row]);
2525         }
2526         $rows[scalar @rows] = (['0', '', '', " "]);
2527         if (@missing){
2528                 $rows[scalar @rows] = (['0', '', '', "The following $type are missing$extra4:"]);
2529                 foreach (@missing) {
2530                         $rows[scalar @rows] = (['0', '', '', "$item: $_"]);
2531                 }
2532         }
2533         if (@unreadable){
2534                 $rows[scalar @rows] = (['0', '', '', "The following $type are not readable: "]);
2535                 foreach (@unreadable) {
2536                         $rows[scalar @rows] = (['0', '', '', "$item: $_"]);
2537                 }
2538         }
2539         if (!@missing && !@unreadable){
2540                 $rows[scalar @rows] = (['0', '', '', "All $type are present"]);
2541         }
2542         return @rows;
2543 }
2544
2545 sub item_data {
2546         my ($type) = @_;
2547         my %data = (
2548         # directory data
2549         '/sys/class/dmi/id' => ({
2550         'info' => '-M system, motherboard, bios',
2551         }),
2552         '/dev' => ({
2553         'info' => '-l,-u,-o,-p,-P,-D disk partition data',
2554         }),
2555         '/dev/disk/by-id' => ({
2556         'info' => '-D serial numbers',
2557         }),
2558         '/dev/disk/by-path' => ({
2559         'info' => '-D extra data',
2560         }),
2561         '/dev/disk/by-label' => ({
2562         'info' => '-l,-o,-p,-P partition labels',
2563         }),
2564         '/dev/disk/by-uuid' => ({
2565         'info' => '-u,-o,-p,-P partition uuid',
2566         }),
2567         '/proc' => ({
2568         'info' => '',
2569         }),
2570         '/sys' => ({
2571         'info' => '',
2572         }),
2573         # file data
2574         '/etc/lsb-release' => ({
2575         'info' => '-S distro version data (older version)',
2576         }),
2577         '/etc/os-release' => ({
2578         'info' => '-S distro version data (newer version)',
2579         }),
2580         '/proc/asound/cards' => ({
2581         'info' => '-A sound card data',
2582         }),
2583         '/proc/asound/version' => ({
2584         'info' => '-A ALSA data',
2585         }),
2586         '/proc/cpuinfo' => ({
2587         'info' => '-C cpu data',
2588         }),
2589         '/proc/mdstat' => ({
2590         'info' => '-R mdraid data (if you use dm-raid)',
2591         }),
2592         '/proc/meminfo' => ({
2593         'info' => '-I,-tm, -m memory data',
2594         }),
2595         '/proc/modules' => ({
2596         'info' => '-G module data (sometimes)',
2597         }),
2598         '/proc/mounts' => ({
2599         'info' => '-P,-p partition advanced data',
2600         }),
2601         '/proc/scsi/scsi' => ({
2602         'info' => '-D Advanced hard disk data (used rarely)',
2603         }),
2604         '/var/log/Xorg.0.log' => ({
2605         'info' => '-G graphics driver load status',
2606         }),
2607         '/var/run/dmesg.boot' => ({
2608         'info' => '-D,-d disk data',
2609         }),
2610         # system tools
2611         # apt-dpkg,apt-get; pm-arch,pacman; rpm-redhat,suse
2612         'curl' => ({
2613         'info' => '-i (if no dig); -w,-W; -U',
2614         'info-bsd' => '-i (if no dig); -w,-W; -U',
2615         'apt' => 'curl',
2616         'pacman' => 'curl',
2617         'rpm' => 'curl',
2618         }),
2619         'camcontrol' => ({
2620         'info' => '',
2621         'info-bsd' => '-R; -D; -P. Get actual gptid /dev path',
2622         'apt' => '',
2623         'pacman' => '',
2624         'rpm' => '',
2625         }),
2626         'dig' => ({
2627         'info' => '-i wlan IP',
2628         'info-bsd' => '-i wlan IP',
2629         'apt' => 'dnsutils',
2630         'pacman' => 'dnsutils',
2631         'rpm' => 'bind-utils',
2632         }),
2633         'dmidecode' => ({
2634         'info' => '-M if no sys machine data; -m',
2635         'info-bsd' => '-M if null sysctl; -m; -B if null sysctl',
2636         'apt' => 'dmidecode',
2637         'pacman' => 'dmidecode',
2638         'rpm' => 'dmidecode',
2639         }),
2640         'fdisk' => ({
2641         'info' => '-D partition scheme (fallback)',
2642         'info-bsd' => '-D partition scheme',
2643         'apt' => 'fdisk',
2644         'pacman' => 'util-linux',
2645         'rpm' => 'util-linux',
2646         }),
2647         'fetch' => ({
2648         'info' => '',
2649         'info-bsd' => '-i (if no dig); -w,-W; -U',
2650         'apt' => '',
2651         'pacman' => '',
2652         'rpm' => '',
2653         }),
2654         'file' => ({
2655         'info' => '-o unmounted file system (if no lsblk)',
2656         'info-bsd' => '-o unmounted file system',
2657         'apt' => 'file',
2658         'pacman' => 'file',
2659         'rpm' => 'file',
2660         }),
2661         'ftp' => ({
2662         'info' => '',
2663         'info-bsd' => '-i (if no dig); -w,-W; -U',
2664         'apt' => '',
2665         'pacman' => '',
2666         'rpm' => '',
2667         }),
2668         'glabel' => ({
2669         'info' => '',
2670         'info-bsd' => '-R; -D; -P. Get actual gptid /dev path',
2671         'apt' => '',
2672         'pacman' => '',
2673         'rpm' => '',
2674         }),
2675         'gpart' => ({
2676         'info' => '',
2677         'info-bsd' => '-p,-P file system, size',
2678         'apt' => '',
2679         'pacman' => '',
2680         'rpm' => '',
2681         }),
2682         'hciconfig' => ({
2683         'info' => 'Experimental',
2684         'info-bsd' => '',
2685         'apt' => 'bluez',
2686         'pacman' => 'bluez-utils',
2687         'rpm' => 'bluez-utils',
2688         }),
2689         'hddtemp' => ({
2690         'info' => '-Dx show hdd temp',
2691         'info-bsd' => '-Dx show hdd temp',
2692         'apt' => 'hddtemp',
2693         'pacman' => 'hddtemp',
2694         'rpm' => 'hddtemp',
2695         }),
2696         'ifconfig' => ({
2697         'info' => '-i ip LAN (deprecated)',
2698         'info-bsd' => '-i ip LAN',
2699         'apt' => 'net-tools',
2700         'pacman' => 'net-tools',
2701         'rpm' => 'net-tools',
2702         }),
2703         'ip' => ({
2704         'info' => '-i ip LAN',
2705         'info-bsd' => '',
2706         'apt' => 'iproute',
2707         'pacman' => 'iproute2',
2708         'rpm' => 'iproute',
2709         }),
2710         'ipmi-sensors' => ({
2711         'info' => '-s IPMI sensors (servers)',
2712         'info-bsd' => '',
2713         'apt' => 'freeipmi-tools',
2714         'pacman' => 'freeipmi',
2715         'rpm' => 'freeipmi',
2716         }),
2717         'ipmitool' => ({
2718         'info' => '-s IPMI sensors (servers)',
2719         'info-bsd' => '-s IPMI sensors (servers)',
2720         'apt' => 'ipmitool',
2721         'pacman' => 'ipmitool',
2722         'rpm' => 'ipmitool',
2723         }),
2724         'lsblk' => ({
2725         'info' => '-o unmounted file system (best option)',
2726         'info-bsd' => '-o unmounted file system',
2727         'apt' => 'util-linux',
2728         'pacman' => 'util-linux',
2729         'rpm' => 'util-linux-ng',
2730         }),
2731         'lsusb' => ({
2732         'info' => '-A usb audio; -N usb networking; --usb',
2733         'info-bsd' => '-A; -N; --usb. Alternate to usbdevs',
2734         'apt' => 'usbutils',
2735         'pacman' => 'usbutils',
2736         'rpm' => 'usbutils',
2737         }),
2738         'modinfo' => ({
2739         'info' => 'Ax; -Nx module version',
2740         'info-bsd' => '',
2741         'apt' => 'module-init-tools',
2742         'pacman' => 'module-init-tools',
2743         'rpm' => 'module-init-tools',
2744         }),
2745         'runlevel' => ({
2746         'info' => '-I fallback to Perl',
2747         'info-bsd' => '',
2748         'apt' => 'systemd or sysvinit',
2749         'pacman' => 'systemd',
2750         'rpm' => 'systemd or sysvinit',
2751         }),
2752         'sensors' => ({
2753         'info' => '-s sensors output',
2754         'info-bsd' => '',
2755         'apt' => 'lm-sensors',
2756         'pacman' => 'lm-sensors',
2757         'rpm' => 'lm-sensors',
2758         }),
2759         'smartctl' => ({
2760         'info' => '-Dx show hdd temp',
2761         'info-bsd' => '-Dx show hdd temp',
2762         'apt' => '',
2763         'pacman' => '',
2764         'rpm' => '',
2765         }),
2766         'strings' => ({
2767         'info' => '-I sysvinit version',
2768         'info-bsd' => '',
2769         'apt' => 'binutils',
2770         'pacman' => '?',
2771         'rpm' => '?',
2772         }),
2773         'sysctl' => ({
2774         'info' => '',
2775         'info-bsd' => '-C; -I; -m; -tm',
2776         'apt' => '?',
2777         'pacman' => '?',
2778         'rpm' => '?',
2779         }),
2780         'sudo' => ({
2781         'info' => '-Dx hddtemp-user; -o file-user',
2782         'info-bsd' => '-Dx hddtemp-user; -o file-user',
2783         'apt' => 'sudo',
2784         'pacman' => 'sudo',
2785         'rpm' => 'sudo',
2786         }),
2787         'tree' => ({
2788         'info' => '--debugger 20,21 /sys tree',
2789         'info-bsd' => '--debugger 20,21 /sys tree',
2790         'apt' => 'tree',
2791         'pacman' => 'tree',
2792         'rpm' => 'tree',
2793         }),
2794         'upower' => ({
2795         'info' => '-sx attached device battery info',
2796         'info-bsd' => '-sx attached device battery info',
2797         'apt' => 'upower',
2798         'pacman' => 'upower',
2799         'rpm' => 'upower',
2800         }),
2801         'uptime' => ({
2802         'info' => '-I uptime',
2803         'info-bsd' => '-I uptime',
2804         'apt' => 'procps',
2805         'pacman' => 'procps',
2806         'rpm' => 'procps',
2807         }),
2808         'usbdevs' => ({
2809         'info' => '',
2810         'info-bsd' => '-A; -N; --usb;',
2811         'apt' => 'usbutils',
2812         'pacman' => 'usbutils',
2813         'rpm' => 'usbutils',
2814         }),
2815         'wget' => ({
2816         'info' => '-i (if no dig); -w,-W; -U',
2817         'info-bsd' => '-i (if no dig); -w,-W; -U',
2818         'apt' => 'wget',
2819         'pacman' => 'wget',
2820         'rpm' => 'wget',
2821         }),
2822         # display tools
2823         'glxinfo' => ({
2824         'info' => '-G glx info',
2825         'info-bsd' => '-G glx info',
2826         'apt' => 'mesa-utils',
2827         'pacman' => 'mesa-demos',
2828         'rpm' => 'glx-utils (openSUSE 12.3 and later Mesa-demo-x)',
2829         }),
2830         'wmctrl' => ({
2831         'info' => '-S active window manager (fallback)',
2832         'info-bsd' => '-S active window managerr (fallback)',
2833         'apt' => 'wmctrl',
2834         'pacman' => 'wmctrl',
2835         'rpm' => 'wmctrl',
2836         }),
2837         'xdpyinfo' => ({
2838         'info' => '-G multi screen resolution',
2839         'info-bsd' => '-G multi screen resolution',
2840         'apt' => 'X11-utils',
2841         'pacman' => 'xorg-xdpyinfo',
2842         'rpm' => 'xorg-x11-utils',
2843         }),
2844         'xprop' => ({
2845         'info' => '-S desktop data',
2846         'info-bsd' => '-S desktop data',
2847         'apt' => 'X11-utils',
2848         'pacman' => 'xorg-xprop',
2849         'rpm' => 'x11-utils',
2850         }),
2851         'xrandr' => ({
2852         'info' => '-G single screen resolution',
2853         'info-bsd' => '-G single screen resolution',
2854         'apt' => 'x11-xserver-utils',
2855         'pacman' => 'xrandr',
2856         'rpm' => 'x11-server-utils',
2857         }),
2858         # Perl modules
2859         'Cpanel::JSON::XS' => ({
2860         'info' => '--output json - required for export.',
2861         'info-bsd' => '--output json - required for export.',
2862         'apt' => 'libcpanel-json-xs-perl',
2863         'pacman' => 'perl-cpanel-json-xs',
2864         'rpm' => 'perl-Cpanel-JSON-XS',
2865         }),
2866         'HTTP::Tiny' => ({
2867         'info' => '-U; -w,-W; -i (if dig not installed).',
2868         'info-bsd' => '-U; -w,-W; -i (if dig not installed)',
2869         'apt' => 'libhttp-tiny-perl',
2870         'pacman' => 'Core Modules',
2871         'rpm' => 'Perl-http-tiny',
2872         }),
2873         'IO::Socket::SSL' => ({
2874         'info' => '-U; -w,-W; -i (if dig not installed).',
2875         'info-bsd' => '-U; -w,-W; -i (if dig not installed)',
2876         'apt' => 'libio-socket-ssl-perl',
2877         'pacman' => 'perl-io-socket-ssl',
2878         'rpm' => 'perl-IO-Socket-SSL',
2879         }),
2880         'JSON::XS' => ({
2881         'info' => '--output json - required for export (legacy).',
2882         'info-bsd' => '--output json - required for export (legacy).',
2883         'apt' => 'libjson-xs-perl',
2884         'pacman' => 'perl-json-xs',
2885         'rpm' => 'perl-JSON-XS',
2886         }),
2887         'Time::HiRes' => ({
2888         'info' => '-C cpu sleep (not required); --debug timers',
2889         'info-bsd' => '-C cpu sleep (not required); --debug timers',
2890         'apt' => 'Core Modules',
2891         'pacman' => 'Core Modules',
2892         'rpm' => 'perl-Time-HiRes',
2893         }),
2894         'XML::Dumper' => ({
2895         'info' => '--output xml - Crude and raw.',
2896         'info-bsd' => '--output xml - Crude and raw.',
2897         'apt' => 'libxml-dumper-perl',
2898         'pacman' => 'perl-xml-dumper',
2899         'rpm' => 'perl-XML-Dumper',
2900         }),
2901         );
2902         my $ref = $data{$type};
2903         my %values = %$ref;
2904         return %values;
2905 }
2906 sub get_pm {
2907         my ($pm) = ('');
2908         if (main::check_program('dpkg')){
2909                 $pm = 'apt';
2910         }
2911         elsif (main::check_program('pacman')){
2912                 $pm = 'pacman';
2913         }
2914         elsif (main::check_program('rpm')){
2915                 $pm = 'rpm';
2916         }
2917         return $pm;
2918 }
2919 # note: end will vary, but should always be treated as longest value possible.
2920 # expected values: Present/Missing
2921 sub make_row {
2922         my ($start,$middle,$end) = @_;
2923         my ($dots,$line,$sep) = ('','',': ');
2924         foreach (0 .. ($size{'max'} - 16 - length("$start$middle"))){
2925                 $dots .= '.';
2926         }
2927         $line = "$start$sep$middle$dots $end";
2928         return $line;
2929 }
2930 sub make_line {
2931         my $line = '';
2932         foreach (0 .. $size{'max'} - 2 ){
2933                 $line .= '-';
2934         }
2935         return $line;
2936 }
2937 }
2938
2939 #### -------------------------------------------------------------------
2940 #### TOOLS
2941 #### -------------------------------------------------------------------
2942
2943 # Duplicates the functionality of awk to allow for one liner
2944 # type data parsing. note: -1 corresponds to awk NF
2945 # args 1: array of data; 2: search term; 3: field result; 4: separator
2946 # correpsonds to: awk -F='separator' '/search/ {print $2}' <<< @data
2947 # array is sent by reference so it must be dereferenced
2948 # NOTE: if you just want the first row, pass it \S as search string
2949 # NOTE: if $num is undefined, it will skip the second step
2950 sub awk {
2951         eval $start if $b_log;
2952         my ($ref,$search,$num,$sep) = @_;
2953         my ($result);
2954         # print "search: $search\n";
2955         return if ! @$ref || ! $search;
2956         foreach (@$ref){
2957                 if (/$search/i){
2958                         $result = $_;
2959                         $result =~ s/^\s+|\s+$//g;
2960                         last;
2961                 }
2962         }
2963         if ($result && defined $num){
2964                 $sep ||= '\s+';
2965                 $num-- if $num > 0; # retain the negative values as is
2966                 $result = (split /$sep/, $result)[$num];
2967                 $result =~ s/^\s+|,|\s+$//g if $result;
2968         }
2969         eval $end if $b_log;
2970         return $result;
2971 }
2972
2973 # $1 - Perl module to check
2974 sub check_module {
2975         my ($module) = @_;
2976         my $b_present = 0;
2977         eval "require $module";
2978         $b_present = 1 if !$@;
2979         return $b_present;
2980 }
2981
2982 # arg: 1 - string or path to search gneerated @paths data for.
2983 # note: a few nano seconds are saved by using raw $_[0] for program
2984 sub check_program {
2985         (grep { return "$_/$_[0]" if -e "$_/$_[0]"} @paths)[0];
2986 }
2987
2988 sub cleanup {
2989         # maybe add in future: , $fh_c, $fh_j, $fh_x
2990         foreach my $fh ($fh_l){
2991                 if ($fh){
2992                         close $fh;
2993                 }
2994         }
2995 }
2996
2997 # returns count of files in directory, if 0, dir is empty
2998 sub count_dir_files {
2999         return unless -d $_[0];
3000         opendir my $dh, $_[0] or error_handler('open-dir-failed', "$_[0]", $!); 
3001         my $count = grep { ! /^\.{1,2}/ } readdir $dh; # strips out . and ..
3002         return $count;
3003 }
3004
3005 # args: 1 - the string to get piece of
3006 # 2 - the position in string, starting at 1 for 0 index.
3007 # 3 - the separator, default is ' '
3008 sub get_piece {
3009         eval $start if $b_log;
3010         my ($string, $num, $sep) = @_;
3011         $num--;
3012         $sep ||= '\s+';
3013         $string =~ s/^\s+|\s+$//g;
3014         my @temp = split(/$sep/, $string);
3015         eval $end if $b_log;
3016         if ( exists $temp[$num] ){
3017                 $temp[$num] =~ s/,//g;
3018                 return $temp[$num];
3019         }
3020 }
3021
3022 # arg: 1 - command to turn into an array; 2 - optional: splitter
3023 # 3 - optionsl, strip and clean data
3024 # similar to reader() except this creates an array of data 
3025 # by lines from the command arg
3026 sub grabber {
3027         eval $start if $b_log;
3028         my ($cmd,$split,$strip) = @_;
3029         $split ||= "\n";
3030         my @rows = split /$split/, qx($cmd);
3031         if ($strip && @rows){
3032                 @rows = grep {/^\s*[^#]/} @rows;
3033                 @rows = map {s/^\s+|\s+$//g; $_} @rows if @rows;
3034         }
3035         eval $end if $b_log;
3036         return @rows;
3037 }
3038
3039 # args: 1 - string value to glob
3040 sub globber {
3041         eval $start if $b_log;
3042         my @files = <$_[0]>;
3043         eval $end if $b_log;
3044         return @files;
3045 }
3046
3047 # gets array ref, which may be undefined, plus join string
3048 # this helps avoid debugger print errors when we are printing arrays
3049 # which we don't know are defined or not null.
3050 # args: 1 - array ref; 2 - join string; 3 - default value, optional
3051 sub joiner {
3052         my ($ref,$join,$default) = @_;
3053         my @arr = @$ref;
3054         $default ||= '';
3055         my $string = '';
3056         foreach (@arr){
3057                 if (defined $_){
3058                         $string .= $_ . $join;
3059                 }
3060                 else {
3061                         $string .= $default . $join;
3062                 }
3063         }
3064         return $string;
3065 }
3066
3067 # returns array of:
3068 # 0 - match string; 1 - search number; 2 - version string; 3 - Print name
3069 # 4 - console 0/1; 5 - 0/1 exit version loop at first iteration; 
3070 # 6 - 0/1 write to stderr
3071 # arg: 1 - program lower case name
3072 sub program_values {
3073         my ($app) = @_;
3074         my (@client_data);
3075         # note: setting index 1 and 2 to 0 will trip flags to not do version
3076         my %data = (
3077         ## Clients
3078         'bitchx' => ['bitchx',2,'','BitchX',1,0,0],# special
3079         'finch' => ['finch',2,'-v','Finch',1,1,0],
3080         'gaim' => ['[0-9.]+',2,'-v','Gaim',0,1,0],
3081         'ircii' => ['[0-9.]+',3,'-v','ircII',1,1,0],
3082         'irssi' => ['irssi',2,'-v','Irssi',1,1,0],
3083         'irssi-text' => ['irssi',2,'-v','Irssi',1,1,0],
3084         'konversation' => ['konversation',2,'-v','Konversation',0,0,0],
3085         'kopete' => ['Kopete',2,'-v','Kopete',0,0,0],
3086         'kvirc' => ['[0-9.]+',2,'-v','KVIrc',0,0,1], # special
3087         'pidgin' => ['[0-9.]+',2,'-v','Pidgin',0,1,0],
3088         'quassel' => ['',1,'-v','Quassel [M]',0,0,0], # special
3089         'quasselclient' => ['',1,'-v','Quassel',0,0,0],# special
3090         'quasselcore' => ['',1,'-v','Quassel (core)',0,0,0],# special
3091         'gribble' => ['^Supybot',2,'--version','Gribble',1,0,0],# special
3092         'limnoria' => ['^Supybot',2,'--version','Limnoria',1,0,0],# special
3093         'supybot' => ['^Supybot',2,'--version','Supybot',1,0,0],# special
3094         'weechat' => ['[0-9.]+',1,'-v','WeeChat',1,0,0],
3095         'weechat-curses' => ['[0-9.]+',1,'-v','WeeChat',1,0,0],
3096         'xchat-gnome' => ['[0-9.]+',2,'-v','X-Chat-Gnome',1,1,0],
3097         'xchat' => ['[0-9.]+',2,'-v','X-Chat',1,1,0],
3098         ## Desktops / wm
3099         '3dwm' => ['^3dwm',0,'0','3dwm',0,1,0], # unknown syntax
3100         '9wm' => ['^9wm',3,'-version','9wm',0,1,0],
3101         'afterstep' => ['^afterstep',3,'--version','AfterStep',0,1,0],
3102         'amiwm' => ['^amiwm',0,'0','AmiWM',0,1,0],
3103         'awesome' => ['^awesome',2,'--version','Awesome',0,1,0],
3104         'blackbox' => ['^Blackbox',2,'--version','Blackbox',0,1,0],
3105         'budgie' => ['^budgie-desktop',2,'--version','Budgie',0,1,0],
3106         'cinnamon' => ['^cinnamon',2,'--version','Cinnamon',0,1,0],
3107         'compiz' => ['^compiz',2,'--version','Compiz',0,1,0],
3108         'dwm' => ['^dwm',1,'-v','Dwm',0,1,1],
3109         'fluxbox' => ['^fluxbox',2,'--version','Fluxbox',0,1,0],
3110         'flwm' => ['^flwm',0,'0','FLWM',0,0,1],
3111         'fvwm' => ['^fvwm',2,'--version','FVWM',0,0,1],
3112         'fvwm2' => ['^fvwm',2,'--version','FVWM2',0,0,1],
3113         # command: fvwm
3114         'fvwm-crystal' => ['^fvwm',2,'--version','FVWM-Crystal',0,0,0], 
3115         'gala' => ['^gala',2,'--version','gala',0,1,0], # super slow result
3116         'gnome-about' => ['gnome',3,'--version','Gnome',0,1,0],
3117         'gnome-shell' => ['gnome',3,'--version','Gnome',0,1,0],
3118         # fails to return version when in wm, but outside does. weird.
3119         'herbstluftwm' => ['^herbstluftwm',2,'--version','herbstluftwm',0,1,0],
3120         'jwm' => ['^jwm',2,'--version','JWM',0,1,0],
3121         # i3 version 4.13 (2016-11-08) © 2009 Michael Stapelberg and contributors
3122         'i3' => ['^i3',3,'--version','i3',0,1,0],
3123         'icewm' => ['^icewm',2,'--version','IceWM',0,1,0],
3124         'kded' => ['^KDE Development Platform:',4,'--version','KDE',0,1,0],
3125         'kded1' => ['^KDE Development Platform:',4,'--version','KDE',0,1,0],
3126         'kded2' => ['^KDE Development Platform:',4,'--version','KDE',0,1,0],
3127         'kded3' => ['^KDE Development Platform:',4,'--version','KDE',0,1,0],
3128         'kded4' => ['^KDE Development Platform:',4,'--version','KDE',0,1,0],
3129         'lxde' => ['^lxpanel',2,'--version','LXDE',0,1,0],
3130         # command: lxqt-panel
3131         'lxqt' => ['^lxqt-panel',2,'--version','LXQt',0,1,0],
3132         'marco' => ['^marco',2,'--version','marco',0,1,0],
3133         'matchbox' => ['^matchbox',0,'0','Matchbox',0,1,0],
3134         'matchbox-window-manager' => ['^matchbox',2,'--help','Matchbox',0,0,0],
3135         'mate-about' => ['^MATE[[:space:]]DESKTOP',-1,'--version','MATE',0,1,0],
3136         # note, mate-session when launched with full path returns full path in version string
3137         'mate-session' => ['mate-session',-1,'--version','MATE',0,1,0], 
3138         'metacity' => ['^metacity',2,'--version','Metacity',0,1,0],
3139         'muffin' => ['^muffin',2,'--version','muffin',0,1,0],
3140         'mwm' => ['^mwm',0,'0','mwm',0,1,0],
3141         'notion' => ['^.',1,'--version','notion',0,1,0],
3142         'openbox' => ['^openbox',2,'--version','Openbox',0,1,0],
3143         'pantheon' => ['^pantheon',0,'0','Pantheon',0,1,0],
3144         'pekwm' => ['^pekwm',3,'--version','PekWM',0,1,0],
3145         'plasmashell' => ['^plasmashell',2,'--version','KDE Plasma',0,1,0],
3146         'qtdiag' => ['^qt',2,'--version','Qt',0,1,0],
3147         'ratpoison' => ['^ratpoison',2,'--version','Ratpoison',0,1,0],
3148         'sawfish' => ['^sawfish',3,'--version','Sawfish',0,1,0],
3149         'scrotwm' => ['^scrotwm.*welcome.*',5,'-v','Scrotwm',0,1,1],
3150         'spectrwm' => ['^spectrwm.*welcome.*wm',5,'-v','Spectrwm',0,1,0],
3151         'twm' => ['^twm',0,'0','twm',0,1,0],
3152         'unity' => ['^unity',2,'--version','Unity',0,1,0],
3153         'windowlab' => ['^windowlab',2,'-about','WindowLab',0,1,0],
3154         'wm2' => ['^wm2',0,'0','wm2',0,1,0],
3155         'wmaker' => ['^Window[[:space:]]*Maker',-1,'--version','WindowMaker',0,1,0],
3156         'wmii' => ['^wmii',0,'0','wmii',0,1,0], # note: in debian, wmii is wmii3
3157         'wmii2' => ['^wmii2',1,'--version','wmii2',0,1,0],
3158         'xfce4-panel' => ['^xfce4-panel',2,'--version','Xfce',0,1,0],
3159         'xfce5-panel' => ['^xfce5-panel',2,'--version','Xfce',0,1,0],
3160         'xfdesktop' => ['xfdesktop[[:space:]]version',5,'--version','Xfce',0,1,0],
3161         # command: xfdesktop
3162         'xfdesktop-toolkit' => ['Built[[:space:]]with[[:space:]]GTK',4,'--version','Gtk',0,1,0],
3163         'xmonad' => ['^xmonad',2,'--version','XMonad',0,1,0],
3164         ## Shells
3165         'bash' => ['^GNU[[:space:]]bash,[[:space:]]version',4,'--version','Bash',1,0,0],
3166         'csh' => ['^tcsh',2,'--version','csh',1,0,0],
3167         'dash' => ['dash',3,'--version','Dash',1,0,0], # no version, uses dpkg query, sigh
3168         # ksh/lksh/mksh/pdksh can't be handled with version but we'll use the search string to 
3169         # trigger version return and tests
3170         'ksh' => ['ksh',5,'-v','ksh',1,0,0], 
3171         'lksh' => ['ksh',5,'-v','lksh',1,0,0], 
3172         'loksh' => ['ksh',5,'-v','lksh',1,0,0], 
3173         'mksh' => ['ksh',5,'-v','mksh',1,0,0], 
3174         'pdksh' => ['ksh',5,'-v','pdksh',1,0,0], 
3175         'tcsh' => ['^tcsh',2,'--version','tcsh',1,0,0],
3176         'zsh' => ['^zsh',2,'--version','zsh',1,0,0],
3177         ## Tools
3178         'clang' => ['clang',3,'--version','Clang',1,0,0],
3179         'gcc' => ['^gcc',3,'--version','GCC',1,0,0],
3180         'gcc-apple' => ['Apple[[:space:]]LLVM',2,'--version','LLVM',1,0,0],
3181         'sudo' => ['^Sudo',3,'-V','Sudo',1,1,0], # sudo pre 1.7 does not have --version
3182         );
3183         if ( defined $data{$app} ){
3184                 my $ref = $data{$app};
3185                 @client_data = @$ref;
3186         }
3187         #my $debug = main::Dumper \@client_data;
3188         main::log_data('dump',"Client Data",\@client_data) if $b_log;
3189         return @client_data;
3190 }
3191
3192 # args: 1 - desktop/app command for --version; 2 - search string; 
3193 # 3 - space print number; 4 - [optional] version arg: -v, version, etc
3194 # 5 - [optional] exit first find 0/1; 6 - [optional] 0/1 stderr output
3195 sub program_version {
3196         eval $start if $b_log;
3197         my ($app, $search, $num,$version,$exit,$b_stderr) = @_;
3198         my ($cmd,$line,$output);
3199         my $version_nu = '';
3200         my $count = 0;
3201         #print "app:$app\n";
3202         $exit ||= 100; # basically don't exit ever
3203         $version ||= '--version';
3204         # adjust to array index, not human readable
3205         $num-- if (defined $num && $num > 0);
3206         # ksh: Version JM 93t+ 2010--03-05
3207         # mksh: @(#)MIRBSD KSH R56 2018/03/09
3208         # loksh: @(#)PD KSH v5.2.14 99/07/13.2
3209         # --version opens a new ksh, sigh... This so far does not work
3210         # because the ENV/Shell variable is not visible in subshells
3211         if ($search eq 'ksh'){
3212                 my $ksh = system('echo -n $KSH_VERSION');
3213                 if ( $ksh ){
3214                         my @temp = split /\s+/, $ksh;
3215                         if ($temp[2]){
3216                                 $temp[2] =~ s/^v//i; # trim off leading v
3217                                 log_data('data',"Program *ksh array: @temp version: $temp[2]") if $b_log;
3218                                 return $temp[2];
3219                         }
3220                 }
3221                 return 0;
3222         }
3223         # konvi in particular doesn't like using $ENV{'PATH'} as set, so we need
3224         # to always assign the full path if it hasn't already been done
3225         if ( $app !~ /^\// ){
3226                 if (my $program = check_program($app) ){
3227                         $app = $program;
3228                 }
3229                 else {
3230                         log_data('data',"$app not found in path.");
3231                         return 0;
3232                 }
3233         }
3234         # note, some wm/apps send version info to stderr instead of stdout
3235         if ( $b_stderr ) {
3236                 $cmd = "$app $version 2>&1";
3237         }
3238 #       elsif ( $app eq 'csh' ){
3239 #               $app = 'tcsh';
3240 #       }
3241         # quick debian/buntu hack until I find a universal way to get version for these
3242         elsif ( $app eq 'dash' ){
3243                 $cmd = "dpkg -l $app 2>/dev/null";
3244         }
3245         else {
3246                 $cmd = "$app $version 2>/dev/null";
3247         }
3248         log_data('data',"version: $version num: $num search: $search command: $cmd") if $b_log;
3249         $output = qx($cmd);
3250         # print "$cmd : $output\n";
3251         # sample: dwm-5.8.2, ©.. etc, why no space? who knows. Also get rid of v in number string
3252         # xfce, and other, output has , in it, so dump all commas and parentheses
3253         if ($output){
3254                 open my $ch, '<', \$output or error_handler('open-data',"$cmd", "$!");
3255                 while (<$ch>){
3256                         #chomp;
3257                         last if $count > $exit;
3258                         if ( $_ =~ /$search/i ) {
3259                                 $_ = trimmer($_);
3260                                 # print "$_ ::$num\n";
3261                                 my @data = split /\s+/, $_;
3262                                 $version_nu = $data[$num];
3263                                 last if ! defined $version_nu;
3264                                 # some distros add their distro name before the version data, which 
3265                                 # breaks version detection. A quick fix attempt is to just add 1 to $num 
3266                                 # to get the next value.
3267                                 $version_nu = $data[$num+1] if $data[$num+1] && $version_nu =~ /version/i;
3268                                 $version_nu =~ s/(\([^)]+\)|,|dwm-|wmii2-|wmii-|\||\(|\))//g if $version_nu;
3269                                 # trim off leading v but only when followed by a number
3270                                 $version_nu =~ s/^v([0-9])/$1/i if $version_nu; 
3271                                 # print "$version_nu\n";
3272                                 last;
3273                         }
3274                         $count++;
3275                 }
3276                 close $ch if $ch;
3277         }
3278         log_data('data',"Program version: $version_nu") if $b_log;
3279         eval $end if $b_log;
3280         return $version_nu;
3281 }
3282 # print program_version('bash', 'bash', 4) . "\n";
3283
3284 # arg: 1 - full file path, returns array of file lines.
3285 # 2 - optionsl, strip and clean data
3286 # note: chomp has to chomp the entire action, not just <$fh>