+ # only for repos?
+ elsif (ref($val1) eq 'ARRAY'){
+ #print "eight\n";
+ $array=0;
+ foreach my $item (@$val1){
+ $array++;
+ $line = "$colors{'c1'}$array$sep{'s2'} $colors{'c2'}$item$colors{'cn'}";
+ $line = sprintf("%-${indent}s%s\n","","$line");
+ print_line($line);
+ }
+ }
+ else {
+
+ }
+ }
+ }
+ }
+}
+
+sub print_line {
+ my ($line) = @_;
+ if ($b_irc && $client{'test-konvi'}){
+ $client{'konvi'} = 3;
+ $client{'dobject'} = 'Konversation';
+ }
+ if ($client{'konvi'} == 1 && $client{'dcop'} ){
+ # konvi doesn't seem to like \n characters, it just prints them literally
+ $line =~ s/\n//g;
+ #qx('dcop "$client{'dport'}" "$client{'dobject'}" say "$client{'dserver'}" "$client{'dtarget'}" "$line 1");
+ system('dcop', $client{'dport'}, $client{'dobject'}, 'say', $client{'dserver'}, $client{'dtarget'}, "$line 1");
+ }
+ elsif ($client{'konvi'} == 3 && $client{'qdbus'} ){
+ # print $line;
+ $line =~ s/\n//g;
+ #qx(qdbus org.kde.konversation /irc say "$client{'dserver'}" "$client{'dtarget'}" "$line");
+ system('qdbus', 'org.kde.konversation', '/irc', 'say', $client{'dserver'}, $client{'dtarget'}, $line);
+ }
+ else {
+ print $line;
+ }
+}
+
+########################################################################
+#### DATA PROCESSORS
+########################################################################
+
+#### -------------------------------------------------------------------
+#### PRIMARY DATA GENERATORS
+#### -------------------------------------------------------------------
+# 0 type
+# 1 type_id
+# 2 bus_id
+# 3 sub_id
+# 4 device
+# 5 vendor_id
+# 6 chip_id
+# 7 rev
+# 8 port
+# 9 driver
+# 10 modules
+
+## AudioData
+{
+package AudioData;
+
+sub get {
+ eval $start if $b_log;
+ my (@data,@rows);
+ my $num = 0;
+ if (($b_arm || $b_mips) && !$b_soc_audio && !$b_pci_tool){
+ my $key = ($b_arm) ? 'ARM' : 'MIPS';
+ @data = ({
+ main::key($num++,$key) => main::row_defaults(lc($key) . '-pci',''),
+ },);
+ @rows = (@rows,@data);
+ }
+ else {
+ @data = card_data();
+ @rows = (@rows,@data);
+ }
+ if ( ( (($b_arm || $b_mips) && !$b_soc_audio && !$b_pci_tool) || !@rows ) &&
+ (my $file = main::system_files('asound-cards') ) ){
+ @data = asound_data($file);
+ @rows = (@rows,@data);
+ }
+ @data = usb_data();
+ @rows = (@rows,@data);
+ if (!@rows){
+ my $key = 'Message';
+ @data = ({
+ main::key($num++,$key) => main::row_defaults('pci-card-data',''),
+ },);
+ @rows = (@rows,@data);
+ }
+ @data = sound_server_data();
+ @rows = (@rows,@data);
+ eval $end if $b_log;
+ return @rows;
+}
+
+sub card_data {
+ eval $start if $b_log;
+ my (@rows,@data);
+ my ($j,$num) = (0,1);
+ foreach (@pci){
+ $num = 1;
+ my @row = @$_;
+ if ($row[0] =~ /^(audio|daudio|hdmi|multimedia)$/){
+ $j = scalar @rows;
+ my $driver = $row[9];
+ $driver ||= 'N/A';
+ my $card = $row[4];
+ $card = ($card) ? main::pci_cleaner($card,'output') : 'N/A';
+ # have seen absurdly verbose card descriptions, with non related data etc
+ if (length($card) > 85 || $size{'max'} < 110){
+ $card = main::pci_long_filter($card);
+ }
+ @data = ({
+ main::key($num++,'Card') => $card,
+ },);
+ @rows = (@rows,@data);
+ if ($extra > 2 && $b_pci_tool && $row[11]){
+ my $item = main::get_pci_vendor($row[4],$row[11]);
+ $rows[$j]{main::key($num++,'vendor')} = $item if $item;
+ }
+ $rows[$j]{main::key($num++,'driver')} = $driver;
+ if ($extra > 0 && !$bsd_type){
+ if ($row[9] ){
+ my $version = main::get_module_version($row[9]);
+ $rows[$j]{main::key($num++,'v')} = $version if $version;
+ }
+ }
+ if ($extra > 0){
+ $rows[$j]{main::key($num++,'bus ID')} = (!$row[2] && !$row[3]) ? 'N/A' : "$row[2].$row[3]";
+ }
+ if ($extra > 1){
+ $rows[$j]{main::key($num++,'chip ID')} = ($row[5]) ? "$row[5]:$row[6]" : $row[6];
+ }
+ }
+ #print "$row[0]\n";
+ }
+ #my $ref = $pci[-1];
+ #print $$ref[0],"\n";
+ eval $end if $b_log;
+ return @rows;
+}
+# this handles fringe cases where there is no card on pcibus,
+# but there is a card present. I don't know the exact architecture
+# involved but I know this situation exists on at least one old machine.
+sub asound_data {
+ eval $start if $b_log;
+ my ($file) = @_;
+ my (@asound,@rows,@data);
+ my ($card,$driver,$j,$num) = ('','',0,1);
+ @asound = main::reader($file);
+ foreach (@asound){
+ # filtering out modems and usb devices like webcams, this might get a
+ # usb audio card as well, this will take some trial and error
+ if ( !/modem|usb/i && /^\s*[0-9]/ ) {
+ $num = 1;
+ my @working = split /:\s*/, $_;
+ # now let's get 1 2
+ $working[1] =~ /(.*)\s+-\s+(.*)/;
+ $card = $2;
+ $driver = $1;
+ if ( $card ){
+ $j = scalar @rows;
+ $driver ||= 'N/A';
+ @data = ({
+ main::key($num++,'Card') => $card,
+ main::key($num++,'driver') => $driver,
+ },);
+ @rows = (@rows,@data);
+ if ($extra > 0){
+ my $version = main::get_module_version($driver);
+ $rows[$j]{main::key($num++,'v')} = $version if $version;
+ $rows[$j]{main::key($num++,'message')} = main::row_defaults('pci-advanced-data','');
+ }
+ }
+ }
+ }
+ # print Data::Dumper:Dumper \s@rows;
+ eval $end if $b_log;
+ return @rows;
+}
+sub usb_data {
+ eval $start if $b_log;
+ my (@rows,@data,@ids,$driver,$product,$product2,@temp2,$vendor,$vendor2);
+ my ($j,$num) = (0,1);
+ if (-d '/proc/asound') {
+ # note: this will double the data, but it's easier this way.
+ # inxi tested for -L in the /proc/asound files, and used only those.
+ my @files = main::globber('/proc/asound/*/usbid');
+ foreach (@files){
+ my $id = (main::reader($_))[0];
+ push @ids, $id if ($id && ! grep {/$id/} @ids);
+ }
+ # lsusb is a very expensive operation
+ if (@ids){
+ if (!$bsd_type && !$b_usb_check){
+ main::set_usb_data();
+ $b_usb_check = 1;
+ }
+ }
+ main::log_data('dump','@ids',\@ids) if $b_log;
+ return if !@usb;
+ foreach my $id (@ids){
+ $j = scalar @rows;
+ foreach my $ref (@usb){
+ my @row = @$ref;
+ # a device will always be the second or > device on the bus
+ if ($row[1] > 1 && $row[2] eq $id){
+ $num = 1;
+ # makre sure to reset, or second device trips last flag
+ ($product,$product2,$vendor,$vendor2) = ('','','','');
+ if ($usb_level == 1){
+ $product = main::cleaner($row[3]);
+ }
+ else {
+ foreach my $line (@row){
+ my @working = split /:/, $line;
+ if ($working[0] eq 'idVendor' && $working[2]){
+ $vendor = main::cleaner($working[2]);
+ }
+ if ($working[0] eq 'idProduct' && $working[2]){
+ $product = main::cleaner($working[2]);
+ }
+ if ($working[0] eq 'iManufacturer' && $working[2]){
+ $vendor2 = main::cleaner($working[2]);
+ }
+ if ($working[0] eq 'iProduct' && $working[2]){
+ $product2 = main::cleaner($working[2]);
+ }
+ if ($working[0] eq 'Descriptor_Configuration'){
+ last;
+ }
+ }
+ }
+ if ($vendor && $product){
+ $product = ($product =~ /$vendor/) ? $product: "$vendor $product" ;
+ }
+ elsif (!$product) {
+ if ($vendor && $product2){
+ $product = ($product2 =~ /$vendor/) ? $product2: "$vendor $product2" ;
+ }
+ elsif ($vendor2 && $product2){
+ $product = ($product2 =~ /$vendor2/) ? $product2: "$vendor2 $product2" ;
+ }
+ elsif ($vendor){
+ $product = $vendor;
+ }
+ elsif ($vendor2){
+ $product = $vendor2;
+ }
+ else {
+ $product = 'N/A';
+ }
+ }
+ @temp2 = main::get_usb_drivers($row[0],$row[2]) if !$bsd_type && -d "/sys/devices";
+ if (@temp2 && $temp2[0]){
+ $driver = $temp2[0];
+ }
+ $driver ||= 'snd-usb-audio';
+ @data = ({
+ main::key($num++,'Card') => $product,
+ main::key($num++,'type') => 'USB',
+ main::key($num++,'driver') => $driver,
+ },);
+ @rows = (@rows,@data);
+ if ($extra > 0){
+ $rows[$j]{main::key($num++,'bus ID')} = "$row[0]:$row[1]";
+ }
+ if ($extra > 1){
+ $rows[$j]{main::key($num++,'chip ID')} = $row[2];
+ }
+ }
+ }
+ }
+ }
+ eval $end if $b_log;
+ return @rows;
+}
+
+sub sound_server_data {
+ eval $start if $b_log;
+ my (@data,$server,$version);
+ my $num = 0;
+ if (my $file = main::system_files('asound-version') ){
+ my $content = (main::reader($file))[0];
+ # some alsa strings have the build date in (...)
+ # remove trailing . and remove possible second line if compiled by user
+# foreach (@content){
+# if (!/compile/i){
+ #$_ =~ s/Advanced Linux Sound Architecture/ALSA/;
+ $version = (split /\s+/, $content)[-1];
+ $version =~ s/\.$//; # trim off period
+ $server = 'ALSA';
+# }
+# }
+ }
+ elsif (my $program = main::check_program('oss')){
+ $server = 'OSS';
+ $version = main::program_version('oss','\S',2);
+ $version ||= 'N/A';
+ }
+ if ($server){
+ @data = ({
+ main::key($num++,'Sound Server') => $server,
+ main::key($num++,'v') => $version,
+ },);
+ }
+ eval $end if $b_log;
+ return @data;
+}
+}
+
+## BatteryData
+{
+package BatteryData;
+my (@upower_items,$b_upower,$upower);
+sub get {
+ eval $start if $b_log;
+ my (@rows,%battery,$key1,$val1);
+ my $num = 0;
+ if ($bsd_type || $b_dmidecode_force){
+ my $ref = $alerts{'dmidecode'};
+ if ( $$ref{'action'} ne 'use'){
+ $key1 = $$ref{'action'};
+ $val1 = $$ref{$key1};
+ $key1 = ucfirst($key1);
+ @rows = ({main::key($num++,$key1) => $val1,});
+ }
+ else {
+ %battery = battery_data_dmi();
+ if (!%battery){
+ if ($show{'battery-forced'}){
+ $key1 = 'Message';
+ $val1 = main::row_defaults('battery-data','');
+ @rows = ({main::key($num++,$key1) => $val1,});
+ }
+ }
+ else {
+ @rows = create_output(%battery);
+ }
+ }
+ }
+ elsif (-d '/sys/class/power_supply/'){
+ %battery = battery_data_sys();
+ if (!%battery){
+ if ($show{'battery-forced'}){
+ $key1 = 'Message';
+ $val1 = main::row_defaults('battery-data','');
+ @rows = ({main::key($num++,$key1) => $val1,});
+ }
+ }
+ else {
+ @rows = create_output(%battery);
+ }
+ }
+ else {
+ if ($show{'battery-forced'}){
+ $key1 = 'Message';
+ $val1 = main::row_defaults('battery-data-sys','');
+ @rows = ({main::key($num++,$key1) => $val1,});
+ }
+ }
+ (@upower_items,$b_upower,$upower) = undef;
+ eval $end if $b_log;
+ return @rows;
+}
+# alarm capacity capacity_level charge_full charge_full_design charge_now
+# cycle_count energy_full energy_full_design energy_now location manufacturer model_name
+# power_now present serial_number status technology type voltage_min_design voltage_now
+# 0 name - battery id, not used
+# 1 status
+# 2 present
+# 3 technology
+# 4 cycle_count
+# 5 voltage_min_design
+# 6 voltage_now
+# 7 power_now
+# 8 energy_full_design
+# 9 energy_full
+# 10 energy_now
+# 11 capacity
+# 12 capacity_level
+# 13 of_orig
+# 14 model_name
+# 15 manufacturer
+# 16 serial_number
+# 17 location
+sub create_output {
+ eval $start if $b_log;
+ my (%battery) = @_;
+ my ($key,@data,@rows);
+ my $num = 0;
+ my $j = 0;
+ # print Data::Dumper::Dumper \%battery;
+ foreach $key (sort keys %battery){
+ $num = 0;
+ my ($charge,$condition,$model,$serial,$status,$volts) = ('','','','','','');
+ my ($chemistry,$cycles,$location) = ('','','');
+ next if !$battery{$key}{'purpose'} || $battery{$key}{'purpose'} ne 'primary';
+ # $battery{$key}{''};
+ # we need to handle cases where charge or energy full is 0
+ $charge = (defined $battery{$key}{'energy_now'} && $battery{$key}{'energy_now'} ne '') ? "$battery{$key}{'energy_now'} Wh" : 'N/A';
+ if ($battery{$key}{'energy_full'} || $battery{$key}{'energy_full_design'}){
+ $battery{$key}{'energy_full_design'} ||= 'N/A';
+ $battery{$key}{'energy_full'}= (defined $battery{$key}{'energy_full'} && $battery{$key}{'energy_full'} ne '') ? $battery{$key}{'energy_full'} : 'N/A';
+ $condition = "$battery{$key}{'energy_full'}/$battery{$key}{'energy_full_design'} Wh";
+ if ($battery{$key}{'of_orig'}){
+ $condition .= " ($battery{$key}{'of_orig'}%)";
+ }
+ }
+ $condition ||= 'N/A';
+ $j = scalar @rows;
+ @data = ({
+ main::key($num++,'ID') => $key,
+ main::key($num++,'charge') => $charge,
+ main::key($num++,'condition') => $condition,
+ },);
+ @rows = (@rows,@data);
+ if ($extra > 0){
+ if ($extra > 1){
+ if ($battery{$key}{'voltage_min_design'} || $battery{$key}{'voltage_now'}){
+ $battery{$key}{'voltage_min_design'} ||= 'N/A';
+ $battery{$key}{'voltage_now'} ||= 'N/A';
+ $volts = "$battery{$key}{'voltage_now'}/$battery{$key}{'voltage_min_design'}";
+ }
+ $volts ||= 'N/A';
+ $rows[$j]{main::key($num++,'volts')} = $volts;
+ }
+ if ($battery{$key}{'manufacturer'} || $battery{$key}{'model_name'}) {
+ if ($battery{$key}{'manufacturer'} && $battery{$key}{'model_name'}){
+ $model = "$battery{$key}{'manufacturer'} $battery{$key}{'model_name'}";
+ }
+ elsif ($battery{$key}{'manufacturer'}){
+ $model = $battery{$key}{'manufacturer'};
+ }
+ elsif ($battery{$key}{'model_name'}){
+ $model = $battery{$key}{'model_name'};
+ }
+ }
+ else {
+ $model = 'N/A';
+ }
+ $rows[$j]{main::key($num++,'model')} = $model;
+ if ($extra > 2){
+ $chemistry = ( $battery{$key}{'technology'} ) ? $battery{$key}{'technology'}: 'N/A';
+ $rows[$j]{main::key($num++,'type')} = $chemistry;
+ }
+ if ($extra > 1){
+ $serial = main::apply_filter($battery{$key}{'serial_number'});
+ $rows[$j]{main::key($num++,'serial')} = $serial;
+ }
+ $status = ($battery{$key}{'status'}) ? $battery{$key}{'status'}: 'N/A';
+ $rows[$j]{main::key($num++,'status')} = $status;
+ if ($extra > 2){
+ if ($battery{$key}{'cycle_count'}){
+ $rows[$j]{main::key($num++,'cycles')} = $battery{$key}{'cycle_count'};
+ }
+ if ($battery{$key}{'location'}){
+ $rows[$j]{main::key($num++,'location')} = $battery{$key}{'location'};
+ }
+ }
+ }
+ $battery{$key} = undef;
+ }
+ # print Data::Dumper::Dumper \%battery;
+ # now if there are any devices left, print them out, excluding Mains
+ if ($extra > 0){
+ $upower = main::check_program('upower');
+ foreach $key (sort keys %battery){
+ $num = 0;
+ next if !defined $battery{$key} || $battery{$key}{'purpose'} eq 'mains';
+ my ($charge,$model,$serial,$percent,$status,$vendor) = ('','','','','','');
+ my (%upower_data);
+ $j = scalar @rows;
+ %upower_data = upower_data($key) if $upower;
+ if ($upower_data{'percent'}){
+ $charge = $upower_data{'percent'};
+ }
+ elsif ($battery{$key}{'capacity_level'} && lc($battery{$key}{'capacity_level'}) ne 'unknown'){
+ $charge = $battery{$key}{'capacity_level'};
+ }
+ else {
+ $charge = 'N/A';
+ }
+ $model = $battery{$key}{'model_name'} if $battery{$key}{'model_name'};
+ $status = ($battery{$key}{'status'} && lc($battery{$key}{'status'}) ne 'unknown') ? $battery{$key}{'status'}: 'N/A' ;
+ $vendor = $battery{$key}{'manufacturer'} if $battery{$key}{'manufacturer'};
+ if ($vendor || $model){
+ if ($vendor && $model){
+ $model = "$vendor $model";
+ }
+ elsif ($vendor){
+ $model = $vendor;
+ }
+ }
+ else {
+ $model = 'N/A';
+ }
+ @data = ({
+ main::key($num++,'Device') => $key,
+ main::key($num++,'model') => $model,
+ },);
+ @rows = (@rows,@data);
+ if ($extra > 1){
+ $serial = main::apply_filter($battery{$key}{'serial_number'});
+ $rows[$j]{main::key($num++,'serial')} = $serial;
+ }
+ $rows[$j]{main::key($num++,'charge')} = $charge;
+ if ($extra > 2 && $upower_data{'rechargeable'}){
+ $rows[$j]{main::key($num++,'rechargeable')} = $upower_data{'rechargeable'};
+ }
+ $rows[$j]{main::key($num++,'status')} = $status;
+ }
+ }
+ eval $end if $b_log;
+ return @rows;
+}
+
+# charge: mAh energy: Wh
+sub battery_data_sys {
+ eval $start if $b_log;
+ my ($b_ma,%battery,$file,$id,$item,$path,$value);
+ my $num = 0;
+ my @batteries = main::globber("/sys/class/power_supply/*");
+ # note: there is no 'location' file, but dmidecode has it
+ # 'type' is generic, like: Battery, Mains
+ # capacity_level is a string, like: Normal
+ my @items = qw(alarm capacity capacity_level charge_full charge_full_design charge_now
+ cycle_count energy_full energy_full_design energy_now location manufacturer model_name
+ power_now present serial_number status technology type voltage_min_design voltage_now);
+ foreach $item (@batteries){
+ $b_ma = 0;
+ $id = $item;
+ $id =~ s%/sys/class/power_supply/%%g;
+ my $purpose = ($id =~ /^(BAT|CMB).*$/) ? 'primary': 'device';
+ # don't create arrays of device data if it's not going to show
+ next if $extra == 0 && $purpose ne 'primary';
+ $battery{$id} = ({});
+ # NOTE: known ids: BAT[0-9] CMB[0-9]
+ $battery{$id}{'purpose'} = $purpose;
+ foreach $file (@items){
+ $path = "$item/$file";
+ $value = (-f $path) ? (main::reader($path))[0]: '';
+ # mains
+ if ($file eq 'type' && $value && lc($value) ne 'battery' ){
+ $battery{$id}{'purpose'} = 'mains';
+ }
+ if ($value){
+ if ($file eq 'voltage_min_design'){
+ $value = sprintf("%.1f", $value/1000000);
+ }
+ elsif ($file eq 'voltage_now'){
+ $value = sprintf("%.1f", $value/1000000);
+ }
+ elsif ($file eq 'energy_full_design'){
+ $value = $value/1000000;
+ }
+ elsif ($file eq 'energy_full'){
+ $value = $value/1000000;
+ }
+ elsif ($file eq 'energy_now'){
+ $value = sprintf("%.1f", $value/1000000);
+ }
+ # note: the following 3 were off, 100000 instead of 1000000
+ # why this is, I do not know. I did not document any reason for that
+ # so going on assumption it is a mistake. CHARGE is mAh, which are converted
+ # to Wh by: mAh x voltage. Note: voltage fluctuates so will make results vary slightly.
+ elsif ($file eq 'charge_full_design'){
+ $value = $value/1000000;
+ $b_ma = 1;
+ }
+ elsif ($file eq 'charge_full'){
+ $value = $value/1000000;
+ $b_ma = 1;
+ }
+ elsif ($file eq 'charge_now'){
+ $value = $value/1000000;
+ $b_ma = 1;
+ }
+ elsif ($file eq 'manufacturer'){
+ $value = main::dmi_cleaner($value);
+ }
+ elsif ($file eq 'model_name'){
+ $value = main::dmi_cleaner($value);
+ }
+ }
+ elsif ($b_root && -e $path && ! -r $path ){
+ $value = main::row_defaults('root-required');
+ }
+ $battery{$id}{$file} = $value;
+ # print "$battery{$id}{$file}\n";
+ }
+ # note:voltage_now fluctuates, which will make capacity numbers change a bit
+ # if any of these values failed, the math will be wrong, but no way to fix that
+ # tests show more systems give right capacity/charge with voltage_min_design
+ # than with voltage_now
+ if ($b_ma && $battery{$id}{'voltage_min_design'}){
+ if ($battery{$id}{'charge_now'}){
+ $battery{$id}{'energy_now'} = $battery{$id}{'charge_now'} * $battery{$id}{'voltage_min_design'};
+ }
+ if ($battery{$id}{'charge_full'}){
+ $battery{$id}{'energy_full'} = $battery{$id}{'charge_full'}*$battery{$id}{'voltage_min_design'};
+ }
+ if ($battery{$id}{'charge_full_design'}){
+ $battery{$id}{'energy_full_design'} = $battery{$id}{'charge_full_design'} * $battery{$id}{'voltage_min_design'};
+ }
+ }
+ if ( $battery{$id}{'energy_now'} && $battery{$id}{'energy_full'} ){
+ $battery{$id}{'capacity'} = 100 * $battery{$id}{'energy_now'}/$battery{$id}{'energy_full'};
+ $battery{$id}{'capacity'} = sprintf( "%.1f", $battery{$id}{'capacity'} );
+ }
+ if ( $battery{$id}{'energy_full_design'} && $battery{$id}{'energy_full'} ){
+ $battery{$id}{'of_orig'} = 100 * $battery{$id}{'energy_full'}/$battery{$id}{'energy_full_design'};
+ $battery{$id}{'of_orig'} = sprintf( "%.0f", $battery{$id}{'of_orig'} );
+ }
+ if ( $battery{$id}{'energy_now'} ){
+ $battery{$id}{'energy_now'} = sprintf( "%.1f", $battery{$id}{'energy_now'} );
+ }
+ if ( $battery{$id}{'energy_full_design'} ){
+ $battery{$id}{'energy_full_design'} = sprintf( "%.1f",$battery{$id}{'energy_full_design'} );
+ }
+ if ( $battery{$id}{'energy_full'} ){
+ $battery{$id}{'energy_full'} = sprintf( "%.1f", $battery{$id}{'energy_full'} );
+ }
+ }
+ eval $end if $b_log;
+ return %battery;
+}
+# note, dmidecode does not have charge_now or charge_full
+sub battery_data_dmi {
+ eval $start if $b_log;
+ my (%battery,$id);
+ my $i = 0;
+ foreach (@dmi){
+ my @ref = @$_;
+ # Portable Battery
+ if ($ref[0] == 22){
+ $id = "BAT$i";
+ $i++;
+ $battery{$id} = ({});
+ $battery{$id}{'purpose'} = 'primary';
+ # skip first three row, we don't need that data
+ splice @ref, 0, 3 if @ref;
+ foreach my $item (@ref){
+ my @value = split /:\s+/, $item;
+ next if !$value[0];
+ if ($value[0] eq 'Location') {$battery{$id}{'location'} = $value[1] }
+ elsif ($value[0] eq 'Manufacturer') {$battery{$id}{'manufacturer'} = main::dmi_cleaner($value[1]) }
+ elsif ($value[0] =~ /Chemistry/) {$battery{$id}{'technology'} = $value[1] }
+ elsif ($value[0] =~ /Serial Number/) {$battery{$id}{'serial_number'} = $value[1] }
+ elsif ($value[0] =~ /^Name/) {$battery{$id}{'model_name'} = main::dmi_cleaner($value[1]) }
+ elsif ($value[0] eq 'Design Capacity') {
+ $value[1] =~ s/\s*mwh$//i;
+ $battery{$id}{'energy_full_design'} = sprintf( "%.1f", $value[1]/1000);
+ }
+ elsif ($value[0] eq 'Design Voltage') {
+ $value[1] =~ s/\s*mv$//i;
+ $battery{$id}{'voltage_min_design'} = sprintf( "%.1f", $value[1]/1000);
+ }
+ }
+ if ($battery{$id}{'energy_now'} && $battery{$id}{'energy_full'} ){
+ $battery{$id}{'capacity'} = 100 * $battery{$id}{'energy_now'} / $battery{$id}{'energy_full'};
+ $battery{$id}{'capacity'} = sprintf( "%.1f%", $battery{$id}{'capacity'} );
+ }
+ if ($battery{$id}{'energy_full_design'} && $battery{$id}{'energy_full'} ){
+ $battery{$id}{'of_orig'} = 100 * $battery{$id}{'energy_full'} / $battery{$id}{'energy_full_design'};
+ $battery{$id}{'of_orig'} = sprintf( "%.0f%", $battery{$id}{'of_orig'} );
+ }
+ }
+ elsif ($ref[0] > 22){
+ last;
+ }
+ }
+ # print Data::Dumper::Dumper \%battery;
+ eval $end if $b_log;
+ return %battery;
+}
+sub upower_data {
+ my ($id) = @_;
+ eval $start if $b_log;
+ my (%data);
+ if (!$b_upower && $upower){
+ @upower_items = main::grabber("$upower -e",'','strip');
+ $b_upower = 1;
+ }
+ if ($upower && @upower_items){
+ foreach (@upower_items){
+ if ($_ =~ /$id/){
+ my @working = main::grabber("$upower -i $_",'','strip');
+ foreach my $row (@working){
+ my @temp = split /\s*:\s*/, $row;
+ if ($temp[0] eq 'percentage'){
+ $data{'percent'} = $temp[1];
+ }
+ elsif ($temp[0] eq 'rechargeable'){
+ $data{'rechargeable'} = $temp[1];
+ }
+ }
+ last;
+ }
+ }
+ }
+ eval $end if $b_log;
+ return %data;
+}
+
+}
+
+## CpuData
+{
+package CpuData;
+
+sub get {
+ eval $start if $b_log;
+ my ($type) = @_;
+ my (@data,@rows,$single,$key1,$val1);
+ my $num = 0;
+ if ($type eq 'short' || $type eq 'basic'){
+ @rows = data_short($type);
+ }
+ else {
+ @rows = create_output_full();
+ }
+ eval $end if $b_log;
+ return @rows;
+}
+sub create_output_full {
+ eval $start if $b_log;
+ my $num = 0;
+ my ($b_flags,$b_speeds,$core_speeds_value,$flag_key,@flags,%cpu,@data,@rows);
+ my $sleep = $cpu_sleep * 1000000;
+ if ($b_hires){
+ eval 'Time::HiRes::usleep( $sleep )';
+ }
+ else {
+ select(undef, undef, undef, $cpu_sleep);
+ }
+ if (my $file = main::system_files('cpuinfo')){
+ %cpu = data_cpuinfo($file,'full');
+ }
+ elsif ($bsd_type ){
+ my ($key1,$val1) = ('','');
+ if ( $alerts{'sysctl'} ){
+ if ( $alerts{'sysctl'}{'action'} eq 'use' ){
+# $key1 = 'Status';
+# $val1 = main::row_defaults('dev');
+ %cpu = data_sysctl('full');
+ }
+ else {
+ $key1 = ucfirst($alerts{'sysctl'}{'action'});
+ $val1 = $alerts{'sysctl'}{$alerts{'sysctl'}{'action'}};
+ @data = ({main::key($num++,$key1) => $val1,});
+ return @data;
+ }
+ }
+ }
+ my %properties = cpu_properties(%cpu);
+ my $type = ($properties{'cpu-type'}) ? $properties{'cpu-type'}: '';
+ my $ref = $cpu{'processors'};
+ my @processors = @$ref;
+ my @speeds = cpu_speeds(@processors);
+ my $j = scalar @rows;
+ $cpu{'model_name'} ||= 'N/A';
+ @data = ({
+ main::key($num++,'Topology') => $properties{'cpu-layout'},
+ main::key($num++,'model') => $cpu{'model_name'},
+ },);
+ @rows = (@rows,@data);
+ if ($cpu{'arm-cpus'}){
+ my $ref = $cpu{'arm-cpus'};
+ my %arm_cpus = %$ref;
+ my $i = 1;
+ my $counter = ( %arm_cpus && scalar keys %arm_cpus > 1 ) ? '-' : '';
+ foreach my $key (keys %arm_cpus){
+ $counter = '-' . $i++ if $counter;
+ $rows[$j]{main::key($num++,'variant'.$counter)} = $key;
+ }
+ }
+ $properties{'bits-sys'} ||= 'N/A';
+ $rows[$j]{main::key($num++,'bits')} = $properties{'bits-sys'};
+ if ($type){
+ $rows[$j]{main::key($num++,'type')} = $type;
+ }
+ if ($extra > 0){
+ $cpu{'arch'} ||= 'N/A';
+ $rows[$j]{main::key($num++,'arch')} = $cpu{'arch'};
+ if ( !$b_admin && $cpu{'arch'} ne 'N/A' && $cpu{'rev'} ){
+ $rows[$j]{main::key($num++,'rev')} = $cpu{'rev'};
+ }
+ }
+ if ($b_admin){
+ $rows[$j]{main::key($num++,'family')} = hex_and_decimal($cpu{'family'});
+ $rows[$j]{main::key($num++,'model-id')} = hex_and_decimal($cpu{'model_id'});
+ $rows[$j]{main::key($num++,'stepping')} = hex_and_decimal($cpu{'rev'});
+ $cpu{'microcode'} ||= 'N/A';
+ $rows[$j]{main::key($num++,'microcode')} = $cpu{'microcode'};
+ }
+ $properties{'l2-cache'} ||= 'N/A';
+ if (!$b_arm || ($b_arm && $properties{'l2-cache'} ne 'N/A')){
+ $rows[$j]{main::key($num++,'L2 cache')} = $properties{'l2-cache'};
+ }
+ if ($extra > 0 && !$show{'cpu-flag'}){
+ $j = scalar @rows;
+ @flags = split /\s+/, $cpu{'flags'} if $cpu{'flags'};
+ $flag_key = ($b_arm || $bsd_type) ? 'features': 'flags';
+ my $flag = 'N/A';
+ if (@flags){
+ # failure to read dmesg.boot: dmesg.boot permissions
+ @flags = grep {/^(dmesg.boot|lm|nx|pae|permissions|pni|svm|vmx|(sss|ss)e([2-9])?([a-z])?(_[0-9])?)$/} @flags;
+ @flags = map {s/pni/sse3/; $_} @flags;
+ @flags = sort(@flags);
+ $flag = join ' ', @flags if @flags;
+ }
+ if ($b_arm && $flag eq 'N/A'){
+ $flag = main::row_defaults('arm-cpu-f');
+ }
+ @data = ({
+ main::key($num++,$flag_key) => $flag,
+ },);
+ @rows = (@rows,@data);
+ $b_flags = 1;
+ }
+ if ($extra > 0 && !$bsd_type){
+ my $bogomips = ($cpu{'bogomips'}) ? int($cpu{'bogomips'}) : 'N/A';
+ $rows[$j]{main::key($num++,'bogomips')} = $bogomips;
+ }
+ $j = scalar @rows;
+ my $core_key = (scalar @speeds > 1) ? 'Core speeds (MHz)' : 'Core speed (MHz)';
+ my $speed_key = ($properties{'speed-key'}) ? $properties{'speed-key'}: 'Speed';
+ my $min_max = ($properties{'min-max'}) ? $properties{'min-max'}: 'N/A';
+ my $min_max_key = ($properties{'min-max-key'}) ? $properties{'min-max-key'}: 'min/max';
+ my $speed = (defined $properties{'speed'}) ? $properties{'speed'}: 'N/A';
+ # aren't able to get per core speeds in bsds yet
+ if (@speeds){
+ if (grep {$_ ne '0'} @speeds){
+ $core_speeds_value = '';
+ $b_speeds = 1;
+ }
+ else {
+ $core_speeds_value = main::row_defaults('cpu-speeds',scalar @speeds);
+ }
+ }
+ else {
+ $core_speeds_value = 'N/A';
+ }
+ $j = scalar @rows;
+ @data = ({
+ main::key($num++,$speed_key) => $speed,
+ main::key($num++,$min_max_key) => $min_max,
+ });
+ @rows = (@rows,@data);
+ if ($extra > 2){
+ my $boost = get_boost_status();
+ $rows[$j]{main::key($num++,'boost')} = $boost if $boost;
+ }
+ $rows[$j]{main::key($num++,$core_key)} = $core_speeds_value;
+ my $i = 1;
+ # if say 96 0 speed cores, no need to print all those 0s
+ if ($b_speeds){
+ foreach (@speeds){
+ $rows[$j]{main::key($num++,$i++)} = $_;
+ }
+ }
+ if ($show{'cpu-flag'} && !$b_flags){
+ $flag_key = ($b_arm || $bsd_type) ? 'Features': 'Flags';
+ @flags = split /\s+/, $cpu{'flags'} if $cpu{'flags'};
+ my $flag = 'N/A';
+ if (@flags){
+ @flags = sort(@flags);
+ $flag = join ' ', @flags if @flags;
+ }
+ @data = ({
+ main::key($num++,$flag_key) => $flag,
+ },);
+ @rows = (@rows,@data);
+ }
+ if ($b_admin && $cpu{'bugs'}){
+ my @bugs = split /\s+/, $cpu{'bugs'};
+ @bugs = sort(@bugs);
+ my $bug = join ' ', @bugs;
+ @data = ({
+ main::key($num++,'Errata') => $bug,
+ },);
+ @rows = (@rows,@data);
+ }
+ eval $end if $b_log;
+ return @rows;
+}
+sub create_output_short {
+ eval $start if $b_log;
+ my (@cpu) = @_;
+ my @data;
+ my $num = 0;
+ $cpu[1] ||= main::row_defaults('cpu-model-null');
+ $cpu[2] ||= 'N/A';
+ @data = ({
+ main::key($num++,$cpu[0]) => $cpu[1],
+ main::key($num++,'type') => $cpu[2],
+ },);
+ if ($extra > 0){
+ $data[0]{main::key($num++,'arch')} = $cpu[7];
+ }
+ $data[0]{main::key($num++,$cpu[3])} = $cpu[4];
+ if ($cpu[6]){
+ $data[0]{main::key($num++,$cpu[5])} = $cpu[6];
+ }
+ eval $end if $b_log;
+ return @data;
+}
+sub data_short {
+ eval $start if $b_log;
+ my ($type) = @_;
+ my $num = 0;
+ my (%cpu,@data,%speeds);
+ my $sys = '/sys/devices/system/cpu/cpufreq/policy0';
+ my $sleep = $cpu_sleep * 1000000;
+ if ($b_hires){
+ eval 'Time::HiRes::usleep( $sleep )';
+ }
+ else {
+ select(undef, undef, undef, $cpu_sleep);
+ }
+ # NOTE: : Permission denied, ie, this is not always readable
+ # /sys/devices/system/cpu/cpu0/cpufreq/cpuinfo_cur_freq
+ if (my $file = main::system_files('cpuinfo')){
+ %cpu = data_cpuinfo($file,$type);
+ }
+ elsif ($bsd_type ){
+ my ($key1,$val1) = ('','');
+ if ( $alerts{'sysctl'} ){
+ if ( $alerts{'sysctl'}{'action'} eq 'use' ){
+# $key1 = 'Status';
+# $val1 = main::row_defaults('dev');
+ %cpu = data_sysctl($type);
+ }
+ else {
+ $key1 = ucfirst($alerts{'sysctl'}{'action'});
+ $val1 = $alerts{'sysctl'}{$alerts{'sysctl'}{'action'}};
+ @data = ({main::key($num++,$key1) => $val1,});
+ return @data;
+ }
+ }
+ }
+ # $cpu{'cur-freq'} = $cpu[0]{'core-id'}[0]{'speed'};
+ if ($type eq 'short' || $type eq 'basic'){
+ @data = prep_short_data(%cpu);
+ }
+ if ($type eq 'basic'){
+ @data = create_output_short(@data);
+ }
+ eval $end if $b_log;
+ return @data;
+}
+
+sub prep_short_data {
+ eval $start if $b_log;
+ my (%cpu) = @_;
+ my %properties = cpu_properties(%cpu);
+ my ($cpu,$speed_key,$speed,$type) = ('','speed',0,'');
+ $cpu = $cpu{'model_name'} if $cpu{'model_name'};
+ $type = $properties{'cpu-type'} if $properties{'cpu-type'};
+ $speed_key = $properties{'speed-key'} if $properties{'speed-key'};
+ $speed = $properties{'speed'} if $properties{'speed'};
+ my @result = (
+ $properties{'cpu-layout'},
+ $cpu,
+ $type,
+ $speed_key,
+ $speed,
+ $properties{'min-max-key'},
+ $properties{'min-max'},
+ );
+ if ($extra > 0){
+ $cpu{'arch'} ||= 'N/A';
+ $result[7] = $cpu{'arch'};
+ }
+ eval $end if $b_log;
+ return @result;
+}
+
+sub data_cpuinfo {
+ eval $start if $b_log;
+ my ($file,$type)= @_;
+ my ($arch,@ids,@line,$b_first,$b_proc_int,$starter);
+ # use --arm flag when testing arm cpus
+ # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/arm/arm-4-core-pinebook-1.txt";
+ # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/arm/armv6-single-core-1.txt";
+ # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/arm/armv7-dual-core-1.txt";
+ # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/arm/armv7-new-format-model-name-single-core.txt";
+ # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/arm/arm-2-die-96-core-rk01.txt";
+ # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/amd/16-core-32-mt-ryzen.txt";
+ # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/amd/2-16-core-epyc-abucodonosor.txt";
+ # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/amd/2-core-probook-antix.txt";
+ # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/amd/4-core-jean-antix.txt";
+ # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/amd/4-core-althlon-mjro.txt";
+ # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/amd/4-core-apu-vc-box.txt";
+ # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/amd/4-core-a10-5800k-1.txt";
+ # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/intel/2-core-ht-atom-bruh.txt";
+ # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/intel/core-2-i3.txt";
+ # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/intel/8-core-i7-damentz64.txt";
+ # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/intel/2-10-core-xeon-ht.txt";
+ # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/intel/4-core-xeon-fake-dual-die-zyanya.txt";
+ # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/intel/2-core-i5-fake-dual-die-hek.txt";
+ # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/intel/2-1-core-xeon-vm-vs2017.txt";
+ # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/intel/4-1-core-xeon-vps-frodo1.txt";
+ # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/intel/4-6-core-xeon-no-mt-lathander.txt";
+ #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/mips/mips-mainusg-cpuinfo.txt";
+ my %speeds = set_cpu_speeds_sys();
+ my @cpuinfo = main::reader($file);
+ my @phys_cpus = (0);# start with 1 always
+ my ($cache,$core_count,$die_holder,$die_id,$phys_id,$proc_count,$speed) = (0,0,0,0,0,0,0);
+ my ($phys_holder) = (undef);
+ # need to prime for arm cpus, which do not have physical/core ids usually
+ # level 0 is phys id, level 1 is die id, level 2 is core id
+ #$ids[0] = ([(0)]);
+ $ids[0] = ([]);
+ $ids[0][0] = ([]);
+ my %cpu = set_cpu_data();
+ # note, there con be a lot of processors, 32 core HT would have 64, for example.
+ foreach (@cpuinfo){
+ next if /^\s*$/;
+ @line = split /\s*:\s*/, $_;
+ next if !$line[0];
+ $starter = $line[0]; # preserve case for one specific ARM issue
+ $line[0] = lc($line[0]);
+ if ($b_arm && !$b_first && $starter eq 'Processor' && $line[1] !~ /^\d+$/){
+ #print "l1:$line[1]\n";
+ $cpu{'model_name'} = main::cleaner($line[1]);
+ $cpu{'model_name'} = cpu_cleaner($cpu{'model_name'});
+ $cpu{'type'} = 'arm';
+ # Processor : AArch64 Processor rev 4 (aarch64)
+ # Processor : Feroceon 88FR131 rev 1 (v5l)
+ if ($cpu{'model_name'} && $cpu{'model_name'} =~ /(.*)\srev\s([\S]+)\s(\(([\S]+)\))?/){
+ $cpu{'model_name'} = $1;
+ $cpu{'rev'} = $2;
+ if ($4){
+ $cpu{'arch'} = $4;
+ $cpu{'model_name'} .= ' ' . $cpu{'arch'} if $cpu{'model_name'} !~ /$cpu{'arch'}/i;
+ }
+ $cpu{'processors'}[$proc_count] = 0;
+ $b_proc_int = 0;
+ $b_first = 1;
+ #print "p0:\n";
+ }
+ }
+ elsif ($line[0] eq 'processor'){
+ # this protects against double processor lines, one int, one string
+ if ($line[1] =~ /^\d+$/){
+ $b_proc_int = 1;
+ $b_first = 1;
+ $cpu{'processors'}[$proc_count] = 0;
+ $proc_count++;
+ #print "p1: $proc_count\n";
+ }
+ else {
+ if (!$b_proc_int){
+ $cpu{'processors'}[$proc_count] = 0;
+ $proc_count++;
+ #print "p2a: $proc_count\n";
+ }
+ if (!$b_first ){
+ # note: alternate:
+ # Processor : AArch64 Processor rev 4 (aarch64)
+ # but no model name type
+ if ( $b_arm || $line[1] =~ /ARM|AArch/i){
+ $b_arm = 1;
+ $cpu{'type'} = 'arm';
+ }
+ $cpu{'model_name'} = main::cleaner($line[1]);
+ $cpu{'model_name'} = cpu_cleaner($cpu{'model'});
+ #print "p2b:\n";
+ }
+ $b_first = 1;
+ }
+ }
+ elsif (!$cpu{'family'} &&
+ ($line[0] eq 'architecture' || $line[0] eq 'cpu family' || $line[0] eq 'cpu architecture' )){
+ if ($line[1] =~ /^\d+$/){
+ # translate integers to hex
+ $cpu{'family'} = uc(sprintf("%x", $line[1]));
+ }
+ elsif ($b_arm) {
+ $cpu{'arch'} = $line[1];
+ }
+ }
+ elsif (!$cpu{'rev'} && ($line[0] eq 'stepping' || $line[0] eq 'cpu revision' )){
+ $cpu{'rev'} = uc(sprintf("%x", $line[1]));
+ }
+ # this is hex so uc for cpu arch id
+ elsif (!$cpu{'model_id'} && $line[0] eq 'model' ){
+ $cpu{'model_id'} = uc(sprintf("%x", $line[1]));
+ }
+ elsif (!$cpu{'model_id'} && $line[0] eq 'cpu variant' ){
+ $cpu{'model_id'} = uc($line[1]);
+ $cpu{'model_id'} =~ s/^0X//;
+ }
+ # cpu can show in arm
+ elsif (!$cpu{'model_name'} && ( $line[0] eq 'model name' || $line[0] eq 'cpu' || $line[0] eq 'cpu model' )){
+ $cpu{'model_name'} = main::cleaner($line[1]);
+ $cpu{'model_name'} = cpu_cleaner($cpu{'model_name'});
+ if ( $b_arm || $line[1] =~ /ARM|AArch/i){
+ $b_arm = 1;
+ $cpu{'type'} = 'arm';
+ if ($cpu{'model_name'} && $cpu{'model_name'} =~ /(.*)\srev\s([\S]+)\s(\(([\S]+)\))?/){
+ $cpu{'model_name'} = $1;
+ $cpu{'rev'} = $2;
+ if ($4){
+ $cpu{'arch'} = $4;
+ $cpu{'model_name'} .= ' ' . $cpu{'arch'} if $cpu{'model_name'} !~ /$cpu{'arch'}/i;
+ }
+ #$cpu{'processors'}[$proc_count] = 0;
+ }
+ }
+ elsif ($b_mips || $line[1] =~ /mips/i){
+ $b_mips = 1;
+ $cpu{'type'} = 'mips';
+ }
+ }
+ elsif ( $line[0] eq 'cpu mhz' ){
+ $speed = speed_cleaner($line[1]);
+ $cpu{'processors'}[$proc_count-1] = $speed;
+ #$ids[$phys_id][$die_id] = ([($speed)]);
+ }
+ elsif (!$cpu{'siblings'} && $line[0] eq 'siblings' ){
+ $cpu{'siblings'} = $line[1];
+ }
+ elsif (!$cpu{'cores'} && $line[0] eq 'cpu cores' ){
+ $cpu{'cores'} = $line[1];
+ }
+ # increment by 1 for every new physical id we see. These are in almost all cases
+ # separate cpus, not separate dies within a single cpu body.
+ elsif ( $line[0] eq 'physical id' ){
+ if ( !defined $phys_holder || $phys_holder != $line[1] ){
+ # only increment if not in array counter
+ push @phys_cpus, $line[1] if ! grep {/$line[1]/} @phys_cpus;
+ $phys_holder = $line[1];
+ $ids[$phys_holder] = ([]) if ! exists $ids[$phys_holder];
+ $ids[$phys_holder][$die_id] = ([]) if ! exists $ids[$phys_holder][$die_id];
+ #print "pid: $line[1] ph: $phys_holder did: $die_id\n";
+ $die_id = 0;
+ #$die_holder = 0;
+ }
+ }
+ elsif ( $line[0] eq 'core id' ){
+ #print "ph: $phys_holder did: $die_id l1: $line[1] s: $speed\n";
+ # https://www.pcworld.com/article/3214635/components-processors/ryzen-threadripper-review-we-test-amds-monster-cpu.html
+ if ($line[1] > 0 ){
+ $die_holder = $line[1];
+ $core_count++;
+ }
+ # NOTE: this logic won't work for die detections, unforutnately.
+ # ARM uses a different /sys based method, and ryzen relies on math on the cores
+ # in process_data
+ elsif ($line[1] == 0 && $die_holder > 0 ){
+ $die_holder = $line[1];
+ $core_count = 0;
+ $die_id++ if ($cpu{'type'} ne 'intel' && $cpu{'type'} ne 'amd' );
+ }
+ $phys_holder = 0 if ! defined $phys_holder;
+ $ids[$phys_holder][$die_id][$line[1]] = $speed;
+ #print "ph: $phys_holder did: $die_id l1: $line[1] s: $speed\n";
+ }
+ if (!$cpu{'type'} && $line[0] eq 'vendor_id' ){
+ $cpu{'type'} = cpu_vendor($line[1]);
+ }
+ ## this is only for -C full cpu output
+ if ( $type eq 'full' ){
+ if (!$cpu{'l2-cache'} && $line[0] eq 'cache size'){
+ if ($line[1] =~ /(\d+)\sKB$/){
+ $cpu{'l2-cache'} = $1;
+ }
+ elsif ($line[1] =~ /(\d+)\sMB$/){
+ $cpu{'l2-cache'} = ($1*1024);
+ }
+ }
+ if (!$cpu{'flags'} && ($line[0] eq 'flags' || $line[0] eq 'features' )){
+ $cpu{'flags'} = $line[1];
+ }
+ }
+ if ( $extra > 0 && $type eq 'full' ){
+ if ($line[0] eq 'bogomips'){
+ # new arm shows bad bogomip value, so don't use it
+ $cpu{'bogomips'} += $line[1] if $line[1] > 50;
+ }
+ }
+ if ($b_admin ){
+ if ( !$cpu{'bugs'} && $line[0] eq 'bugs'){
+ $cpu{'bugs'} = $line[1];
+ }
+ # unlike family and model id, microcode appears to be hex already
+ if ( !$cpu{'microcode'} && $line[0] eq 'microcode'){
+ if ($line[1] =~ /0x/){
+ $cpu{'microcode'} = uc($line[1]);
+ $cpu{'microcode'} =~ s/^0X//;
+ }
+ else {
+ $cpu{'microcode'} = uc(sprintf("%x", $line[1]));
+ }
+ }
+ }
+ }
+ $cpu{'phys'} = scalar @phys_cpus;
+ $cpu{'dies'} = $die_id++; # count starts at 0, all cpus have 1 die at least
+ if ($b_arm){
+ if ($cpu{'dies'} <= 1){
+ my $arm_dies = cpu_dies_sys();
+ # case were 4 core arm returned 4 sibling lists, obviously wrong
+ $cpu{'dies'} = $arm_dies if $arm_dies && $proc_count != $arm_dies;
+ }
+ $cpu{'type'} = 'arm' if !$cpu{'type'};
+ if (!$bsd_type){
+ my %arm_cpus = arm_cpu_name();
+ $cpu{'arm-cpus'} = \%arm_cpus if %arm_cpus;
+ }
+ }
+ $cpu{'ids'} = (\@ids);
+ if ( $extra > 0 && !$cpu{'arch'} && $type ne 'short' ){
+ $cpu{'arch'} = cpu_arch($cpu{'type'},$cpu{'family'},$cpu{'model_id'});
+ $cpu{'arch'} = $cpu_arch if (!$cpu{'arch'} && $cpu_arch && ($b_mips || $b_arm))
+ #print "$cpu{'type'},$cpu{'family'},$cpu{'model_id'},$cpu{'arch'}\n";
+ }
+ if (!$speeds{'cur-freq'}){
+ $cpu{'cur-freq'} = $cpu{'processors'}[0];
+ $speeds{'min-freq'} = 0;
+ $speeds{'max-freq'} = 0;
+ }
+ else {
+ $cpu{'cur-freq'} = $speeds{'cur-freq'};
+ $cpu{'min-freq'} = $speeds{'min-freq'};
+ $cpu{'max-freq'} = $speeds{'max-freq'};
+ }
+ main::log_data('dump','%cpu',\%cpu) if $b_log;
+ print Data::Dumper::Dumper \%cpu if $test[8];
+ eval $end if $b_log;
+ return %cpu;
+}
+
+sub data_sysctl {
+ eval $start if $b_log;
+ my ($type) = @_;
+ my %cpu = set_cpu_data();
+ my (@ids,@line,%speeds,@working);
+ my ($sep) = ('');
+ my ($cache,$die_holder,$die_id,$phys_holder,$phys_id,$proc_count,$speed) = (0,0,0,0,0,0,0);
+ foreach (@sysctl){
+ @line = split /\s*:\s*/, $_;
+ next if ! $line[0];
+ # darwin shows machine, like MacBook7,1, not cpu
+ # machdep.cpu.brand_string: Intel(R) Core(TM)2 Duo CPU P8600 @ 2.40GHz
+ if ( ($bsd_type ne 'darwin' && $line[0] eq 'hw.model' ) || $line[0] eq 'machdep.cpu.brand_string' ){
+ # cut L2 cache/cpu max speed out of model string, if available
+ # openbsd 5.6: AMD Sempron(tm) Processor 3400+ ("AuthenticAMD" 686-class, 256KB L2 cache)
+ # freebsd 10: hw.model: AMD Athlon(tm) II X2 245 Processor
+ $line[1] = main::cleaner($line[1]);
+ $line[1] = cpu_cleaner($line[1]);
+ if ( $line[1] =~ /([0-9]+)[\-[:space:]]*([KM]B)\s+L2 cache/) {
+ my $multiplier = ($2 eq 'MB') ? 1024: 1;
+ $cpu{'l2-cache'} = $1 * $multiplier;
+ }
+ if ( $line[1] =~ /([^0-9\.][0-9\.]+)[\-[:space:]]*[MG]Hz/) {
+ $cpu{'max-freq'} = $1;
+ if ($cpu{'max-freq'} =~ /MHz/i) {
+ $cpu{'max-freq'} =~ s/[\-[:space:]]*MHz//;
+ $cpu{'max-freq'} = speed_cleaner($cpu{'max-freq'},'mhz');
+ }
+ elsif ($cpu{'max-freq'} =~ /GHz/) {
+ $cpu{'max-freq'} =~ s/[\-[:space:]]*GHz//i;
+ $cpu{'max-freq'} = $cpu{'max-freq'} / 1000;
+ $cpu{'max-freq'} = speed_cleaner($cpu{'max-freq'},'mhz');
+ }
+ }
+ if ( $line[1] =~ /\)$/ ){
+ $line[1] =~ s/\s*\(.*\)$//;
+ }
+ $cpu{'model_name'} = $line[1];
+ $cpu{'type'} = cpu_vendor($line[1]);
+ }
+ # NOTE: hw.l1icachesize: hw.l1dcachesize:
+ elsif ($line[0] eq 'hw.l1icachesize') {
+ $cpu{'l1-cache'} = $line[1]/1024;
+ }
+ elsif ($line[0] eq 'hw.l2cachesize') {
+ $cpu{'l2-cache'} = $line[1]/1024;
+ }
+ # this is in mghz in samples
+ elsif ($line[0] eq 'hw.clockrate' || $line[0] eq 'hw.cpuspeed') {
+ $cpu{'cur-freq'} = $line[1];
+ }
+ # these are in hz: 2400000000
+ elsif ($line[0] eq 'hw.cpufrequency') {
+ $cpu{'cur-freq'} = $line[1]/1000000;
+ }
+ elsif ($line[0] eq 'hw.busfrequency_min') {
+ $cpu{'min-freq'} = $line[1]/1000000;
+ }
+ elsif ($line[0] eq 'hw.busfrequency_max') {
+ $cpu{'max-freq'} = $line[1]/1000000;
+ }
+ elsif ($line[0] eq 'machdep.cpu.vendor') {
+ $cpu{'type'} = cpu_vendor($line[1]);
+ }
+ # darwin only?
+ elsif ($line[0] eq 'machdep.cpu.features') {
+ $cpu{'flags'} = lc($line[1]);
+ }
+ elsif ($line[0] eq 'hw.ncpu' ) {
+ $cpu{'cores'} = $line[1];
+ }
+ # Freebsd does some voltage hacking to actually run at lowest listed frequencies.
+ # The cpu does not actually support all the speeds output here but works in freebsd.
+ elsif ($line[0] eq 'dev.cpu.0.freq_levels') {
+ $line[1] =~ s/^\s+|\/[0-9]+|\s+$//g;
+ if ( $line[1] =~ /[0-9]+\s+[0-9]+/ ) {
+ my @temp = split /\s+/, $line[1];
+ $cpu{'max-freq'} = $temp[0];
+ $cpu{'min-freq'} = $temp[-1];
+ $cpu{'scalings'} = \@temp;
+ }
+ }
+ elsif (!$cpu{'cur-freq'} && $line[0] eq 'dev.cpu.0.freq' ) {
+ $cpu{'cur-freq'} = $line[1];
+ }
+ # the following have only been seen in DragonflyBSD data but thumbs up!
+ elsif ($line[0] eq 'hw.cpu_topology.members' ) {
+ my @temp = split /\s+/, $line[1];
+ my $count = scalar @temp;
+ $count-- if $count > 0;
+ $cpu{'processors'}[$count] = 0;
+ # no way to get per processor speeds yet, so assign 0 to each
+ foreach (0 .. $count){
+ $cpu{'processors'}[$_] = 0;
+ }
+ }
+ elsif ($line[0] eq 'hw.cpu_topology.cpu1.physical_siblings' ) {
+ # string, like: cpu0 cpu1
+ my @temp = split /\s+/, $line[1];
+ $cpu{'siblings'} = scalar @temp;
+ }
+ # increment by 1 for every new physical id we see. These are in almost all cases
+ # separate cpus, not separate dies within a single cpu body.
+ elsif ( $line[0] eq 'hw.cpu_topology.cpu0.physical_id' ){
+ if ($phys_holder != $line[1] ){
+ $phys_id++;
+ $phys_holder = $line[1];
+ $ids[$phys_id] = ([(0)]);
+ $ids[$phys_id][$die_id] = ([(0)]);
+ }
+ }
+ elsif ( $line[0] eq 'hw.cpu_topology.cpu0.core_id' ){
+ if ($line[1] > 0 ){
+ $die_holder = $line[1];
+ }
+ # this handles multi die cpus like 16 core ryzen
+ elsif ($line[1] == 0 && $die_holder > 0 ){
+ $die_id++ ;
+ $die_holder = $line[1];
+ }
+ $ids[$phys_id][$die_id][$line[1]] = $speed;
+ $cpu{'dies'} = $die_id;
+ }
+ }
+ if (!$cpu{'flags'}){
+ $cpu{'flags'} = cpu_flags_bsd();
+ }
+ main::log_data('dump','%cpu',\%cpu) if $b_log;
+ print Data::Dumper::Dumper \%cpu if $test[8];
+ eval $end if $b_log;
+ return %cpu;
+}
+
+sub cpu_properties {
+ my (%cpu) = @_;
+ my ($b_amd_zen,$b_epyc,$b_ht,$b_intel,$b_ryzen,$b_xeon);
+ if ($cpu{'type'} ){
+ if ($cpu{'type'} eq 'intel'){
+ $b_intel = 1;
+ $b_xeon = 1 if $cpu{'model_name'} =~ /Xeon/i;
+ }
+ elsif ($cpu{'type'} eq 'amd' ){
+ if ( $cpu{'family'} && $cpu{'family'} eq '17' ) {
+ $b_amd_zen = 1;
+ if ($cpu{'model_name'} ){
+ if ($cpu{'model_name'} =~ /Ryzen/i ){
+ $b_ryzen = 1;
+ }
+ elsif ($cpu{'model_name'} =~ /EPYC/i){
+ $b_epyc = 1;
+ }
+ }
+ }
+ }
+ }
+ #my @dies = $phys[0][0];
+ my $ref = $cpu{'ids'};
+ my @phys = @$ref;
+ my $phyical_count = 0;
+ #my $phyical_count = scalar @phys;
+ my @processors;
+ my ($speed,$speed_key);
+ # handle case where cpu reports say, phys id 0, 2, 4, 6 [yes, seen it]
+ foreach (@phys) {
+ $phyical_count++ if $_;
+ }
+ $phyical_count ||= 1; # assume 1 if no id found, as with ARM
+ # count unique processors ##
+ # note, this fails for intel cpus at times
+ $ref = $cpu{'processors'};
+ @processors = @$ref;
+ #print ref $cpu{'processors'}, "\n";
+ my $processors_count = scalar @processors;
+ #print "p count:$processors_count\n";
+ #print Data::Dumper::Dumper \@processors;
+ # $cpu_cores is per physical cpu
+ my ($cpu_layout,$cpu_type,$min_max,$min_max_key) = ('','','','');
+ my ($cache,$core_count,$cpu_cores,$die_count) = (0,0,0,0);
+ foreach my $die_ref ( @phys ){
+ next if ! $die_ref;
+ my @dies = @$die_ref;
+ $core_count = 0;
+ $die_count = scalar @dies;
+ #$cpu{'dies'} = $die_count;
+ foreach my $core_ref (@dies){
+ next if ref $core_ref ne 'ARRAY';
+ my @cores = @$core_ref;
+ $core_count = 0;# reset for each die!!
+ # NOTE: the counters can be undefined because the index comes from
+ # core id: which can be 0 skip 1 then 2, which leaves index 1 undefined
+ # arm cpus do not actually show core id so ignore that counter
+ foreach my $id (@cores){
+ $core_count++ if defined $id && !$b_arm;
+ }
+ #print 'cores: ' . $core_count, "\n";
+ }
+ }
+ # this covers potentially cases where ARM cpus have > 1 die
+ $cpu{'dies'} = ($b_arm && $die_count <= 1 && $cpu{'dies'} > 1) ? $cpu{'dies'}: $die_count;
+ # this is an attempt to fix the amd family 15 bug with reported cores vs actual cores
+ # NOTE: amd A6-4400M APU 2 core reports: cores: 1 siblings: 2
+ # NOTE: AMD A10-5800K APU 4 core reports: cores: 2 siblings: 4
+ if ($cpu{'cores'} && ! $core_count || $cpu{'cores'} >= $core_count){
+ $cpu_cores = $cpu{'cores'};
+ }
+ elsif ($core_count > $cpu{'cores'}){
+ $cpu_cores = $core_count;
+ }
+ #print "cpu-c:$cpu_cores\n";
+ #$cpu_cores = $cpu{'cores'};
+ # like, intel core duo
+ # NOTE: sadly, not all core intel are HT/MT, oh well...
+ # xeon may show wrong core / physical id count, if it does, fix it. A xeon
+ # may show a repeated core id : 0 which gives a fake num_of_cores=1
+ if ($b_intel){
+ if ($cpu{'siblings'} && $cpu{'siblings'} > 1 && $cpu{'cores'} && $cpu{'cores'} > 1 ){
+ if ( $cpu{'siblings'}/$cpu{'cores'} == 1 ){
+ $b_intel = 0;
+ $b_ht = 0;
+ }
+ else {
+ $cpu_cores = ($cpu{'siblings'}/2);
+ $b_ht = 1;
+ }
+ }
+ }
+ # ryzen is made out of blocks of 8 core dies
+ elsif ($b_ryzen){
+ $cpu_cores = $cpu{'cores'};
+ # note: posix ceil isn't present in Perl for some reason, deprecated?
+ my $working = $cpu_cores / 8;
+ my @temp = split /\./, $working;
+ $cpu{'dies'} = ($temp[1] && $temp[1] > 0) ? $temp[0]++ : $temp[0];
+ }
+ # these always have 4 dies
+ elsif ($b_epyc) {
+ $cpu_cores = $cpu{'cores'};
+ $cpu{'dies'} = 4;
+ }
+ # final check, override the num of cores value if it clearly is wrong
+ # and use the raw core count and synthesize the total instead of real count
+ if ( $cpu_cores == 0 && ($cpu{'cores'} * $phyical_count > 1)){
+ $cpu_cores = ($cpu{'cores'} * $phyical_count);
+ }
+ # last check, seeing some intel cpus and vms with intel cpus that do not show any
+ # core id data at all, or siblings.
+ if ($cpu_cores == 0 && $processors_count > 0){
+ $cpu_cores = $processors_count;
+ }
+ # this happens with BSDs which have very little cpu data available
+ if ( $processors_count == 0 && $cpu_cores > 0 ){
+ $processors_count = $cpu_cores;
+ if ($bsd_type && ($b_ht || $b_amd_zen) && $cpu_cores > 2 ){
+ $cpu_cores = $cpu_cores/2;;
+ }
+ my $count = $processors_count;
+ $count-- if $count > 0;
+ $cpu{'processors'}[$count] = 0;
+ # no way to get per processor speeds yet, so assign 0 to each
+ # must be a numeric value. Could use raw speed from core 0, but
+ # that would just be a hack.
+ foreach (0 .. $count){
+ $cpu{'processors'}[$_] = 0;
+ }
+ }
+ # last test to catch some corner cases
+ # seen a case where a xeon vm in a dual xeon system actually had 2 cores, no MT
+ # so it reported 4 siblings, 2 cores, but actually only had 1 core per virtual cpu
+ #print "prc: $processors_count phc: $phyical_count coc: $core_count cpc: $cpu_cores\n";
+ if (!$b_arm && $processors_count == $phyical_count*$core_count && $cpu_cores > $core_count){
+ $b_ht = 0;
+ #$b_xeon = 0;
+ $b_intel = 0;
+ $cpu_cores = 1;
+ $core_count = 1;
+ $cpu{'siblings'} = 1;
+ }
+ #print "pc: $processors_count s: $cpu{'siblings'} cpuc: $cpu_cores corec: $core_count\n";
+ # Algorithm:
+ # if > 1 processor && processor id (physical id) == core id then Multi threaded (MT)
+ # if siblings > 1 && siblings == 2 * num_of_cores ($cpu{'cores'}) then Multi threaded (MT)
+ # if > 1 processor && processor id (physical id) != core id then Multi-Core Processors (MCP)
+ # if > 1 processor && processor ids (physical id) > 1 then Symmetric Multi Processing (SMP)
+ # if = 1 processor then single core/processor Uni-Processor (UP)
+ if ( $processors_count > 1 || ( $b_intel && $cpu{'siblings'} > 0 ) ) {
+ # non-multicore MT
+ if ($processors_count == ($phyical_count * $cpu_cores * 2)){
+ #print "mt:1\n";
+ $cpu_type .= 'MT';
+ }
+# elsif ($b_xeon && $cpu{'siblings'} > 1){
+# #print "mt:2\n";
+# $cpu_type .= 'MT';
+# }
+ elsif ($cpu{'siblings'} > 1 && ($cpu{'siblings'} == 2 * $cpu_cores )){
+ #print "mt:3\n";
+ $cpu_type .= 'MT';
+ }
+ # non-MT multi-core or MT multi-core
+ if ( ($processors_count == $cpu_cores ) || ($phyical_count < $cpu_cores)){
+ my $sep = ($cpu_type) ? ' ' : '' ;
+ $cpu_type .= $sep . 'MCP';
+ }
+ # only solidly known > 1 die cpus will use this, ryzen and arm for now
+ if ( $cpu{'dies'} > 1 ){
+ my $sep = ($cpu_type) ? ' ' : '' ;
+ $cpu_type .= $sep . 'MCM';
+ }
+ # >1 cpu sockets active: Symetric Multi Processing
+ if ($phyical_count > 1){
+ my $sep = ($cpu_type) ? ' ' : '' ;
+ $cpu_type .= $sep . 'SMP';
+ }
+ }
+ else {
+ $cpu_type = 'UP';
+ }
+ if ($phyical_count > 1){
+ $cpu_layout = $phyical_count . 'x ';
+ }
+ $cpu_layout .= count_alpha($cpu_cores) . 'Core';
+ $cpu_layout .= ' (' . $cpu{'dies'}. '-Die)' if !$bsd_type && $cpu{'dies'} > 1;
+ # the only possible change for bsds is if we can get phys counts in the future
+ if ($bsd_type){
+ $cache = $cpu{'l2-cache'} * $phyical_count;
+ }
+ # AMD SOS chips appear to report full L2 cache per core
+ elsif ($cpu{'type'} eq 'amd' && ($cpu{'family'} eq '14' || $cpu{'family'} eq '15' || $cpu{'family'} eq '16')){
+ $cache = $cpu{'l2-cache'} * $phyical_count;
+ }
+ elsif ($cpu{'type'} ne 'intel'){
+ $cache = $cpu{'l2-cache'} * $cpu_cores * $phyical_count;
+ }
+ ## note: this handles how intel reports L2, total instead of per core like AMD does
+ # note that we need to multiply by number of actual cpus here to get true cache size
+ else {
+ $cache = $cpu{'l2-cache'} * $phyical_count;
+ }
+ if ($cache > 10000){
+ $cache = sprintf("%.01f MiB",$cache/1024); # trim to no decimals?
+ }
+ elsif ($cache > 0){
+ $cache = "$cache KiB";
+ }
+ if ($cpu{'cur-freq'} && $cpu{'min-freq'} && $cpu{'max-freq'} ){
+ $min_max = "$cpu{'min-freq'}/$cpu{'max-freq'} MHz";
+ $min_max_key = "min/max";
+ $speed_key = ($show{'short'} || $show{'cpu-basic'}) ? 'speed' : 'Speed';
+ $speed = "$cpu{'cur-freq'} MHz";
+ }
+ elsif ($cpu{'cur-freq'} && $cpu{'max-freq'}){
+ $min_max = "$cpu{'max-freq'} MHz";
+ $min_max_key = "max";
+ $speed_key = ($show{'short'} || $show{'cpu-basic'}) ? 'speed' : 'Speed';
+ $speed = "$cpu{'cur-freq'} MHz";
+ }
+# elsif ($cpu{'cur-freq'} && $cpu{'max-freq'} && $cpu{'cur-freq'} == $cpu{'max-freq'}){
+# $speed_key = ($show{'short'} || $show{'cpu-basic'}) ? 'speed' : 'Speed';
+# $speed = "$cpu{'cur-freq'} MHz (max)";
+# }
+ elsif ($cpu{'cur-freq'} && $cpu{'min-freq'}){
+ $min_max = "$cpu{'min-freq'} MHz";
+ $min_max_key = "min";
+ $speed_key = ($show{'short'} || $show{'cpu-basic'}) ? 'speed' : 'Speed';
+ $speed = "$cpu{'cur-freq'} MHz";
+ }
+ elsif ($cpu{'cur-freq'} && !$cpu{'max-freq'}){
+ $speed_key = ($show{'short'} || $show{'cpu-basic'}) ? 'speed' : 'Speed';
+ $speed = "$cpu{'cur-freq'} MHz";
+ }
+
+ if ( !$bits_sys && !$b_arm && $cpu{'flags'} ){
+ $bits_sys = ($cpu{'flags'} =~ /\blm\b/) ? 64 : 32;
+ }
+ my %cpu_properties = (
+ 'bits-sys' => $bits_sys,
+ 'cpu-layout' => $cpu_layout,
+ 'cpu-type' => $cpu_type,
+ 'min-max-key' => $min_max_key,
+ 'min-max' => $min_max,
+ 'speed-key' => $speed_key,
+ 'speed' => $speed,
+ 'l2-cache' => $cache,
+ );
+ main::log_data('dump','%cpu_properties',\%cpu_properties) if $b_log;
+ #print Data::Dumper::Dumper \%cpu;
+ #print Data::Dumper::Dumper \%cpu_properties;
+ #my $dc = scalar @dies;
+ #print 'phys: ' . $pc . ' dies: ' . $dc, "\n";
+ eval $end if $b_log;
+ return %cpu_properties;
+}
+sub cpu_speeds {
+ eval $start if $b_log;
+ my (@processors) = @_;
+ my (@speeds);
+ my @files = main::globber('/sys/devices/system/cpu/cpu*/cpufreq/scaling_cur_freq');
+ foreach (@files){
+ my $speed = (main::reader($_))[0];
+ if ($speed || $speed eq '0'){
+ $speed = sprintf "%.0f", $speed/1000;
+ push @speeds, $speed;
+ }
+ }
+ if (!@speeds){
+ foreach (@processors){
+ if ($_ || $_ eq '0'){
+ $_ = sprintf "%.0f", $_;
+ push @speeds, $_;
+ }
+ }
+ }
+ #print join '; ', @speeds, "\n";
+ eval $end if $b_log;
+ return @speeds;
+}
+sub set_cpu_speeds_sys {
+ eval $start if $b_log;
+ my (@arm,%speeds);
+ my $sys = '/sys/devices/system/cpu/cpufreq/policy0';
+ my $sys2 = '/sys/devices/system/cpu/cpu0/cpufreq/';
+ my ($cur,$min,$max) = ('scaling_cur_freq','scaling_min_freq','scaling_max_freq');
+ if (!-d $sys && -d $sys2){
+ $sys = $sys2;
+ ($cur,$min,$max) = ('scaling_cur_freq','cpuinfo_min_freq','cpuinfo_max_freq');
+ }
+ if (-d $sys){
+ $speeds{'cur-freq'} = (main::reader("$sys/$cur"))[0];
+ $speeds{'cur-freq'} = speed_cleaner($speeds{'cur-freq'},'khz');
+ $speeds{'min-freq'} = (main::reader("$sys/$min"))[0];
+ $speeds{'min-freq'} = speed_cleaner($speeds{'min-freq'},'khz');
+ $speeds{'max-freq'} = (main::reader("$sys/$max"))[0];
+ $speeds{'max-freq'} = speed_cleaner($speeds{'max-freq'},'khz');
+ if ($b_arm){
+ @arm = main::globber('/sys/devices/system/cpu/cpufreq/policy*/');
+ # there are arm chips with two dies, that run at different min max speeds!!
+ # see: https://github.com/smxi/inxi/issues/128
+ # it would be slick to show both die min/max/cur speeds, but this is
+ # ok for now.
+ if (scalar @arm > 1){
+ my ($current,$max,$min) = (0,0,0);
+ foreach (@arm){
+ $_ =~ s/\/$//; # strip off last slash in case globs have them
+ my $max_temp = main::reader("$_/cpuinfo_max_freq");
+ $max_temp = speed_cleaner($max_temp,'khz');
+ if ($max_temp > $max){
+ $max = $max_temp;
+ }
+ my $min_temp = main::reader("$_/cpuinfo_min_freq");
+ $min_temp = speed_cleaner($min_temp,'khz');
+ if ($min_temp < $min || $min == 0){
+ $max = $min_temp;
+ }
+ my $cur_temp = main::reader("$_/cpuinfo_max_freq");
+ $cur_temp = speed_cleaner($cur_temp,'khz');
+ if ($cur_temp > $current){
+ $current = $cur_temp;
+ }
+ }
+ $speeds{'cur-freq'} = $current if $current;
+ $speeds{'max-freq'} = $max if $max;
+ $speeds{'min-freq'} = $min if $min;
+ }
+ }
+ # policy4/cpuinfo_max_freq:["2000000"]
+ # policy4/cpuinfo_min_freq:["200000"]
+ if ($speeds{'min-freq'} > $speeds{'max-freq'} || $speeds{'min-freq'} == $speeds{'max-freq'}){
+ $speeds{'min-freq'} = 0;
+ }
+ }
+ main::log_data('dump','%speeds',\%speeds) if $b_log;
+ eval $end if $b_log;
+ return %speeds;
+}
+
+# right now only using this for ARM cpus, this is not the same in intel/amd
+sub cpu_dies_sys {
+ eval $start if $b_log;
+ my @data = main::globber('/sys/devices/system/cpu/cpu*/topology/core_siblings_list');
+ my (@dies);
+ foreach (@data){
+ my $siblings = (main::reader($_))[0];
+ if (! grep {/$siblings/} @dies){
+ push @dies, $siblings;
+ }
+ }
+ my $die_count = scalar @dies;
+ eval $end if $b_log;
+ return $die_count;
+}
+sub cpu_flags_bsd {
+ eval $start if $b_log;
+ my ($flags,$sep) = ('','');
+ # this will be null if it was not readable
+ my $file = main::system_files('dmesg-boot');
+ if ( @dmesg_boot){
+ foreach (@dmesg_boot){
+ if ( /Features/ || ( $bsd_type eq "openbsd" && /^cpu0:\s*[a-z0-9]{2,3}(\s|,)[a-z0-9]{2,3}(\s|,)/i ) ) {
+ my @line = split /:\s*/, lc($_);
+ # free bsd has to have weird syntax: <....<b23>,<b34>>
+ # Features2=0x1e98220b<SSE3,PCLMULQDQ,MON,SSSE3,CX16,SSE4.1,SSE4.2,POPCNT,AESNI,XSAVE,OSXSAVE,AVX>
+ $line[1] =~ s/^[^<]*<|>[^>]*$//g;
+ # then get rid of <b23> stuff
+ $line[1] =~ s/<[^>]+>//g;
+ # and replace commas with spaces
+ $line[1] =~ s/,/ /g;
+ $flags .= $sep . $line[1];
+ $sep = ' ';
+ }
+ elsif (/real mem/){
+ last;
+ }
+ }
+ if ($flags){
+ $flags =~ s/\s+/ /g;
+ $flags =~ s/^\s+|\s+$//g;
+ }
+ }
+ else {
+ if ( $file && ! -r $file ){
+ $flags = main::row_defaults('dmesg-boot-permissions');
+ }
+ }
+ eval $end if $b_log;
+ return $flags;
+}
+
+sub cpu_vendor {
+ eval $start if $b_log;
+ my ($string) = @_;
+ my ($vendor) = ('');
+ $string = lc($string);
+ if ($string =~ /intel/) {
+ $vendor = "intel"
+ }
+ elsif ($string =~ /amd/){
+ $vendor = "amd"
+ }
+ # via
+ elsif ($string =~ /centaur/){
+ $vendor = "centaur"
+ }
+ eval $end if $b_log;
+ return $vendor;
+}
+sub get_boost_status {
+ eval $start if $b_log;
+ my ($boost);
+ my $path = '/sys/devices/system/cpu/cpufreq/boost';
+ if (-f $path){
+ $boost = (main::reader($path))[0];
+ if (defined $boost && $boost =~/^[01]$/){
+ $boost = ($boost) ? 'enabled' : 'disabled';
+ }
+ }
+ eval $end if $b_log;
+ return $boost;
+}
+sub arm_cpu_name {
+ eval $start if $b_log;
+ my (%cpus,$compat);
+ if ( -e '/sys/firmware/devicetree/base/cpus/cpu@1/compatible' ){
+ my @working = main::globber('/sys/firmware/devicetree/base/cpus/cpu@*/compatible');
+ foreach my $file (@working){
+ $compat = (main::reader($file))[0];
+ # these can have non printing ascii... why? As long as we only have the
+ # splits for: null 00/start header 01/start text 02/end text 03
+ $compat = (split /\x01|\x02|\x03|\x00/, $compat)[0] if $compat;
+ $compat = (split /,\s*/, $compat)[-1] if $compat;
+ $cpus{$compat} = ($cpus{$compat}) ? ++$cpus{$compat}: 1;
+ }
+ }
+ main::log_data('dump','%cpus',\%cpus) if $b_log;
+ eval $end if $b_log;
+ return %cpus;
+}
+
+sub cpu_arch {
+ eval $start if $b_log;
+ my ($type,$family,$model) = @_;
+ my $arch = '';
+ # https://en.wikipedia.org/wiki/List_of_AMD_CPU_microarchitectures
+ # print "$type;$family;$model\n";
+ if ( $type eq 'amd'){
+ if ($family eq '4'){
+ if ( $model =~ /^(3|7|8|9|A)$/ ) {$arch = 'Am486'}
+ elsif ( $model =~ /^(E|F)$/ ) {$arch = 'Am5x86'}
+ }
+ elsif ($family eq '5'){
+ if ( $model =~ /^(0|1|2|3)$/ ) {$arch = 'K5'}
+ elsif ( $model =~ /^(6|7)$/ ) {$arch = 'K6'}
+ elsif ( $model =~ /^(8)$/ ) {$arch = 'K6-2'}
+ elsif ( $model =~ /^(9|D)$/ ) {$arch = 'K6-3'}
+ elsif ( $model =~ /^(A)$/ ) {$arch = 'Geode'}
+ }
+ elsif ($family eq '6'){
+ if ( $model =~ /^(1|2)$/ ) {$arch = 'K7'}
+ elsif ( $model =~ /^(3|4)$/ ) {$arch = 'K7 Thunderbird'}
+ elsif ( $model =~ /^(6|7|8|A)$/ ) {$arch = 'K7 Palomino+'}
+ else {$arch = 'K7'}
+ }
+ elsif ($family eq 'F'){
+ if ( $model =~ /^(4|5|7|8|B|C|E|F|14|15|17|18|1B|1C|1F)$/ ) {$arch = 'K8'}
+ elsif ( $model =~ /^(21|23|24|25|27|28|2C|2F)$/ ) {$arch = 'K8 rev.E'}
+ elsif ( $model =~ /^(41|43|48|4B|4C|4F|5D|5F|68|6B|6C|6F|7C|7F|C1)$/ ) {$arch = 'K8 rev.F+'}
+ else {$arch = 'K8'}
+ }
+ elsif ($family eq '10'){
+ if ( $model =~ /^(2|4|5|6|8|9|A)$/ ) {$arch = 'K10'}
+ else {$arch = 'K10'}
+ }
+ elsif ($family eq '11'){
+ if ( $model =~ /^(3)$/ ) {$arch = 'Turion X2 Ultra'}
+ }
+ # might also need cache handling like 14/16
+ elsif ($family eq '12'){
+ if ( $model =~ /^(1)$/ ) {$arch = 'Fusion'}
+ else {$arch = 'Fusion'}
+ }
+ # SOC, apu
+ elsif ($family eq '14'){
+ if ( $model =~ /^(1|2)$/ ) {$arch = 'Bobcat'}
+ else {$arch = 'Bobcat'}
+ }
+ elsif ($family eq '15'){
+ if ( $model =~ /^(0|1|2|3|4|5|6|7|8|9|A|B|C|D|E|F)$/ ) {$arch = 'Bulldozer'}
+ elsif ( $model =~ /^(10|11|12|13|14|15|16|17|18|19|1A|1B|1C|1D|1E|1F)$/ ) {$arch = 'Piledriver'}
+ elsif ( $model =~ /^(30|31|32|33|34|35|36|37|38|39|3A|3B|3C|3D|3E|3F)$/ ) {$arch = 'Steamroller'}
+ elsif ( $model =~ /^(60|61|62|63|64|65|66|67|68|69|6A|6B|6C|6D|6E|6F|70|71|72|73|74|75|76|77|78|79|7A|7B|7C|7D|7E|7F)$/ ) {$arch = 'Excavator'}
+ else {$arch = 'Bulldozer'}
+ }
+ # SOC, apu
+ elsif ($family eq '16'){
+ if ( $model =~ /^(0|1|2|3|4|5|6|7|8|9|A|B|C|D|E|F)$/ ) {$arch = 'Jaguar'}
+ elsif ( $model =~ /^(30|31|32|33|34|35|36|37|38|39|3A|3B|3C|3D|3E|3F)$/ ) {$arch = 'Puma'}
+ else {$arch = 'Jaguar'}
+ }
+ elsif ($family eq '17'){
+ if ( $model =~ /^(1)$/ ) {$arch = 'Zen'}
+ else {$arch = 'Zen'}
+ }
+ }
+ elsif ( $type eq 'arm'){
+ if ($family ne ''){$arch="ARMv$family";}
+ else {$arch='ARM';}
+ }
+ # aka VIA
+ elsif ( $type eq 'centaur'){
+ if ($family eq '5'){
+ if ( $model =~ /^(4)$/ ) {$arch = 'WinChip C6'}
+ elsif ( $model =~ /^(8)$/ ) {$arch = 'WinChip 2'}
+ elsif ( $model =~ /^(9)$/ ) {$arch = 'WinChip 3'}
+ }
+ elsif ($family eq '6'){
+ if ( $model =~ /^(6)$/ ) {$arch = 'WinChip-based'}
+ elsif ( $model =~ /^(7|8)$/ ) {$arch = 'C3'}
+ elsif ( $model =~ /^(9)$/ ) {$arch = 'C3-2'}
+ elsif ( $model =~ /^(A|D)$/ ) {$arch = 'C7'}
+ elsif ( $model =~ /^(F)$/ ) {$arch = 'Isaiah'}
+ }
+ }
+ # https://software.intel.com/en-us/articles/intel-architecture-and-processor-identification-with-cpuid-model-and-family-numbers
+ elsif ( $type eq 'intel'){
+ if ($family eq '4'){
+ if ( $model =~ /^(0|1|2|3|4|5|6|7|8|9)$/ ) {$arch = '486'}
+ }
+ elsif ($family eq '5'){
+ if ( $model =~ /^(1|2|3|7)$/ ) {$arch = 'P5'}
+ elsif ( $model =~ /^(4|8)$/ ) {$arch = 'P5'} # MMX
+ elsif ( $model =~ /^(9)$/ ) {$arch = 'Quark'}
+ }
+ elsif ($family eq '6'){
+ if ( $model =~ /^(1)$/ ) {$arch = 'P6 Pro'}
+ elsif ( $model =~ /^(15)$/ ) {$arch = 'Dothan Tolapai'} # pentium M system on chip
+ elsif ( $model =~ /^(3)$/ ) {$arch = 'P6 II Klamath'}
+ elsif ( $model =~ /^(5)$/ ) {$arch = 'P6 II Deschutes'}
+ elsif ( $model =~ /^(6)$/ ) {$arch = 'P6 II Mendocino'}
+ elsif ( $model =~ /^(7)$/ ) {$arch = 'P6 III Katmai'}
+ elsif ( $model =~ /^(8)$/ ) {$arch = 'P6 III Coppermine'}
+ elsif ( $model =~ /^(9)$/ ) {$arch = 'Banias'} # pentium M
+ elsif ( $model =~ /^(A)$/ ) {$arch = 'P6 III Xeon'}
+ elsif ( $model =~ /^(B)$/ ) {$arch = 'P6 III Tualitin'}
+ elsif ( $model =~ /^(D)$/ ) {$arch = 'Dothan'} # Pentium M
+ elsif ( $model =~ /^(E)$/ ) {$arch = 'Yonah'}
+ elsif ( $model =~ /^(F|16)$/ ) {$arch = 'Merom'}
+ elsif ( $model =~ /^(17|1D)$/ ) {$arch = 'Penryn'}
+ elsif ( $model =~ /^(1A|1E|1F|2E|25|2C|2F)$/ ) {$arch = 'Nehalem'}
+ elsif ( $model =~ /^(1C)$/ ) {$arch = 'Bonnell'} # atom Bonnell? 27?
+ elsif ( $model =~ /^(27|35)$/ ) {$arch = 'Saltwell'}
+ elsif ( $model =~ /^(25|2C|2F)$/ ) {$arch = 'Westmere'}
+ elsif ( $model =~ /^(26)$/ ) {$arch = 'Atom Lincroft'}
+ elsif ( $model =~ /^(2A|2D)$/ ) {$arch = 'Sandy Bridge'}
+ elsif ( $model =~ /^(36)$/ ) {$arch = 'Atom Cedarview'}
+ elsif ( $model =~ /^(37|4A|4D|5A)$/ ) {$arch = 'Silvermont'}
+ elsif ( $model =~ /^(3A|3E)$/ ) {$arch = 'Ivy Bridge'}
+ elsif ( $model =~ /^(3C|3F|45|46)$/ ) {$arch = 'Haswell'}
+ elsif ( $model =~ /^(3D|47|4F|56)$/ ) {$arch = 'Broadwell'}
+ elsif ( $model =~ /^(4E|55|9E)$/ ) {$arch = 'Skylake'}
+ elsif ( $model =~ /^(5E)$/ ) {$arch = 'Skylake-S'}
+ elsif ( $model =~ /^(4C|5D)$/ ) {$arch = 'Airmont'}
+ elsif ( $model =~ /^(8E|9E)$/ ) {$arch = 'Kaby Lake'}
+ elsif ( $model =~ /^(57)$/ ) {$arch = 'Knights Landing'}
+ elsif ( $model =~ /^(85)$/ ) {$arch = 'Knights Mill'}
+ # product codes: https://en.wikipedia.org/wiki/List_of_Intel_microprocessors
+ # coming: coffee lake; cannonlake; icelake; tigerlake
+ }
+ # itanium 1 family 7 all recalled
+ elsif ($family eq 'B'){
+ if ( $model =~ /^(1)$/ ) {$arch = 'Knights Corne'}
+ }
+ elsif ($family eq 'F'){
+ if ( $model =~ /^(0|1)$/ ) {$arch = 'Netburst Willamette'}
+ elsif ( $model =~ /^(2)$/ ) {$arch = 'Netburst Northwood'}
+ elsif ( $model =~ /^(3)$/ ) {$arch = 'Prescott'} # 6? Nocona
+ elsif ( $model =~ /^(4)$/ ) {$arch = 'Smithfield'} # 6? Nocona
+ elsif ( $model =~ /^(6)$/ ) {$arch = 'Presler'}
+ else {$arch = 'Netburst'}
+ }
+ }
+ eval $end if $b_log;
+ return $arch;
+}
+
+sub count_alpha {
+ my ($count) = @_;
+ #print "$count\n";
+ my @alpha = qw(Single Dual Triple Quad);
+ if ($count > 4){
+ $count .= '-';
+ }
+ else {
+ $count = $alpha[$count-1] . ' ' if $count > 0;
+ }
+ return $count;
+}
+sub set_cpu_data {
+ my %cpu = (
+ 'arch' => '',
+ 'bogomips' => 0,
+ 'cores' => 0,
+ 'cur-freq' => 0,
+ 'dies' => 0,
+ 'family' => '',
+ 'flags' => '',
+ 'ids' => [],
+ 'l1-cache' => 0, # store in KB
+ 'l2-cache' => 0, # store in KB
+ 'l3-cache' => 0, # store in KB
+ 'max-freq' => 0,
+ 'min-freq' => 0,
+ 'model_id' => '',
+ 'model_name' => '',
+ 'processors' => [],
+ 'rev' => '',
+ 'scalings' => [],
+ 'siblings' => 0,
+ 'type' => '',
+ );
+ return %cpu;
+}
+# MHZ - cell cpus
+sub speed_cleaner {
+ my ($speed,$opt) = @_;
+ return if ! $speed || $speed eq '0';
+ $speed =~ s/[GMK]HZ$//gi;
+ $speed = ($speed/1000) if $opt && $opt eq 'khz';
+ $speed = sprintf "%.0f", $speed;
+ return $speed;
+}
+sub cpu_cleaner {
+ my ($cpu) = @_;
+ return if ! $cpu;
+ my $filters = '@|cpu |cpu deca|([0-9]+|single|dual|two|triple|three|tri|quad|four|';
+ $filters .= 'penta|five|hepta|six|hexa|seven|octa|eight|multi)[ -]core|';
+ $filters .= 'ennea|genuine|multi|processor|single|triple|[0-9\.]+ *[MmGg][Hh][Zz]';
+ $cpu =~ s/$filters//ig;
+ $cpu =~ s/\s\s+/ /g;
+ $cpu =~ s/^\s+|\s+$//g;
+ return $cpu;
+}
+sub hex_and_decimal {
+ my ($data) = @_;
+ if ($data){
+ $data .= ' (' . hex($data) . ')' if hex($data) ne $data;
+ }
+ else {
+ $data = 'N/A';
+ }
+ return $data;
+}
+}
+
+## DiskData
+{
+package DiskData;
+my ($b_hddtemp,$b_nvme);
+my ($hddtemp,$nvme) = ('','');
+my (@by_id,@by_path);
+
+sub get {
+ eval $start if $b_log;
+ my (@data,@rows,$key1,$val1);
+ my ($type) = @_;
+ $type ||= 'standard';
+ my $num = 0;
+ @data = disk_data($type);
+ # NOTE:
+ if (@data){
+ if ($type eq 'standard'){
+ @data = create_output(@data);
+ @rows = (@rows,@data);
+ if ( $bsd_type && !@dm_boot_disk && $type eq 'standard' && $show{'disk'} ){
+ $key1 = 'Drive Report';
+ my $file = main::system_files('dmesg-boot');
+ if ( $file && ! -r $file){
+ $val1 = main::row_defaults('dmesg-boot-permissions');
+ }
+ elsif (!$file){
+ $val1 = main::row_defaults('dmesg-boot-missing');
+ }
+ else {
+ $val1 = main::row_defaults('disk-data-bsd');
+ }
+ @data = ({main::key($num++,$key1) => $val1,});
+ @rows = (@rows,@data);
+ }
+ }
+ else {
+ @rows = @data;
+ # print Data::Dumper::Dumper \@rows;
+ }
+ }
+ else {
+ $key1 = 'Message';
+ $val1 = main::row_defaults('disk-data');
+ @rows = ({main::key($num++,$key1) => $val1,});
+ }
+ if (!@rows){
+ $key1 = 'Message';
+ $val1 = main::row_defaults('disk-data');
+ @data = ({main::key($num++,$key1) => $val1,});
+ }
+ #@rows = (@rows,@data);
+ @data = ();
+ if ($show{'optical'} || $show{'optical-basic'}){
+ @data = OpticalData::get();
+ @rows = (@rows,@data);
+ }
+ ($b_hddtemp,$b_nvme,$hddtemp,$nvme) = (undef,undef,undef,undef);
+ (@by_id,@by_path) = (undef,undef);
+ eval $end if $b_log;
+ return @rows;
+}
+sub create_output {
+ eval $start if $b_log;
+ my (@disks) = @_;
+ #print Data::Dumper::Dumper \@disks;
+ my (@data,@rows);
+ my ($num,$j) = (0,0);
+ my ($id,$model,$size,$used,$percent,$size_holder,$used_holder) = ('','','','','','','');
+ my @sizing = main::get_size($disks[0]{'size'}) if $disks[0]{'size'};
+ #print Data::Dumper::Dumper \@disks;
+ if (@sizing){
+ $size = $sizing[0];
+ # note: if a string is returned there will be no Size unit so just use string.
+ if (defined $sizing[0] && $sizing[1]){
+ $size .= ' ' . $sizing[1];
+ }
+ }
+ $size ||= 'N/A';
+ @sizing = main::get_size($disks[0]{'used'}) if $disks[0]{'used'};
+ if (@sizing){
+ $used = $sizing[0];
+ if (defined $sizing[0] && $sizing[1]){
+ $used .= ' ' . $sizing[1];
+ if (( $disks[0]{'size'} && $disks[0]{'size'} =~ /^[0-9]/ ) &&
+ ( $disks[0]{'used'} =~ /^[0-9]/ ) ){
+ $used = $used . ' (' . sprintf("%0.1f", $disks[0]{'used'}/$disks[0]{'size'}*100) . '%)';
+ }
+ }
+ }
+ $used ||= 'N/A';
+ @data = ({
+ main::key($num++,'Local Storage') => '',
+ main::key($num++,'total') => $size,
+ main::key($num++,'used') => $used,
+ });
+ @rows = (@rows,@data);
+ shift @disks;
+ if ( $show{'disk'} && @disks){
+ @disks = sort { $a->{'id'} cmp $b->{'id'} } @disks;
+ foreach my $ref (@disks){
+ ($id,$model,$size) = ('','','');
+ my %row = %$ref;
+ $num = 1;
+ $model = ($row{'model'}) ? $row{'model'}: 'N/A';
+ $id = ($row{'id'}) ? "/dev/$row{'id'}":'N/A';
+ my @sizing = main::get_size($row{'size'});
+ #print Data::Dumper::Dumper \@disks;
+ if (@sizing){
+ $size = $sizing[0];
+ # note: if a string is returned there will be no Size unit so just use string.
+ if (defined $sizing[0] && $sizing[1]){
+ $size .= ' ' . $sizing[1];
+ $size_holder = $sizing[0];
+ }
+ $size ||= 'N/A';
+ }
+ else {
+ $size = 'N/A';
+ }
+ $j = scalar @rows;
+ @data = ({
+ main::key($num++,'ID') => $id,
+ });
+ @rows = (@rows,@data);
+ if ($row{'type'}){
+ $rows[$j]{main::key($num++,'type')} = $row{'type'},
+ }
+ if ($row{'vendor'}){
+ $rows[$j]{main::key($num++,'vendor')} = $row{'vendor'},
+ }
+ $rows[$j]{main::key($num++,'model')} = $model;
+ $rows[$j]{main::key($num++,'size')} = $size;
+ if ($extra > 1 && $row{'speed'}){
+ $rows[$j]{main::key($num++,'speed')} = $row{'speed'};
+ $rows[$j]{main::key($num++,'lanes')} = $row{'lanes'} if $row{'lanes'};
+ }
+ if ($extra > 2 && $row{'rotation'}){
+ $rows[$j]{main::key($num++,'rotation')} = $row{'rotation'};
+ }
+ if ($extra > 1){
+ my $serial = main::apply_filter($row{'serial'});
+ $rows[$j]{main::key($num++,'serial')} = $serial;
+ if ($row{'firmware'}){
+ $rows[$j]{main::key($num++,'rev')} = $row{'firmware'};
+ }
+ }
+ if ($extra > 0 && $row{'temp'}){
+ $rows[$j]{main::key($num++,'temp')} = $row{'temp'} . ' C';
+ }
+ # extra level tests already done
+ if (defined $row{'partition-table'}){
+ $rows[$j]{main::key($num++,'scheme')} = $row{'partition-table'};
+ }
+ }
+ }
+
+ eval $end if $b_log;
+ return @rows;
+}
+sub disk_data {
+ eval $start if $b_log;
+ my ($type) = @_;
+ my (@rows,@data,@devs);
+ my $num = 0;
+ my ($used) = (0);
+ PartitionData::partition_data() if !$b_partitions;
+ foreach my $ref (@partitions){
+ my %row = %$ref;
+ # don't count remote used, also, some cases mount
+ # panfs is parallel NAS volume manager, need more data
+ next if ($row{'fs'} && $row{'fs'} =~ /nfs|panfs|sshfs|smbfs|unionfs/);
+ # in some cases, like redhat, mounted cdrom/dvds show up in partition data
+ next if ($row{'dev-base'} && $row{'dev-base'} =~ /^sr[0-9]+$/);
+ # this is used for specific cases where bind, or incorrect multiple mounts
+ # to same partitions, or btrfs sub volume mounts, is present. The value is
+ # searched for an earlier appearance of that partition and if it is present,
+ # the data is not added into the partition used size.
+ if ( $row{'dev-base'} !~ /^\/\/|:\// && ! (grep {/$row{'dev-base'}/} @devs) ){
+ $used += $row{'used'} if $row{'used'};
+ push @devs, $row{'dev-base'};
+ }
+ }
+ if (!$bsd_type && (my $file = main::system_files('partitions'))){
+ @data = proc_data($used,$file);
+ }
+ elsif ($bsd_type) {
+ @data = dmesg_boot_data($used);
+ }
+ #print Data::Dumper::Dumper \@data;
+ main::log_data('data',"used: $used") if $b_log;
+ eval $end if $b_log;
+ return @data;
+}
+sub proc_data {
+ eval $start if $b_log;
+ my ($used,$file) = @_;
+ my (@data,@drives);
+ my ($b_hdx,$size,$drive_size) = (0,0,0);
+ my @proc_partitions = main::reader($file,'strip');
+ shift @proc_partitions;
+ foreach (@proc_partitions){
+ next if (/^\s*$/);
+ my @row = split /\s+/, $_;
+ if ( $row[-1] =~ /^([hsv]d[a-z]+|(ada|mmcblk|n[b]?d|nvme[0-9]+n)[0-9]+)$/) {
+ $drive_size = $row[2];
+ $b_hdx = 1 if $row[-1] =~ /^hd[a-z]/;
+ @data = ({
+ 'firmware' => '',
+ 'id' => $row[-1],
+ 'model' => '',
+ 'serial' => '',
+ 'size' => $drive_size,
+ 'spec' => '',
+ 'speed' => '',
+ 'temp' => '',
+ 'type' => '',
+ 'vendor' => '',
+ });
+ @drives = (@drives,@data);
+ }
+ # See http://lanana.org/docs/device-list/devices-2.6+.txt for major numbers used below
+ # See https://www.mjmwired.net/kernel/Documentation/devices.txt for kernel 4.x device numbers
+ # if ( $row[0] =~ /^(3|22|33|8)$/ && $row[1] % 16 == 0 ) {
+ # $size += $row[2];
+ # }
+ # special case from this data: 8 0 156290904 sda
+ # 43 0 48828124 nbd0
+ # note: known starters: vm: 252/253/254; grsec: 202; nvme: 259 mmcblk: 179
+ if ( $row[0] =~ /^(3|8|22|33|43|179|202|252|253|254|259)$/ &&
+ $row[-1] =~ /(mmcblk[0-9]+|n[b]?d[0-9]+|nvme[0-9]+n[0-9]+|[hsv]d[a-z]+)$/ &&
+ ( $row[1] % 16 == 0 || $row[1] % 16 == 8 ) ) {
+ $size += $row[2];
+ }
+ }
+ # print Data::Dumper::Dumper \@drives;
+ main::log_data('data',"size: $size") if $b_log;
+ @data = ({
+ 'size' => $size,
+ 'used' => $used,
+ });
+ #print Data::Dumper::Dumper \@data;
+ if ( $show{'disk'} ){
+ @drives = (@data,@drives);
+ # print 'drives:', Data::Dumper::Dumper \@drives;
+ @data = proc_data_advanced($b_hdx,@drives);
+ }
+ main::log_data('dump','@data',\@data) if $b_log;
+ # print Data::Dumper::Dumper \@data;
+ eval $end if $b_log;
+ return @data;
+}
+sub proc_data_advanced {
+ eval $start if $b_log;
+ my ($b_hdx,@drives) = @_;
+ my ($i) = (0);
+ my (@data,@disk_data,@rows,@scsi,@temp,@working);
+ my ($pt_cmd) = ('unset');
+ my ($block_type,$file,$firmware,$model,$path,$partition_scheme,
+ $serial,$vendor,$working_path);
+ @by_id = main::globber('/dev/disk/by-id/*');
+ # these do not contain any useful data, no serial or model name
+ # wwn-0x50014ee25fb50fc1 and nvme-eui.0025385b71b07e2e
+ # scsi-SATA_ST980815A_ simply repeats ata-ST980815A_; same with scsi-0ATA_WDC_WD5000L31X
+ # we also don't need the partition items
+ my $pattern = '^\/dev\/disk\/by-id\/(md-|lvm-|dm-|wwn-|nvme-eui|raid-|scsi-([0-9]ATA|SATA))|-part[0-9]+$';
+ @by_id = grep {!/$pattern/} @by_id if @by_id;
+ # print join "\n", @by_id, "\n";
+ @by_path = main::globber('/dev/disk/by-path/*');
+ ## check for all ide type drives, non libata, only do it if hdx is in array
+ ## this is now being updated for new /sys type paths, this may handle that ok too
+ ## skip the first rows in the loops since that's the basic size/used data
+ if ($b_hdx){
+ for ($i = 1; $i < scalar @drives; $i++){
+ $file = "/proc/ide/$drives[$i]{'id'}/model";
+ if ( $drives[$i]{'id'} =~ /^hd[a-z]/ && -e $file){
+ $model = (main::reader($file,'strip'))[0];
+ $drives[$i]{'model'} = $model;
+ }
+ }
+ }
+ # scsi stuff
+ if ($file = main::system_files('scsi')){
+ @scsi = scsi_data($file);
+ }
+ # print 'drives:', Data::Dumper::Dumper \@drives;
+ for ($i = 1; $i < scalar @drives; $i++){
+ #next if $drives[$i]{'id'} =~ /^hd[a-z]/;
+ ($block_type,$firmware,$model,$partition_scheme,
+ $serial,$vendor,$working_path) = ('','','','','','','');
+ if ($extra > 2){
+ @data = advanced_disk_data($pt_cmd,$drives[$i]{'id'});
+ $pt_cmd = $data[0];
+ $drives[$i]{'partition-table'} = uc($data[1]) if $data[1];
+ $drives[$i]{'rotation'} = "$data[2] rpm" if $data[2];
+ }
+ #print "$drives[$i]{'id'}\n";
+ @disk_data = disk_data_by_id("/dev/$drives[$i]{'id'}");
+ main::log_data('dump','@disk_data', \@disk_data) if $b_log;
+ if ($drives[$i]{'id'} =~ /[sv]d[a-z]/){
+ $block_type = 'sdx';
+ $working_path = "/sys/block/$drives[$i]{'id'}/device/";
+ }
+ elsif ($drives[$i]{'id'} =~ /mmcblk/){
+ $block_type = 'mmc';
+ $working_path = "/sys/block/$drives[$i]{'id'}/device/";
+ }
+ elsif ($drives[$i]{'id'} =~ /nvme/){
+ $block_type = 'nvme';
+ # this results in:
+ # /sys/devices/pci0000:00/0000:00:03.2/0000:06:00.0/nvme/nvme0/nvme0n1
+ # but we want to go one level down so slice off trailing nvme0n1
+ $working_path = Cwd::abs_path("/sys/block/$drives[$i]{'id'}");
+ $working_path =~ s/nvme[^\/]*$//;
+ }
+ main::log_data('data',"working path: $working_path") if $b_log;
+ if ($block_type && @scsi && @by_id && ! -e "${working_path}model" && ! -e "${working_path}name"){
+ ## ok, ok, it's incomprehensible, search /dev/disk/by-id for a line that contains the
+ # discovered disk name AND ends with the correct identifier, sdx
+ # get rid of whitespace for some drive names and ids, and extra data after - in name
+ SCSI:
+ foreach my $ref (@scsi){
+ my %row = %$ref;
+ if ($row{'model'}){
+ $row{'model'} = (split /\s*-\s*/,$row{'model'})[0];
+ foreach my $id (@by_id){
+ if ($id =~ /$row{'model'}/ && "/dev/$drives[$i]{'id'}" eq Cwd::abs_path($id)){
+ $drives[$i]{'firmware'} = $row{'firmware'};
+ $drives[$i]{'model'} = $row{'model'};
+ $drives[$i]{'vendor'} = $row{'vendor'};
+ last SCSI;
+ }
+ }
+ }
+ }
+ }
+ # note: an entire class of model names gets truncated by /sys so that should be the last
+ # in priority re tests.
+ elsif ( (!@disk_data || !$disk_data[0] ) && $block_type){
+ # NOTE: while path ${working_path}vendor exists, it contains junk value, like: ATA
+ $path = "${working_path}model";
+ if ( -e $path){
+ $model = (main::reader($path,'strip'))[0];
+ if ($model){
+ $drives[$i]{'model'} = $model;
+ }
+ }
+ elsif ($block_type eq 'mmc' && -e "${working_path}name"){
+ $path = "${working_path}name";
+ $model = (main::reader($path,'strip'))[0];
+ if ($model){
+ $drives[$i]{'model'} = $model;
+ }
+ }
+ }
+ if (!$drives[$i]{'model'} && @disk_data){
+ $drives[$i]{'model'} = $disk_data[0] if $disk_data[0];
+ $drives[$i]{'vendor'} = $disk_data[1] if $disk_data[1];
+ }
+ # maybe rework logic if find good scsi data example, but for now use this
+ elsif ($drives[$i]{'model'} && !$drives[$i]{'vendor'}) {
+ $drives[$i]{'model'} = main::disk_cleaner($drives[$i]{'model'});
+ my @device_data = device_vendor($drives[$i]{'model'},'');
+ $drives[$i]{'model'} = $device_data[1] if $device_data[1];
+ $drives[$i]{'vendor'} = $device_data[0] if $device_data[0];
+ }
+ if ($working_path){
+ $path = "${working_path}removable";
+ $drives[$i]{'type'} = 'Removable' if -e $path && (main::reader($path,'strip'))[0]; # 0/1 value
+ }
+ my $peripheral = peripheral_data($drives[$i]{'id'});
+ # note: we only want to update type if we found a peripheral, otherwise preserve value
+ $drives[$i]{'type'} = $peripheral if $peripheral;
+ # print "type:$drives[$i]{'type'}\n";
+ if ($extra > 0){
+ $drives[$i]{'temp'} = hdd_temp("/dev/$drives[$i]{'id'}");
+ if ($extra > 1){
+ my @speed_data = device_speed($drives[$i]{'id'});
+ $drives[$i]{'speed'} = $speed_data[0] if $speed_data[0];
+ $drives[$i]{'lanes'} = $speed_data[1] if $speed_data[1];
+ if (@disk_data && $disk_data[2]){
+ $drives[$i]{'serial'} = $disk_data[2];
+ }
+ else {
+ $path = "${working_path}serial";
+ if ( -e $path){
+ $serial = (main::reader($path,'strip'))[0];
+ $drives[$i]{'serial'} = $serial if $serial;
+ }
+ }
+ if ($extra > 2 && !$drives[$i]{'firmware'} ){
+ my @fm = ('rev','fmrev','firmware_rev'); # 0 ~ default; 1 ~ mmc; 2 ~ nvme
+ foreach my $firmware (@fm){
+ $path = "${working_path}$firmware";
+ if ( -e $path){
+ $drives[$i]{'firmware'} = (main::reader($path,'strip'))[0];
+ last;
+ }
+ }
+ }
+ }
+ }
+ }
+ # print Data::Dumper::Dumper \@drives;
+ eval $end if $b_log;
+ return @drives;
+}
+# camcontrol identify <device> |grep ^serial (this might be (S)ATA specific)
+# smartcl -i <device> |grep ^Serial
+# see smartctl; camcontrol devlist; gptid status;
+sub dmesg_boot_data {
+ eval $start if $b_log;
+ my ($used) = @_;
+ my (@data,@drives,@temp);
+ my ($id_holder,$i,$size,$working) = ('',0,0,0);
+ my $file = main::system_files('dmesg-boot');
+ if (@dm_boot_disk){
+ foreach (@dm_boot_disk){
+ my @row = split /:\s*/, $_;
+ next if ! defined $row[1];
+ if ($id_holder ne $row[0]){
+ $i++ if $id_holder;
+ # print "$i $id_holder $row[0]\n";
+ $id_holder = $row[0];
+ }
+ # no dots, note: ada2: 2861588MB BUT: ada2: 600.000MB/s
+ if (! exists $drives[$i]){
+ $drives[$i] = ({});
+ $drives[$i]{'id'} = $row[0];
+ $drives[$i]{'firmware'} = '';
+ $drives[$i]{'temp'} = '';
+ $drives[$i]{'type'} = '';
+ $drives[$i]{'vendor'} = '';
+ }
+ #print "$i\n";
+ if ($bsd_type eq 'openbsd'){
+ if ($row[1] =~ /,\s*([0-9\.]+[MGTPE][B]?),.*\ssectors$|^</){
+ $working = main::translate_size($1);
+ $size += $working if $working;
+ $drives[$i]{'size'} = $working;
+ }
+ if ($row[2] && $row[2] =~ /<([^>]+)>/){
+ $drives[$i]{'model'} = $1 if $1;
+ $drives[$i]{'type'} = 'removable' if $_ =~ /removable$/;
+ # <Generic-, Compact Flash, 1.00>
+ my $count = ($drives[$i]{'model'} =~ tr/,//);
+ if ($count && $count > 1){
+ @temp = split /,\s*/, $drives[$i]{'model'};
+ $drives[$i]{'model'} = $temp[1];
+ }
+ }
+ # print "openbsd\n";
+ }
+ else {
+ if ($row[1] =~ /^([0-9]+[KMGTPE][B]?)\s/){
+ $working = main::translate_size($1);
+ $size += $working if $working;
+ $drives[$i]{'size'} = $working;
+ }
+ if ($row[1] =~ /device$|^</){
+ $row[1] =~ s/\sdevice$//g;
+ $row[1] =~ /<([^>]*)>\s(.*)/;
+ $drives[$i]{'model'} = $1 if $1;
+ $drives[$i]{'spec'} = $2 if $2;
+ }
+ if ($row[1] =~ /^Serial\sNumber\s(.*)/){
+ $drives[$i]{'serial'} = $1;
+ }
+ if ($row[1] =~ /^([0-9\.]+[MG][B]?\/s)/){
+ $drives[$i]{'speed'} = $1;
+ $drives[$i]{'speed'} =~ s/\.[0-9]+// if $drives[$i]{'speed'};
+ }
+ }
+ $drives[$i]{'model'} = main::disk_cleaner($drives[$i]{'model'});
+ my @device_data = device_vendor($drives[$i]{'model'},'');
+ $drives[$i]{'vendor'} = $device_data[0] if $device_data[0];
+ $drives[$i]{'model'} = $device_data[1] if $device_data[1];
+ }
+ if (!$size){
+ $size = main::row_defaults('data-bsd');
+ }
+ }
+ elsif ( $file && ! -r $file ){
+ $size = main::row_defaults('dmesg-boot-permissions');
+ }
+ elsif (!$file ){
+ $size = main::row_defaults('dmesg-boot-missing');
+ }
+ @data = ({
+ 'size' => $size,
+ 'used' => $used,
+ });
+ #main::log_data('dump','@data',\@data) if $b_log;
+ if ( $show{'disk'} ){
+ @data = (@data,@drives);
+ # print 'drives:', Data::Dumper::Dumper \@drives;
+ }
+ # print Data::Dumper::Dumper \@data;
+ eval $end if $b_log;
+ return @data;
+}
+
+# check for usb/firewire/[and thunderwire when data found]
+sub peripheral_data {
+ eval $start if $b_log;
+ my ($id) = @_;
+ my ($type) = ('');
+ # print "$id here\n";
+ if (@by_id){
+ foreach (@by_id) {
+ if ("/dev/$id" eq Cwd::abs_path($_)){
+ #print "$id here\n";
+ if (/usb-/i){
+ $type = 'USB';
+ }
+ elsif (/ieee1394--/i){
+ $type = 'FireWire';
+ }
+ last;
+ }
+ }
+ }
+ # note: sometimes with wwn- numbering usb does not appear in by-id but it does in by-path
+ if (!$type && @by_path){
+ foreach (@by_path) {
+ if ("/dev/$id" eq Cwd::abs_path($_)){
+ if (/usb-/i){
+ $type = 'USB';
+ }
+ elsif (/ieee1394--/i){
+ $type = 'FireWire';
+ }
+ last;
+ }
+ }
+ }
+ eval $end if $b_log;
+ return $type;
+}
+sub advanced_disk_data {
+ eval $start if $b_log;
+ my ($set_cmd,$id) = @_;
+ my ($cmd,$pt,$program,@data,@return);
+ if ($set_cmd ne 'unset'){
+ $return[0] = $set_cmd;
+ }
+ else {
+ # runs as user, but is SLOW: udisksctl info -b /dev/sda
+ # line: org.freedesktop.UDisks2.PartitionTable:
+ # Type: dos
+ if ($program = main::check_program('udevadm')){
+ $return[0] = "$program info -q property -n ";
+ }
+ elsif ($b_root && -e "/lib/udev/udisks-part-id") {
+ $return[0] = "/lib/udev/udisks-part-id /dev/";
+ }
+ elsif ($b_root && ($program = main::check_program('fdisk'))) {
+ $return[0] = "$program -l /dev/";
+ }
+ if (!$return[0]) {
+ $return[0] = 'na'
+ }
+ }
+ if ($return[0] ne 'na'){
+ $cmd = "$return[0]$id 2>&1";
+ main::log_data('cmd',$cmd) if $b_log;
+ @data = main::grabber($cmd);
+ # for pre ~ 2.30 fdisk did not show gpt, but did show gpt scheme error, so
+ # if no gpt match, it's dos = mbr
+ if ($cmd =~ /fdisk/){
+ foreach (@data){
+ if (/^WARNING:\s+GPT/){
+ $return[1] = 'gpt';
+ last;
+ }
+ elsif (/^Disklabel\stype:\s*(.+)/i){
+ $return[1] = $1;
+ last;
+ }
+ }
+ $return[1] = 'dos' if !$return[1];
+ }
+ else {
+ foreach (@data){
+ if ( /^(UDISKS_PARTITION_TABLE_SCHEME|ID_PART_TABLE_TYPE)/ ){
+ my @working = split /=/, $_;
+ $return[1] = $working[1];
+ }
+ elsif (/^ID_ATA_ROTATION_RATE_RPM/){
+ my @working = split /=/, $_;
+ $return[2] = $working[1];
+ }
+ last if $return[1] && $return[2];
+ }
+ }
+ $return[1] = 'mbr' if $return[1] && lc($return[1]) eq 'dos';
+ }
+ eval $end if $b_log;
+ return @return;
+}
+sub scsi_data {
+ eval $start if $b_log;
+ my ($file) = @_;
+ my @temp = main::reader($file);
+ my (@scsi);
+ my ($firmware,$model,$vendor) = ('','','');
+ foreach (@temp){
+ if (/Vendor:\s*(.*)\s+Model:\s*(.*)\s+Rev:\s*(.*)/i){
+ $vendor = $1;
+ $model = $2;
+ $firmware = $3;
+ }
+ if (/Type:/i){
+ if (/Type:\s*Direct-Access/i){
+ my @working = ({
+ 'vendor' => $vendor,
+ 'model' => $model,
+ 'firmware' => $firmware,
+ });
+ @scsi = (@scsi,@working);
+ }
+ else {
+ ($firmware,$model,$vendor) = ('','','');
+ }
+ }
+ }
+ main::log_data('dump','@scsi', \@scsi) if $b_log;
+ eval $end if $b_log;
+ return @scsi;
+}
+# @b_id has already been cleaned of partitions, wwn-, nvme-eui
+sub disk_data_by_id {
+ eval $start if $b_log;
+ my ($device) = @_;
+ my ($model,$serial,$vendor) = ('','','');
+ my (@disk_data);
+ foreach (@by_id){
+ if ($device eq Cwd::abs_path($_)){
+ my @data = split /_/, $_;
+ my @device_data = ();
+ last if scalar @data < 2; # scsi-3600508e000000000876995df43efa500
+ $serial = pop @data if @data;
+ # usb-PNY_USB_3.0_FD_3715202280-0:0
+ $serial =~ s/-[0-9]+:[0-9]+$//;
+ $model = join ' ', @data;
+ # get rid of the ata-|nvme-|mmc- etc
+ $model =~ s/^\/dev\/disk\/by-id\/([^-]+-)?//;
+ $model = main::disk_cleaner($model);
+ @device_data = device_vendor($model,$serial);
+ $vendor = $device_data[0] if $device_data[0];
+ $model = $device_data[1] if $device_data[1];
+ # print $device, '::', Cwd::abs_path($_),'::', $model, '::', $vendor, '::', $serial, "\n";
+ (@disk_data) = ($model,$vendor,$serial);
+ last;
+ }
+ }
+ eval $end if $b_log;
+ return @disk_data;
+}
+# receives space separated string that may or may not contain vendor data
+sub device_vendor {
+ eval $start if $b_log;
+ my ($model,$serial) = @_;
+ my ($vendor) = ('');
+ my (@data);
+ return if !$model;
+ # 0 - match pattern; 1 - replace pattern; 2 - vendor print; 3 - serial pattern
+ # Data URLs: inxi-resources.txt Section: DiskData device_vendor()
+ my @vendors = (
+ ## These go first because they are the most likely and common ##
+ ['(Crucial|^CT|-CT|^M4-)','Crucial','Crucial',''],
+ ['^INTEL','^INTEL','Intel',''],
+ ['(KINGSTON|DataTraveler|^SMS|^SHS|^SUV)','KINGSTON','Kingston',''], # maybe SHS: SHSS37A SKC SUV
+ # must come before samsung MU. NOTE: toshiba can have: TOSHIBA_MK6475GSX: mush: MKNSSDCR120GB_
+ ['(^MKN|Mushkin)','Mushkin','Mushkin',''], # MKNS
+ # MU = Multiple_Flash_Reader too risky: |M[UZ][^L]
+ ['(SAMSUNG|^MCG[0-9]+GC)','SAMSUNG','Samsung',''], # maybe ^SM
+ ['(SanDisk|^SDS[S]?[DQ]|^SL([0-9]+)G|^AFGCE|ULTRA\sFIT|Cruzer)','SanDisk','SanDisk',''],
+ ['(^ST[^T]|[S]?SEAGATE|^X[AFP]|^BUP|Expansion Desk)','[S]?SEAGATE','Seagate',''], # real, SSEAGATE Backup+; XP1600HE30002
+ ['^(WD|Western Digital|My (Book|Passport)|00LPCX|Elements)','(^WDC|Western Digital)','Western Digital',''],
+ ## Then better known ones ##
+ ['^(A-DATA|ADATA|AXN)','^(A-DATA|ADATA)','A-Data',''],
+ ['^ADTRON','^(ADTRON)','Adtron',''],
+ ['^ASUS','^ASUS','ASUS',''],
+ ['^ATP','^ATP[\s\-]','ATP',''],
+ ['^Corsair','^Corsair','Corsair',''],
+ ['^(FUJITSU|MP)','^FUJITSU','Fujitsu',''],
+ # note: 2012: wdc bought hgst
+ ['^(HGST)','^HGST','HGST (Hitachi)',''], # HGST HUA
+ ['^(Hitachi|HDS|IC|HT|HU)','^Hitachi','Hitachi',''],
+ ['^Hoodisk','^Hoodisk','Hoodisk',''],
+ ['^(HP\b)','^HP','HP',''], # vb: VB0250EAVER but clashes with vbox; HP_SSD_S700_120G
+ ['^(LSD|Lexar)','^Lexar','Lexar',''], # mmc-LEXAR_0xb016546c
+ # OCZSSD2-2VTXE120G is OCZ-VERTEX2_3.5
+ ['^(OCZ|APOC|D2|DEN|DEN|DRSAK|EC188|FTNC|GFGC|MANG|MMOC|NIMC|NIMR|PSIR|TALOS2|TMSC|TRSAK)','^OCZ[\s\-]','OCZ',''],
+ ['^OWC','^OWC[\s\-]','OWC',''],
+ ['^Philips','^Philips','Philips',''],
+ ['^PIONEER','^PIONEER','Pioneer',''],
+ ['^PNY','^PNY\s','PNY','','^PNY'],
+ # note: get rid of: M[DGK] becasue mushkin starts with MK
+ # note: seen: KXG50ZNV512G NVMe TOSHIBA 512GB | THNSN51T02DUK NVMe TOSHIBA 1024GB
+ ['(^[S]?TOS|^THN|TOSHIBA)','[S]?TOSHIBA','Toshiba',''], # scsi-STOSHIBA_STOR.E_EDITION_
+ ## These go last because they are short and could lead to false ID, or are unlikely ##
+ ['^Android','^Android','Android',''],
+ # must come before AP|Apacer
+ ['^APPLE','^APPLE','Apple',''],
+ ['^(AP|Apacer)','^Apacer','Apacer',''],
+ ['^BUFFALO','^BUFFALO','Buffalo',''],
+ ['^CHN\b','','Zheino',''],
+ ['^Colorful\b','^Colorful','Colorful',''],
+ ['^DREVO\b','','Drevo',''],
+ ['^EXCELSTOR','^EXCELSTOR( TECHNOLOGY)?','Excelstor',''],
+ ['^FASTDISK','^FASTDISK','FASTDISK',''],
+ ['^FORESEE','^FORESEE','Foresee',''],
+ ['^GALAX\b','^GALAX','GALAX',''],
+ ['^Generic','^Generic','Generic',''],
+ ['^GOODRAM','^GOODRAM','GOODRAM',''],
+ # supertalent also has FM: |FM
+ ['^(G[\.]?SKILL)','^G[\.]?SKILL','G.SKILL',''],
+ ['^HUAWEI','^HUAWEI','Huawei',''],
+ ['^(IBM|DT)','^IBM','IBM',''],
+ ['^Imation','^Imation(\sImation)?','Imation',''], # Imation_ImationFlashDrive
+ ['^(InnoDisk|Innolite)','^InnoDisk( Corp.)?','InnoDisk',''],
+ ['^Innostor','^Innostor','Innostor',''],
+ ['^Intenso','^Intenso','Intenso',''],
+ ['^KingDian','^KingDian','KingDian',''],
+ ['^(LITE[\-]?ON[\s\-]?IT)','^LITE[\-]?ON[\s\-]?IT','LITE-ON IT',''], # LITEONIT_LSS-24L6G
+ ['^(LITE[\-]?ON|PH6)','^LITE[\-]?ON','LITE-ON',''], # PH6-CE240-L
+ ['^M-Systems','^M-Systems','M-Systems',''],
+ ['^MAXTOR','^MAXTOR','Maxtor',''],
+ ['^(MT|M5|Micron)','^Micron','Micron',''],
+ ['^MARVELL','^MARVELL','Marvell',''],
+ ['^Medion','^Medion','Medion',''],
+ ['^Motorola','^Motorola','Motorola',''],
+ ['^(PS[8F]|Patriot)','^Patriot','Patriot',''],
+ ['^PIX[\s]?JR','^PIX[\s]?JR','Disney',''],
+ ['^(PLEXTOR|PX-)','^PLEXTOR','Plextor',''],
+ ['(^Quantum|Fireball)','^Quantum','Quantum',''],
+ ['^R3','','AMD Radeon',''], # ssd
+ ['^RENICE','^RENICE','Renice',''],
+ ['^RIM[\s]','^RIM','RIM',''],
+ ['^SigmaTel','^SigmaTel','SigmaTel',''],
+ ['^SPPC','','Silicon Power',''],
+ ['^(SK\s?HYNIX|HFS)','^SK\s?HYNIX','SK Hynix',''], # HFS128G39TND-N210A
+ ['^hynix','hynix','Hynix',''],# nvme middle of string, must be after sk hynix
+ ['^SH','','Smart Modular Tech.',''],
+ ['^(SMART( Storage Systems)?|TX)','^(SMART( Storage Systems)?)','Smart Storage Systems',''],
+ ['^(S[FR]-|Sony)','^Sony','Sony',''],
+ ['^STE[CK]','^STE[CK]','sTec',''], # wd bought this one
+ ['^STORFLY','^STORFLY','StorFly',''],
+ # NOTE: F[MNETU] not reliable, g.skill starts with FM too:
+ # Seagate ST skips STT.
+ ['^(STT)','','Super Talent',''],
+ ['^(SF|Swissbit)','^Swissbit','Swissbit',''],
+ # ['^(SUPERSPEED)','^SUPERSPEED','SuperSpeed',''], # superspeed is a generic term
+ ['^TANDBERG','^TANDBERG','Tanberg',''],
+ ['^TEAC','^TEAC','TEAC',''],
+ ['^(TS|Transcend|JetFlash)','^Transcend','Transcend',''],
+ ['^TrekStor','^TrekStor','TrekStor',''],
+ ['^UDinfo','^UDinfo','UDinfo',''],
+ ['^(UG|Unigen)','^Unigen','Unigen',''],
+ ['^VBOX','','VirtualBox',''],
+ ['^(Verbatim|STORE N GO)','^Verbatim','Verbatim',''],
+ ['^VISIONTEK','^VISIONTEK','VisionTek',''],
+ ['^VMware','^VMware','VMware',''],
+ ['^(Vseky|Vaseky)','^Vaseky','Vaseky',''], # ata-Vseky_V880_350G_
+ );
+ foreach my $ref (@vendors){
+ my @row = @$ref;
+ if ($model =~ /$row[0]/i || ($row[3] && $serial && $serial =~ /$row[3]/)){
+ $vendor = $row[2];
+ $model =~ s/$row[1]//i if $row[1] && lc($model) ne lc($row[1]);
+ $model =~ s/^[\s\-_]+|[\s\-_]+$//g;
+ $model =~ s/\s\s/ /g;
+ @data = ($vendor,$model);
+ last;
+ }
+ }
+ eval $end if $b_log;
+ return @data;
+}
+# Normally hddtemp requires root, but you can set user rights in /etc/sudoers.
+# args: $1 - /dev/<disk> to be tested for
+sub hdd_temp {
+ eval $start if $b_log;
+ my ($device) = @_;
+ my ($path) = ('');
+ my (@data,$hdd_temp);
+ if ($device =~ /nvme/i){
+ if (!$b_nvme){
+ $b_nvme = 1;
+ if ($path = main::check_program('nvme')) {
+ $nvme = $path;
+ }
+ }
+ if ($nvme){
+ $device =~ s/n[0-9]//;
+ @data = main::grabber("$sudo$nvme smart-log $device 2>/dev/null");
+ foreach (@data){
+ my @row = split /\s*:\s*/, $_;
+ # other rows may have: Temperature sensor 1 :
+ if ( $row[0] eq 'temperature') {
+ $row[1] =~ s/\s*C//;
+ $hdd_temp = $row[1];
+ last;
+ }
+ }
+ }
+ }
+ else {
+ if (!$b_hddtemp){
+ $b_hddtemp = 1;
+ if ($path = main::check_program('hddtemp')) {
+ $hddtemp = $path;
+ }
+ }
+ if ($hddtemp){
+ $hdd_temp = (main::grabber("$sudo$hddtemp -nq -u C $device 2>/dev/null"))[0];
+ }
+ }
+ eval $end if $b_log;
+ return $hdd_temp;
+}
+sub device_speed {
+ eval $start if $b_log;
+ my ($device) = @_;
+ my ($b_nvme,$lanes,$speed,@data);
+ my $working = Cwd::abs_path("/sys/class/block/$device");
+ #print "$working\n";
+ if ($working){
+ my ($id);
+ # slice out the ata id:
+ # /sys/devices/pci0000:00:11.0/ata1/host0/target0:
+ if ($working =~ /^.*\/ata([0-9]+)\/.*/){
+ $id = $1;
+ }
+ # /sys/devices/pci0000:00/0000:00:05.0/virtio1/block/vda
+ elsif ($working =~ /^.*\/virtio([0-9]+)\/.*/){
+ $id = $1;
+ }
+ # /sys/devices/pci0000:10/0000:10:01.2/0000:13:00.0/nvme/nvme0/nvme0n1
+ elsif ($working =~ /^.*\/(nvme[0-9]+)\/.*/){
+ $id = $1;
+ $b_nvme = 1;
+ }
+ # do host last because the strings above might have host as well as their search item
+ # 0000:00:1f.2/host3/target3: increment by 1 sine ata starts at 1, but host at 0
+ elsif ($working =~ /^.*\/host([0-9]+)\/.*/){
+ $id = $1 + 1 if defined $1;
+ }
+ # print "$working $id\n";
+ if (defined $id){
+ if ($b_nvme){
+ $working = "/sys/class/nvme/$id/device/max_link_speed";
+ $speed = (main::reader($working))[0] if -f $working;
+ if ($speed =~ /([0-9\.]+)\sGT\/s/){
+ $speed = $1;
+ # pcie1: 2.5 GT/s; pcie2: 5.0 GT/s; pci3: 8 GT/s
+ # NOTE: PCIe 3 stopped using the 8b/10b encoding but a sample pcie3 nvme has
+ # rated speed of GT/s * .8 anyway. GT/s * (128b/130b)
+ $speed = ($speed <= 5 ) ? $speed * .8 : $speed * 128/130;
+ $speed = sprintf("%.1f",$speed) if $speed;
+ $working = "/sys/class/nvme/$id/device/max_link_width";
+ $lanes = (main::reader($working))[0] if -f $working;
+ $lanes = 1 if !$lanes;
+ # https://www.edn.com/electronics-news/4380071/What-does-GT-s-mean-anyway-
+ # https://www.anandtech.com/show/2412/2
+ # http://www.tested.com/tech/457440-theoretical-vs-actual-bandwidth-pci-express-and-thunderbolt/
+ # PCIe 1,2 use “8b/10b” encoding: eight bits are encoded into a 10-bit symbol
+ # PCIe 3,4,5 use "128b/130b" encoding: 128 bits are encoded into a 130 bit symbol
+ $speed = ($speed * $lanes) . " Gb/s";
+ }
+ }
+ else {
+ $working = "/sys/class/ata_link/link$id/sata_spd";
+ $speed = (main::reader($working))[0] if -f $working;
+ $speed = main::disk_cleaner($speed) if $speed;
+ $speed =~ s/Gbps/Gb\/s/ if $speed;
+ }
+ }
+ }
+ @data = ($speed,$lanes);
+ #print "$working $speed\n";
+ eval $end if $b_log;
+ return @data;
+}
+# gptid/c5e940f1-5ce2-11e6-9eeb-d05099ac4dc2 N/A ada0p1
+sub match_glabel {
+ eval $start if $b_log;
+ my ($gptid) = @_;
+ return if !@glabel || ! $gptid;
+ #$gptid =~ s/s[0-9]+$//;
+ my ($dev_id) = ('');
+ foreach (@glabel){
+ my @temp = split /\s+/, $_;
+ my $gptid_trimmed = $gptid;
+ # slice off s[0-9] from end in case they use slice syntax
+ $gptid_trimmed =~ s/s[0-9]+$//;
+ if (defined $temp[0] && ($temp[0] eq $gptid || $temp[0] eq $gptid_trimmed ) ){
+ $dev_id = $temp[2];
+ last;
+ }
+ }
+ $dev_id ||= $gptid; # no match? return full string
+ eval $end if $b_log;
+ return $dev_id;
+}
+sub set_glabel {
+ eval $start if $b_log;
+ $b_glabel = 1;
+ if (my $path = main::check_program('glabel')){
+ @glabel = main::grabber("$path status 2>/dev/null");
+ }
+ main::log_data('dump','@glabel:with Headers',\@glabel) if $b_log;
+ # get rid of first header line
+ shift @glabel;
+ eval $end if $b_log;
+}
+}
+
+## GraphicData
+{
+package GraphicData;
+my $driver = ''; # we need this as a fallback in case no xorg.0.log
+sub get {
+ eval $start if $b_log;
+ my (@data,@rows);
+ my $num = 0;
+ if (($b_arm || $b_mips) && !$b_soc_gfx && !$b_pci_tool){
+ my $key = ($b_arm) ? 'ARM' : 'MIPS';
+ @data = ({
+ main::key($num++,$key) => main::row_defaults(lc($key) . '-pci',''),
+ },);
+ @rows = (@rows,@data);
+ }
+ else {
+ @data = card_data();
+ @rows = (@rows,@data);
+ if (!@rows){
+ my $key = 'Message';
+ @data = ({
+ main::key($num++,$key) => main::row_defaults('pci-card-data',''),
+ },);
+ @rows = (@rows,@data);
+ }
+ }
+ @data = display_data();
+ @rows = (@rows,@data);
+ @data = gl_data();
+ @rows = (@rows,@data);
+ eval $end if $b_log;
+ return @rows;
+}
+# 0 type
+# 1 type_id
+# 2 bus_id
+# 3 sub_id
+# 4 device
+# 5 vendor_id
+# 6 chip_id
+# 7 rev
+# 8 port
+# 9 driver
+# 10 modules
+# not using 3D controller yet, needs research: |3D controller |display controller
+# note: this is strange, but all of these can be either a separate or the same
+# card. However, by comparing bus id, say: 00:02.0 we can determine that the
+# cards are either the same or different. We want only the .0 version as a valid
+# card. .1 would be for example: Display Adapter with bus id x:xx.1, not the right one
+sub card_data {
+ eval $start if $b_log;
+ my (@rows,@data);
+ my ($j,$num) = (0,1);
+ foreach (@pci){
+ $num = 1;
+ my @row = @$_;
+ #print "$row[0] $row[3]\n";
+ if ($row[3] == 0 && ( $row[0] =~ /^(vga|disp|display|3d|fb|gpu|hdmi)$/ ) ){
+ #print "$row[0] $row[3]\n";
+ $j = scalar @rows;
+ $driver = $row[9];
+ $driver ||= 'N/A';
+ my $card = main::trimmer($row[4]);
+ $card = ($card) ? main::pci_cleaner($card,'output') : 'N/A';
+ #$card ||= 'N/A';
+ # have seen absurdly verbose card descriptions, with non related data etc
+ if (length($card) > 85 || $size{'max'} < 110){
+ $card = main::pci_long_filter($card);
+ }
+ @data = ({
+ main::key($num++,'Card') => $card,
+ },);
+ @rows = (@rows,@data);
+ if ($extra > 2 && $b_pci_tool && $row[11]){
+ my $item = main::get_pci_vendor($row[4],$row[11]);
+ $rows[$j]{main::key($num++,'vendor')} = $item if $item;
+ }
+ $rows[$j]{main::key($num++,'driver')} = $driver;
+ if ($row[9] && !$bsd_type){
+ my $version = main::get_module_version($row[9]);
+ $version ||= 'N/A';
+ $rows[$j]{main::key($num++,'v')} = $version;
+ }
+ if ($extra > 0){
+ $rows[$j]{main::key($num++,'bus ID')} = (!$row[2] && !$row[3]) ? 'N/A' : "$row[2].$row[3]";
+ }
+ if ($extra > 1){
+ $rows[$j]{main::key($num++,'chip ID')} = ($row[5]) ? "$row[5]:$row[6]" : $row[6];
+ }
+ }
+ #print "$row[0]\n";
+ }
+ #my $ref = $pci[-1];
+ #print $$ref[0],"\n";
+ eval $end if $b_log;
+ return @rows;
+}
+sub display_data(){
+ eval $start if $b_log;
+ my (%graphics,@row);
+ my @xdpyinfo;
+ my $num = 0;
+ my ($protocol,$server) = ('','');
+ # note: these may not always be set, they won't be out of X, for example
+ $protocol = $ENV{'XDG_SESSION_TYPE'} if $ENV{'XDG_SESSION_TYPE'};
+ $protocol = $ENV{'WAYLAND_DISPLAY'} if (!$protocol && $ENV{'WAYLAND_DISPLAY'});
+ # need to confirm that there's a point to this test, I believe no, fails out of x
+ # loginctl also results in the session id
+ if (!$protocol && $b_display && $b_force_display){
+ if (my $program = main::check_program('loginctl')){
+ my $id = '';
+ # $id = $ENV{'XDG_SESSION_ID'}; # returns tty session in console
+ my @data = main::grabber("$program --no-pager --no-legend 2>/dev/null",'','strip');
+ foreach (@data){
+ next if /tty[v]?[0-6]$/; # freebsd: ttyv3
+ $id = (split /\s+/, $_)[0];
+ last; # multiuser? too bad, we'll go for the first one
+ }
+ if ($id ){
+ my $temp = (main::grabber("$program show-session $id -p Type --no-pager --no-legend 2>/dev/null"))[0];
+ $temp =~ s/Type=// if $temp;
+ # ssh will not show /dev/ttyx so would have passed the first test
+ $protocol = $temp if $temp && $temp ne 'tty';
+ }
+ }
+ }
+ if ($extra > 1){
+ # initial tests, if wayland, it is certainly a compositor
+ $protocol = lc($protocol) if $protocol;
+ $graphics{'compositor'} = display_compositor($protocol);
+ }
+ if ( $b_display){
+ # X vendor and version detection.
+ # new method added since radeon and X.org and the disappearance of
+ # <X server name> version : ...etc. Later on, the normal textual version string
+ # returned, e.g. like: X.Org version: 6.8.2
+ # A failover mechanism is in place: if $version empty, release number parsed instead
+ if (my $program = main::check_program('xdpyinfo')){
+ my @xdpyinfo = main::grabber("$program $display_opt 2>/dev/null","\n",'strip');
+ #@xdpyinfo = map {s/^\s+//;$_} @xdpyinfo if @xdpyinfo;
+ #print join "\n",@xdpyinfo, "\n";
+ foreach (@xdpyinfo){
+ my @working = split /:\s+/, $_;
+ next if ( ($graphics{'dimensions'} && $working[0] ne 'dimensions' ) || !$working[0] );
+ #print "$_\n";
+ if ($working[0] eq 'vendor string'){
+ $working[1] =~ s/The\s|\sFoundation//g;
+ # some distros, like fedora, report themselves as the xorg vendor,
+ # so quick check here to make sure the vendor string includes Xorg in string
+ if ($working[1] !~ /x/i){
+ $working[1] .= ' X.org';
+ }
+ $graphics{'vendor'} = $working[1];
+ }
+ elsif ($working[0] eq 'version number'){
+ $graphics{'version-id'} = $working[1];
+ }
+ elsif ($working[0] eq 'vendor release number'){
+ $graphics{'vendor-release'} = $working[1];
+ }
+ elsif ($working[0] eq 'X.Org version'){
+ $graphics{'xorg-version'} = $working[1];
+ }
+ elsif ($working[0] eq 'dimensions'){
+ $working[1] =~ s/\spixels//;
+ $working[1] =~ s/\smillimeters/ mm/;
+ if ($graphics{'dimensions'}){
+ $graphics{'dimensions'} = ([@{$graphics{'dimensions'}},$working[1]]);
+ }
+ else {
+ $graphics{'dimensions'} = ([$working[1]]);
+ }
+ }
+ }
+ #$graphics{'dimensions'} = (\@dimensions);
+ # we get a bit more info from xrandr than xdpyinfo, but xrandr fails to handle
+ # multiple screens from different video cards
+ my $ref = $graphics{'dimensions'};
+ if (defined $ref){
+ my @screens = @$ref;
+ if (scalar @screens == 1){
+ if (my $program = main::check_program('xrandr')){
+ my @xrandr = main::grabber("$program $display_opt 2>/dev/null",'','strip');
+ foreach (@xrandr){
+ my @working = split /\s+/,$_;
+ # print join "$_\n";
+ if ($working[1] =~ /\*/){
+ $working[1] =~ s/\*|\+//g;
+ $working[1] = sprintf("%.0f",$working[1]);
+ $working[1] = ($working[1]) ? "$working[1]Hz" : 'N/A';
+ my $screen = "$working[0]~$working[1]";
+ if ($graphics{'screens'}){
+ $graphics{'screens'} = ([@{$graphics{'screens'}},$screen]);
+ }
+ else {
+ $graphics{'screens'} = ([$screen]);
+ }
+ }
+ }
+ }
+ }
+ }
+ else {
+ $graphics{'tty'} = tty_data();
+ }
+ }
+ else {
+ $graphics{'screens'} = ([main::row_defaults('xdpyinfo-missing')]);
+ }
+ }
+ else {
+ $graphics{'tty'} = tty_data();
+ }
+ # this gives better output than the failure last case, which would only show:
+ # for example: X.org: 1.9 instead of: X.org: 1.9.0
+ $graphics{'version'} = $graphics{'xorg-version'} if $graphics{'xorg-version'};;
+ $graphics{'version'} = x_version() if !$graphics{'version'};
+ $graphics{'version'} = $graphics{'version-id'} if !$graphics{'version'};
+
+ undef @xdpyinfo;
+ #print Data::Dumper::Dumper \%graphics;
+ if (%graphics){
+ my $resolution = '';
+ my $server_string = '';
+ if ($graphics{'vendor'}){
+ my $version = ($graphics{'version'}) ? " $graphics{'version'}" : '';
+ $server_string = "$graphics{'vendor'}$version";
+ }
+ elsif ($graphics{'version'}) {
+ $server_string = "X.org $graphics{'version'}";
+ }
+ if ($graphics{'screens'}){
+ my $ref = $graphics{'screens'};
+ my @screens = @$ref;
+ my $sep = '';
+ foreach (@screens){
+ $resolution .= $sep . $_;
+ $sep = ', ';
+ }
+ }
+ my @drivers = x_drivers();
+ if (!$protocol && !$server_string && !$graphics{'vendor'} && !@drivers){
+ $server_string = main::row_defaults('display-server');
+ @row = ({
+ main::key($num++,'Display') => '',
+ main::key($num++,'server') => $server_string,
+ });
+ }
+ else {
+ $server_string ||= 'N/A';
+ # note: if no xorg log, and if wayland, there will be no xorg drivers,
+ # obviously, so we use the last driver found on the card section in that case.
+ # those come from lscpi kernel drivers so there should be no xorg/wayland issues.
+ $driver = ($drivers[0]) ? $drivers[0]: $driver;
+ @row = ({
+ main::key($num++,'Display') => $protocol,
+ main::key($num++,'server') => $server_string,
+ main::key($num++,'driver') => $driver,
+ });
+ if ($drivers[2]){
+ $row[0]{main::key($num++,'FAILED')} = $drivers[2];
+ }
+ if ($drivers[1]){
+ $row[0]{main::key($num++,'unloaded')} = $drivers[1];
+ }
+ if ($extra > 1 && $drivers[3]){
+ $row[0]{main::key($num++,'alternate')} = $drivers[3];
+ }
+ if ($graphics{'compositor'}){
+ $row[0]{main::key($num++,'compositor')} = $graphics{'compositor'};
+ }
+ }
+ if ($resolution){
+ $row[0]{main::key($num++,'resolution')} = $resolution;
+ }
+ else {
+ $graphics{'tty'} ||= 'N/A';
+ $row[0]{main::key($num++,'tty')} = $graphics{'tty'};
+ }
+ }
+ eval $end if $b_log;
+ return @row;
+}
+sub gl_data(){
+ eval $start if $b_log;
+ my $num = 0;
+ my (@row,$arg);
+ #print ("$b_display : $b_root\n");
+ if ( $b_display){
+ if (my $program = main::check_program('glxinfo')){
+ # NOTE: glxinfo -B is not always available, unforunately
+ my @glxinfo = main::grabber("$program $display_opt 2>/dev/null");
+ if (!@glxinfo){
+ my $type = 'display-console';
+ if ($b_root){
+ $type = 'display-root-x';
+ }
+ else {
+ $type = 'display-null';
+ }
+ @row = ({
+ main::key($num++,'Message') => main::row_defaults($type),
+ });
+ return @row;
+ }
+ #print join "\n",@glxinfo,"\n";
+ my $compat_version = '';
+ my ($b_compat,@core_profile_version,@direct_render,@renderer,@opengl_version,@working);
+ foreach (@glxinfo){
+ next if /^\s/;
+ if (/^opengl renderer/i){
+ @working = split /:\s*/, $_;
+ $working[1] = main::cleaner($working[1]);
+ # Allow all mesas
+ #if ($working[1] =~ /mesa/i){
+ #
+ #}
+ push @renderer, $working[1];
+ }
+ # dropping all conditions from this test to just show full mesa information
+ # there is a user case where not f and mesa apply, atom mobo
+ # /opengl version/ && ( f || $2 !~ /mesa/ ) {
+ elsif (/^opengl version/i){
+ # fglrx started appearing with this extra string, does not appear
+ # to communicate anything of value
+ @working = split /:\s*/, $_;
+ $working[1] =~ s/(Compatibility Profile Context|\(Compatibility Profile\))//;
+ $working[1] =~ s/\s\s/ /g;
+ $working[1] =~ s/^\s+|\s+$//;
+ push @opengl_version, $working[1];
+ # note: this is going to be off if ever multi opengl versions appear, never seen one
+ @working = split /\s+/, $working[1];
+ $compat_version = $working[0];
+ }
+ elsif (/^opengl core profile version/i){
+ # fglrx started appearing with this extra string, does not appear
+ # to communicate anything of value
+ @working = split /:\s*/, $_;
+ $working[1] =~ s/(Compatibility Profile Context|\((Compatibility|Core) Profile\))//;
+ $working[1] =~ s/\s\s/ /g;
+ $working[1] =~ s/^\s+|\s+$//;
+ push @core_profile_version, $working[1];
+ }
+ elsif (/direct rendering/){
+ @working = split /:\s*/, $_;
+ push @direct_render, $working[1];
+ }
+ # if -B was always available, we could skip this, but it is not
+ elsif (/GLX Visuals/){
+ last;
+ }
+ }
+ my ($direct_render,$renderer,$version) = ('N/A','N/A','N/A');
+ $direct_render = join ', ', @direct_render if @direct_render;
+ # non free drivers once filtered and cleaned show the same for core and compat
+ # but this stopped for some reason at 4.5/4.6 nvidia
+ if (@core_profile_version && @opengl_version &&
+ join ('', @core_profile_version) ne join( '', @opengl_version) &&
+ !(grep {/nvidia/i} @opengl_version ) ){
+ @opengl_version = @core_profile_version;
+ $b_compat = 1;
+ }
+ $version = join ', ', @opengl_version if @opengl_version;
+ $renderer = join ', ', @renderer if @renderer;
+ @row = ({
+ main::key($num++,'OpenGL') => '',
+ main::key($num++,'renderer') => $renderer,
+ main::key($num++,'v') => $version,
+ });
+
+ if ($b_compat && $extra > 1 && $compat_version){
+ $row[0]{main::key($num++,'compat-v')} = $compat_version;
+ }
+ if ($extra > 0){
+ $row[0]{main::key($num++,'direct render')} = $direct_render;
+ }
+ }
+ else {
+ @row = ({
+ main::key($num++,'Message') => main::row_defaults('glxinfo-missing'),
+ });
+ }
+ }
+ else {
+ my $type = 'display-console';
+ if (!main::check_program('glxinfo')){
+ $type = 'glxinfo-missing';
+ }
+ else {
+ if ($b_root){
+ $type = 'display-root';
+ }
+ else {
+ $type = 'display-try';
+ }
+ }
+ @row = ({
+ main::key($num++,'Message') => main::row_defaults($type),
+ });
+ }
+ eval $end if $b_log;
+ return @row;
+}
+sub tty_data(){
+ eval $start if $b_log;
+ my ($tty);
+ if ($size{'term-cols'}){
+ $tty = "$size{'term-cols'}x$size{'term-lines'}";
+ }
+ elsif ($b_irc && $client{'console-irc'}){
+ my $tty_working = main::get_tty_console_irc('tty');
+ if (my $program = main::check_program('stty')){
+ my $tty_arg = ($bsd_type) ? '-f' : '-F';
+ $tty = (main::grabber("$program $tty_arg /dev/pts/$tty_working size 2>/dev/null"))[0];
+ if ($tty){
+ my @temp = split /\s+/, $tty;
+ $tty = "$temp[1]x$temp[0]";
+ }
+ }
+ }
+ eval $end if $b_log;
+ return $tty;
+}
+sub x_drivers {
+ eval $start if $b_log;
+ my ($driver,@driver_data,,%drivers);
+ my ($alternate,$failed,$loaded,$sep,$unloaded) = ('','','','','');
+ if (my $log = main::system_files('xorg-log')){
+ # $log = "$ENV{HOME}/bin/scripts/inxi/data/xorg-logs/Xorg.0-voyager-serena.log";
+ # $log = "$ENV{HOME}/bin/scripts/inxi/data/xorg-logs/loading-unload-failed-all41-mint.txt";
+ # $log = "$ENV{HOME}/bin/scripts/inxi/data/xorg-logs/loading-unload-failed-phd21-mint.txt";
+ # $log = "$ENV{HOME}/bin/scripts/inxi/data/xorg-logs/Xorg.0-gm10.log";
+ my @xorg = main::reader($log);
+ # list is from sgfxi plus non-free drivers, plus ARM drivers
+ my $list = 'amdgpu|apm|ark|armsoc|ati|chips|cirrus|cyrix|fbdev|fbturbo|fglrx|glint|';
+ $list .= 'i128|i740|i810|iftv|imstt|intel|ivtv|mach64|mesa|mga|modesetting|';
+ $list .= 'neomagic|newport|nouveau|nsc|nvidia|nv|openchrome|radeonhd|radeon|';
+ $list .= 'rendition|s3virge|s3|savage|siliconmotion|sisimedia|sisusb|sis|tdfx|';
+ $list .= 'tga|trident|tseng|unichrome|v4l|vboxvideo|vesa|vga|via|vmware|voodoo';
+ # it's much cheaper to grab the simple pattern match then do the expensive one
+ # in the main loop.
+ #@xorg = grep {/Failed|Unload|Loading/} @xorg;
+ foreach (@xorg){
+ next if !/Failed|Unload|Loading/;
+ # print "$_\n";
+ # note that in file names, driver is always lower case
+ if (/\sLoading.*($list)_drv.so$/i ) {
+ $driver=lc($1);
+ # we get all the actually loaded drivers first, we will use this to compare the
+ # failed/unloaded, which have not always actually been truly loaded
+ $drivers{$driver}='loaded';
+ }
+ # openbsd uses UnloadModule:
+ elsif (/(Unloading\s|UnloadModule).*\"?($list)(_drv.so)?\"?$/i ) {
+ $driver=lc($2);
+ # we get all the actually loaded drivers first, we will use this to compare the
+ # failed/unloaded, which have not always actually been truly loaded
+ if (exists $drivers{$driver} && $drivers{$driver} ne 'alternate'){
+ $drivers{$driver}='unloaded';
+ }
+ }
+ # verify that the driver actually started the desktop, even with false failed messages
+ # which can occur. This is the driver that is actually driving the display.
+ # note that xorg will often load several modules, like modesetting,fbdev,nouveau
+ # NOTE:
+ #(II) UnloadModule: "nouveau"
+ #(II) Unloading nouveau
+ #(II) Failed to load module "nouveau" (already loaded, 0)
+ #(II) LoadModule: "modesetting"
+ elsif (/Failed.*($list)\"?.*$/i ) {
+ # Set driver to lower case because sometimes it will show as
+ # RADEON or NVIDIA in the actual x start
+ $driver=lc($1);
+ # we need to make sure that the driver has already been truly loaded,
+ # not just discussed
+ if (exists $drivers{$driver} && $drivers{$driver} ne 'alternate'){
+ if ( $_ !~ /\(already loaded/){
+ $drivers{$driver}='failed';
+ }
+ # reset the previous line's 'unloaded' to 'loaded' as well
+ else {
+ $drivers{$driver}='loaded';
+ }
+ }
+ elsif ($_ =~ /module does not exist/){
+ $drivers{$driver}='alternate';
+ }
+ }
+ }
+ my $sep = '';
+ foreach (sort keys %drivers){
+ if ($drivers{$_} eq 'loaded') {
+ $sep = ($loaded) ? ',' : '';
+ $loaded .= $sep . $_;
+ }
+ elsif ($drivers{$_} eq 'unloaded') {
+ $sep = ($unloaded) ? ',' : '';
+ $unloaded .= $sep . $_;
+ }
+ elsif ($drivers{$_} eq 'failed') {
+ $sep = ($failed) ? ',' : '';
+ $failed .= $sep . $_;
+ }
+ elsif ($drivers{$_} eq 'alternate') {
+ $sep = ($alternate) ? ',' : '';
+ $alternate .= $sep . $_;
+ }
+ }
+ $loaded ||= 'none';
+ @driver_data = ($loaded,$unloaded,$failed,$alternate);
+ }
+ eval $end if $b_log;
+ return @driver_data;
+}
+sub x_version {
+ eval $start if $b_log;
+ my ($version,@data,$program);
+ # IMPORTANT: both commands send version data to stderr!
+ if ($program = main::check_program('Xorg')){
+ @data = main::grabber("$program -version 2>&1");
+ }
+ elsif ($program = main::check_program('X')){
+ @data = main::grabber("$program -version 2>&1");
+ }
+ #print Data::Dumper::Dumper \@data;
+ if (@data){
+ foreach (@data){
+ if (/^X.org X server/i){
+ my @working = split /\s+/, $_;
+ $version = $working[3];
+ last;
+ }
+ elsif (/^X Window System Version/i) {
+ my @working = split /\s+/, $_;
+ $version = $working[4];
+ last;
+ }
+ }
+ }
+ eval $end if $b_log;
+ return $version;
+}
+# $1 - protocol: wayland|x11
+sub display_compositor {
+ eval $start if $b_log;
+ my ($protocol) = @_;
+ my ($compositor) = ('');
+ main::set_ps_gui() if ! $b_ps_gui;
+ if (@ps_gui){
+ # 1 check program; 2 search; 3 unused version; 4 print
+ my @compositors = (
+ ['budgie-wm','budgie-wm','','budgie-wm'],
+ ['compton','compton','','compton'],
+ ['enlightenment','enlightenment','','enlightenment'],
+ ['gnome-shell','gnome-shell','','gnome-shell'],
+ ['kwin_wayland','kwin_wayland','','kwin wayland'],
+ ['kwin_x11','kwin_x11','','kwin x11'],
+ #['kwin','kwin','','kwin'],
+ ['marco','marco','','marco'],
+ ['muffin','muffin','','muffin'],
+ ['mutter','mutter','','mutter'],
+ ['weston','weston','','weston'],
+ # owned by: compiz-core in debian
+ ['compiz','compiz','','compiz'],
+ # did not find follwing in debian apt
+ ['3dwm','3dwm','','3dwm'],
+ ['dwc','dwc','','dwc'],
+ ['grefson','grefson','','grefson'],
+ ['ireplace','ireplace','','ireplace'],
+ ['kmscon','kmscon','','kmscon'],
+ ['metisse','metisse','','metisse'],
+ ['mir','mir','','mir'],
+ ['moblin','moblin','','moblin'],
+ ['rustland','rustland','','rustland'],
+ ['sway','sway','','sway'],
+ ['swc','swc','','swc'],
+ ['unagi','unagi','','unagi'],
+ ['wayhouse','wayhouse','','wayhouse'],
+ ['westford','westford','','westford'],
+ ['xcompmgr','xcompmgr','','xcompmgr'],
+ );
+ foreach my $ref (@compositors){
+ my @item = @$ref;
+ # no need to use check program with short list of ps_gui
+ # if (main::check_program($item[0]) && (grep {/^$item[1]$/} @ps_gui ) ){
+ if (grep {/^$item[1]$/} @ps_gui){
+ $compositor = $item[3];
+ last;
+ }
+ }
+ }
+ main::log_data('data',"compositor: $compositor") if $b_log;
+ eval $end if $b_log;
+ return $compositor;
+}
+}
+
+## MachineData
+{
+package MachineData;
+
+sub get {
+ eval $start if $b_log;
+ my (%soc_machine,@data,@rows,$key1,$val1,$which);
+ my $num = 0;
+ if ($bsd_type && @sysctl_machine && !$b_dmidecode_force ){
+ @data = machine_data_sysctl();
+ if (!@data && !$key1){
+ $key1 = 'Message';
+ $val1 = main::row_defaults('machine-data-force-dmidecode','');
+ }
+ }
+ elsif ($bsd_type || $b_dmidecode_force){
+ my $ref = $alerts{'dmidecode'};
+ if ( $$ref{'action'} ne 'use'){
+ $key1 = $$ref{'action'};
+ $val1 = $$ref{$key1};
+ $key1 = ucfirst($key1);
+ }
+ else {
+ @data = machine_data_dmi();
+ if (!@data && !$key1){
+ $key1 = 'Message';
+ $val1 = main::row_defaults('machine-data','');
+ }
+ }
+ }
+ elsif (-d '/sys/class/dmi/id/') {
+ @data = machine_data_sys();
+ if (!@data){
+ $key1 = 'Message';
+ $val1 = main::row_defaults('machine-data-dmidecode','');
+ }
+ }
+ elsif (!$bsd_type) {
+ # this uses /proc/cpuinfo so only GNU/Linux
+ if ($b_arm || $b_mips){
+ %soc_machine = machine_data_soc();
+ @data = create_output_soc(%soc_machine) if %soc_machine;
+ }
+ if (!@data){
+ $key1 = 'Message';
+ $val1 = main::row_defaults('machine-data-force-dmidecode','');
+ }
+ }
+ # if error case, null data, whatever
+ if ($key1) {
+ @data = ({main::key($num++,$key1) => $val1,});
+ }
+ eval $end if $b_log;
+ return @data;
+}
+## keys for machine data are:
+# 0-sys_vendor 1-product_name 2-product_version 3-product_serial 4-product_uuid
+# 5-board_vendor 6-board_name 7-board_version 8-board_serial
+# 9-bios_vendor 10-bios_version 11-bios_date
+## with extra data:
+# 12-chassis_vendor 13-chassis_type 14-chassis_version 15-chassis_serial
+## unused: 16-bios_rev 17-bios_romsize 18 - firmware type
+sub create_output {
+ eval $start if $b_log;
+ my ($ref) = @_;
+ my (%data,@row,@rows);
+ %data = %$ref;
+ my $firmware = 'BIOS';
+ my $num = 0;
+ my $j = 0;
+ my ($b_chassis,$b_skip_chassis,$b_skip_system);
+ my ($bios_date,$bios_rev,$bios_romsize,$bios_vendor,$bios_version,$chassis_serial,
+ $chassis_type,$chassis_vendor,$chassis_version, $mobo_model,$mobo_serial,$mobo_vendor,
+ $mobo_version,$product_name,$product_serial,$product_version,$system_vendor);
+# foreach my $key (keys %data){
+# print "$key: $data{$key}\n";
+# }
+ if (!$data{'sys_vendor'} || ($data{'board_vendor'} &&
+ $data{'sys_vendor'} eq $data{'board_vendor'} && !$data{'product_name'} &&
+ !$data{'product_version'} && !$data{'product_serial'})){
+ $b_skip_system = 1;
+ }
+ # found a case of battery existing but having nothing in it on desktop mobo
+ # not all laptops show the first. /proc/acpi/battery is deprecated.
+ elsif ( !glob('/proc/acpi/battery/*') && !glob('/sys/class/power_supply/*') ){
+ # ibm / ibm can be true; dell / quantum is false, so in other words, only do this
+ # in case where the vendor is the same and the version is the same and not null,
+ # otherwise the version information is going to be different in all cases I think
+ if ( ($data{'sys_vendor'} && $data{'sys_vendor'} eq $data{'board_vendor'} ) &&
+ ( ($data{'product_version'} && $data{'product_version'} eq $data{'board_version'} ) ||
+ (!$data{'product_version'} && $data{'product_name'} eq $data{'board_name'} ) ) ){
+ $b_skip_system = 1;
+ }
+ }
+ $data{'device'} ||= 'N/A';
+ $j = scalar @rows;
+ @row = ({
+ main::key($num++,'Type') => ucfirst($data{'device'}),
+ },);
+ @rows = (@rows,@row);
+ if (!$b_skip_system){
+ # this has already been tested for above so we know it's not null
+ $system_vendor = main::cleaner($data{'sys_vendor'});
+ $product_name = ($data{'product_name'}) ? $data{'product_name'}:'N/A';
+ $product_version = ($data{'product_version'}) ? $data{'product_version'}:'N/A';
+ $product_serial = main::apply_filter($data{'product_serial'});
+ $rows[$j]{main::key($num++,'System')} = $system_vendor;
+ $rows[$j]{main::key($num++,'product')} = $product_name;
+ $rows[$j]{main::key($num++,'v')} = $product_version;
+ $rows[$j]{main::key($num++,'serial')} = $product_serial;
+ # no point in showing chassis if system isn't there, it's very unlikely that
+ # would be correct
+ if ($extra > 1){
+ if ($data{'board_version'} && $data{'chassis_version'} eq $data{'board_version'}){
+ $b_skip_chassis = 1;
+ }
+ if (!$b_skip_chassis && $data{'chassis_vendor'} ){
+ if ($data{'chassis_vendor'} ne $data{'sys_vendor'} ){
+ $chassis_vendor = $data{'chassis_vendor'};
+ }
+ # dmidecode can have these be the same
+ if ($data{'chassis_type'} && $data{'device'} ne $data{'chassis_type'} ){
+ $chassis_type = $data{'chassis_type'};
+ }
+ if ($data{'chassis_version'}){
+ $chassis_version = $data{'chassis_version'};
+ $chassis_version =~ s/^v([0-9])/$1/i;
+ }
+ $chassis_serial = main::apply_filter($data{'chassis_serial'});
+ $chassis_vendor ||= '';
+ $chassis_type ||= '';
+ $rows[$j]{main::key($num++,'Chassis')} = $chassis_vendor;
+ if ($chassis_type){
+ $rows[$j]{main::key($num++,'type')} = $chassis_type;
+ }
+ if ($chassis_version){
+ $rows[$j]{main::key($num++,'v')} = $chassis_version;
+ }
+ $rows[$j]{main::key($num++,'serial')} = $chassis_serial;
+ }
+ }
+ $j++; # start new row
+ }
+ if ($data{'firmware'}){
+ $firmware = $data{'firmware'};
+ }
+ $mobo_vendor = ($data{'board_vendor'}) ? main::cleaner($data{'board_vendor'}) : 'N/A';
+ $mobo_model = ($data{'board_name'}) ? $data{'board_name'}: 'N/A';
+ $mobo_version = ($data{'board_version'})? $data{'board_version'} : '';
+ $mobo_serial = main::apply_filter($data{'board_serial'});
+ $bios_vendor = ($data{'bios_vendor'}) ? main::cleaner($data{'bios_vendor'}) : 'N/A';
+ if ($data{'bios_version'}){
+ $bios_version = $data{'bios_version'};
+ $bios_version =~ s/^v([0-9])/$1/i;
+ if ($data{'bios_rev'}){
+ $bios_rev = $data{'bios_rev'};
+ }
+ }
+ $bios_version ||= 'N/A';
+ if ($data{'bios_date'}){
+ $bios_date = $data{'bios_date'};
+ }
+ $bios_date ||= 'N/A';
+ if ($extra > 1 && $data{'bios_romsize'}){
+ $bios_romsize = $data{'bios_romsize'};
+ }
+ $rows[$j]{main::key($num++,'Mobo')} = $mobo_vendor;
+ $rows[$j]{main::key($num++,'model')} = $mobo_model;
+ if ($mobo_version){
+ $rows[$j]{main::key($num++,'v')} = $mobo_version;
+ }
+ $rows[$j]{main::key($num++,'serial')} = $mobo_serial;
+ if ($extra > 2 && $data{'board_uuid'}){
+ $rows[$j]{main::key($num++,'uuid')} = $data{'board_uuid'};
+ }
+ $rows[$j]{main::key($num++,$firmware)} = $bios_vendor;
+ $rows[$j]{main::key($num++,'v')} = $bios_version;
+ if ($bios_rev){
+ $rows[$j]{main::key($num++,'rev')} = $bios_rev;
+ }
+ $rows[$j]{main::key($num++,'date')} = $bios_date;
+ if ($bios_romsize){
+ $rows[$j]{main::key($num++,'rom size')} = $bios_romsize;
+ }
+ eval $end if $b_log;
+ return @rows;
+}
+sub create_output_soc {
+ my (%data,@row,@rows);
+ my (%soc_machine) = @_;
+ my $num = 0;
+ my $j = 0;
+ #print Data::Dumper::Dumper \%soc_machine;
+ # this is sketchy, /proc/device-tree/model may be similar to Hardware value from /proc/cpuinfo
+ # raspi: Hardware : BCM2835 model: Raspberry Pi Model B Rev 2
+ if ($soc_machine{'device'} || $soc_machine{'model'}){
+ my $key = ($b_arm) ? 'ARM Device': 'MIPS Device';
+ $rows[$j]{main::key($num++,'Type')} = $key;
+ my $system = 'System';
+ if (defined $soc_machine{'model'}){
+ $rows[$j]{main::key($num++,'System')} = $soc_machine{'model'};
+ $system = 'details';
+ }
+ my $device = $soc_machine{'device'};
+ $device ||= 'N/A';
+ $rows[$j]{main::key($num++,$system)} = $device;
+ }
+ # we're going to print N/A for 0000 values sine the item was there.
+ if ($soc_machine{'firmware'}){
+ # most samples I've seen are like: 0000
+ $soc_machine{'firmware'} =~ s/^[0]+$//;
+ $soc_machine{'firmware'} ||= 'N/A';
+ $rows[$j]{main::key($num++,'rev')} = $soc_machine{'firmware'};
+ }
+ # sometimes has value like: 0000
+ if (defined $soc_machine{'serial'}){
+ # most samples I've seen are like: 0000
+ $soc_machine{'serial'} =~ s/^[0]+$//;
+ $rows[$j]{main::key($num++,'serial')} = main::apply_filter($soc_machine{'serial'});
+ }
+ eval $end if $b_log;
+ return @rows;
+}
+
+sub machine_data_sys {
+ eval $start if $b_log;
+ my (%data,$path,$vm);
+ my $sys_dir = '/sys/class/dmi/id/';
+ my $sys_dir_alt = '/sys/devices/virtual/dmi/id/';
+ my @sys_files = qw(bios_vendor bios_version bios_date
+ board_name board_serial board_vendor board_version chassis_type
+ product_name product_serial product_uuid product_version sys_vendor
+ );
+ if ($extra > 1){
+ splice @sys_files, 0, 0, qw( chassis_serial chassis_vendor chassis_version);
+ }
+ $data{'firmware'} = 'BIOS';
+ # print Data::Dumper::Dumper \@sys_files;
+ if (!-d $sys_dir ){
+ if ( -d $sys_dir_alt){
+ $sys_dir = $sys_dir_alt;
+ }
+ else {
+ return 0;
+ }
+ }
+ if ( -d '/sys/firmware/efi'){
+ $data{'firmware'} = 'UEFI';
+ }
+ elsif ( glob('/sys/firmware/acpi/tables/UEFI*') ){
+ $data{'firmware'} = 'UEFI [Legacy]';
+ }
+ foreach (@sys_files){
+ $path = "$sys_dir$_";
+ if (-r $path){
+ $data{$_} = (main::reader($path))[0];
+ $data{$_} = ($data{$_}) ? main::dmi_cleaner($data{$_}) : '';
+ }
+ elsif (!$b_root && -e $path && !-r $path ){
+ $data{$_} = main::row_defaults('root-required');
+ }
+ else {
+ $data{$_} = '';
+ }
+ }
+ if ($data{'chassis_type'}){
+ if ( $data{'chassis_type'} == 1){
+ $data{'device'} = get_device_vm($data{'sys_vendor'},$data{'product_name'});
+ $data{'device'} ||= 'other-vm?';
+ }
+ else {
+ $data{'device'} = get_device_sys($data{'chassis_type'});
+ }
+ }
+# print "sys:\n";
+# foreach (keys %data){
+# print "$_: $data{$_}\n";
+# }
+ main::log_data('dump','%data',\%data) if $b_log;
+ my @rows = create_output(\%data);
+ eval $end if $b_log;
+ return @rows;
+}
+# this will create an alternate machine data source
+# which will be used for alt ARM machine data in cases
+# where no dmi data present, or by cpu data to guess at
+# certain actions for arm only.
+sub machine_data_soc {
+ eval $end if $b_log;
+ my (%soc_machine,@temp);
+ if (my $file = main::system_files('cpuinfo')){
+ #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/arm/arm-shevaplug-1.2ghz.txt";
+ my @data = main::reader($file);
+ foreach (@data){
+ if (/^(Hardware|machine)\s*:/i){
+ @temp = split /\s*:\s*/, $_;
+ $temp[1] = main::arm_cleaner($temp[1]);
+ $temp[1] = main::dmi_cleaner($temp[1]);
+ $soc_machine{'device'} = main::cleaner($temp[1]);
+ }
+ elsif (/^(system type)\s*:/i){
+ @temp = split /\s*:\s*/, $_;
+ $temp[1] = main::dmi_cleaner($temp[1]);
+ $soc_machine{'model'} = main::cleaner($temp[1]);
+ }
+ elsif (/^Revision/i){
+ @temp = split /\s*:\s*/, $_;
+ $soc_machine{'firmware'} = $temp[1];
+ }
+ elsif (/^Serial/i){
+ @temp = split /\s*:\s*/, $_;
+ $soc_machine{'serial'} = $temp[1];
+ }
+ }
+ }
+ if (!$soc_machine{'model'} && -f '/proc/device-tree/model'){
+ my $model = (main::reader('/proc/device-tree/model'))[0];
+ main::log_data('data',"device-tree-model: $model") if $b_log;
+ if ( $model ){
+ $model = main::dmi_cleaner($model);
+ $model = (split /\x01|\x02|\x03|\x00/, $model)[0] if $model;
+ # idea was to use only first part of string, but now try using all
+ #my (@result) = ();
+ #@result = split(/\s+/, $soc_machine{'device'}) if $soc_machine{'device'};
+ if ( !$soc_machine{'device'} || ($model && $model !~ /$soc_machine{'device'}/i) ){
+ $model = main::arm_cleaner($model);
+ $soc_machine{'model'} = $model;
+ }
+ }
+ }
+ if (!$soc_machine{'serial'} && -f '/proc/device-tree/serial-number'){
+ my $serial = (main::reader('/proc/device-tree/serial-number'))[0];
+ $serial = (split /\x01|\x02|\x03|\x00/, $serial)[0] if $serial;
+ main::log_data('data',"device-tree-serial: $serial") if $b_log;
+ $soc_machine{'serial'} = $serial if $serial;
+ }
+ #print Data::Dumper::Dumper \%soc_machine;
+ eval $end if $b_log;
+ return %soc_machine;
+}
+
+# bios_date: 09/07/2010
+# bios_romsize: dmi only
+# bios_vendor: American Megatrends Inc.
+# bios_version: P1.70
+# bios_rev: 8.14: dmi only
+# board_name: A770DE+
+# board_serial:
+# board_vendor: ASRock
+# board_version:
+# chassis_serial:
+# chassis_type: 3
+# chassis_vendor:
+# chassis_version:
+# firmware:
+# product_name:
+# product_serial:
+# product_uuid:
+# product_version:
+# sys_uuid: dmi/sysctl only
+# sys_vendor:
+sub machine_data_dmi {
+ eval $start if $b_log;
+ my (%data,$vm);
+ return if ! @dmi;
+ $data{'firmware'} = 'BIOS';
+ # dmi types:
+ # 0 bios; 1 system info; 2 board|base board info; 3 chassis info;
+ # 4 processor info, use to check for hypervisor
+ foreach (@dmi){
+ my @ref = @$_;
+ # bios/firmware
+ if ($ref[0] == 0){
+ # skip first three row, we don't need that data
+ splice @ref, 0, 3 if @ref;
+ foreach my $item (@ref){
+ if ($item !~ /^~/){ # skip the indented rows
+ my @value = split /:\s+/, $item;
+ if ($value[0] eq 'Release Date') {$data{'bios_date'} = main::dmi_cleaner($value[1]) }
+ elsif ($value[0] eq 'Vendor') {$data{'bios_vendor'} = main::dmi_cleaner($value[1]) }
+ elsif ($value[0] eq 'Version') {$data{'bios_version'} = main::dmi_cleaner($value[1]) }
+ elsif ($value[0] eq 'ROM Size') {$data{'bios_romsize'} = main::dmi_cleaner($value[1]) }
+ elsif ($value[0] eq 'BIOS Revision') {$data{'bios_rev'} = main::dmi_cleaner($value[1]) }
+ elsif ($value[0] =~ /^UEFI is supported/) {$data{'firmware'} = 'UEFI';}
+ }
+ }
+ next;
+ }
+ # system information
+ elsif ($ref[0] == 1){
+ # skip first three row, we don't need that data
+ splice @ref, 0, 3 if @ref;
+ foreach my $item (@ref){
+ if ($item !~ /^~/){ # skip the indented rows
+ my @value = split /:\s+/, $item;
+ if ($value[0] eq 'Product Name') {$data{'product_name'} = main::dmi_cleaner($value[1]) }
+ elsif ($value[0] eq 'Version') {$data{'product_version'} = main::dmi_cleaner($value[1]) }
+ elsif ($value[0] eq 'Serial Number') {$data{'product_serial'} = main::dmi_cleaner($value[1]) }
+ elsif ($value[0] eq 'Manufacturer') {$data{'sys_vendor'} = main::dmi_cleaner($value[1]) }
+ elsif ($value[0] eq 'UUID') {$data{'sys_uuid'} = main::dmi_cleaner($value[1]) }
+ }
+ }
+ next;
+ }
+ # baseboard information
+ elsif ($ref[0] == 2){
+ # skip first three row, we don't need that data
+ splice @ref, 0, 3 if @ref;
+ foreach my $item (@ref){
+ if ($item !~ /^~/){ # skip the indented rows
+ my @value = split /:\s+/, $item;
+ if ($value[0] eq 'Product Name') {$data{'board_name'} = main::dmi_cleaner($value[1]) }
+ elsif ($value[0] eq 'Serial Number') {$data{'board_serial'} = main::dmi_cleaner($value[1]) }
+ elsif ($value[0] eq 'Manufacturer') {$data{'board_vendor'} = main::dmi_cleaner($value[1]) }
+ }
+ }
+ next;
+ }
+ # chassis information
+ elsif ($ref[0] == 3){
+ # skip first three row, we don't need that data
+ splice @ref, 0, 3 if @ref;
+ foreach my $item (@ref){
+ if ($item !~ /^~/){ # skip the indented rows
+ my @value = split /:\s+/, $item;
+ if ($value[0] eq 'Serial Number') {$data{'chassis_serial'} = main::dmi_cleaner($value[1]) }
+ elsif ($value[0] eq 'Type') {$data{'chassis_type'} = main::dmi_cleaner($value[1]) }
+ elsif ($value[0] eq 'Manufacturer') {$data{'chassis_vendor'} = main::dmi_cleaner($value[1]) }
+ elsif ($value[0] eq 'Version') {$data{'chassis_version'} = main::dmi_cleaner($value[1]) }
+ }
+ }
+ if ( $data{'chassis_type'} && $data{'chassis_type'} ne 'Other' ){
+ $data{'device'} = $data{'chassis_type'};
+ }
+ next;
+ }
+ # this may catch some BSD and fringe Linux cases
+ # processor information: check for hypervisor
+ elsif ($ref[0] == 4){
+ # skip first three row, we don't need that data
+ splice @ref, 0, 3 if @ref;
+ if (!$data{'device'}){
+ if (grep {/hypervisor/i} @ref){
+ $data{'device'} = 'virtual-machine';
+ }
+ }
+ last;
+ }
+ elsif ($ref[0] > 4){
+ last;
+ }
+ }
+ if (!$data{'device'}){
+ $data{'device'} = get_device_vm($data{'sys_vendor'},$data{'product_name'});
+ $data{'device'} ||= 'other-vm?';
+ }
+# print "dmi:\n";
+# foreach (keys %data){
+# print "$_: $data{$_}\n";
+# }
+ main::log_data('dump','%data',\%data) if $b_log;
+ my @rows = create_output(\%data);
+ eval $end if $b_log;
+ return @rows;
+}
+# As far as I know, only OpenBSD supports this method.
+# it uses hw. info from sysctl -a and bios info from dmesg.boot
+sub machine_data_sysctl {
+ eval $start if $b_log;
+ my (%data,$vm);
+ # ^hw\.(vendor|product|version|serialno|uuid)
+ foreach (@sysctl_machine){
+ next if ! $_;
+ my @item = split /:/, $_;
+ next if ! $item[1];
+ if ($item[0] eq 'hw.vendor'){
+ $data{'board_vendor'} = main::dmi_cleaner($item[1]);
+ }
+ elsif ($item[0] eq 'hw.product'){
+ $data{'board_name'} = main::dmi_cleaner($item[1]);
+ }
+ elsif ($item[0] eq 'hw.version'){
+ $data{'board_version'} = $item[1];
+ }
+ elsif ($item[0] eq 'hw.serialno'){
+ $data{'board_serial'} = $item[1];
+ }
+ elsif ($item[0] eq 'hw.serial'){
+ $data{'board_serial'} = $item[1];
+ }
+ elsif ($item[0] eq 'hw.uuid'){
+ $data{'board_uuid'} = $item[1];
+ }
+ # bios0:at mainbus0: AT/286+ BIOS, date 06/30/06, BIOS32 rev. 0 @ 0xf2030, SMBIOS rev. 2.4 @ 0xf0000 (47 entries)
+ # bios0:vendor Phoenix Technologies, LTD version "3.00" date 06/30/2006
+ elsif ($item[0] =~ /^bios[0-9]/){
+ if ($_ =~ /^^bios[0-9]:at\s.*\srev\.\s([\S]+)\s@.*/){
+ $data{'bios_rev'} = $1;
+ $data{'firmware'} = 'BIOS' if $_ =~ /BIOS/;
+ }
+ elsif ($item[1] =~ /^vendor\s(.*)\sversion\s"?([\S]+)"?\sdate\s([\S]+)/ ){
+ $data{'bios_vendor'} = $1;
+ $data{'bios_version'} = $2;
+ $data{'bios_date'} = $3;
+ $data{'bios_version'} =~ s/^v//i if $data{'bios_version'} && $data{'bios_version'} !~ /vi/i;
+ }
+ }
+ }
+ my @rows = create_output(\%data);
+ eval $end if $b_log;
+ return @rows;
+}
+
+sub get_device_sys {
+ eval $start if $b_log;
+ my ($chasis_id) = @_;
+ my ($device) = ('');
+ my @chassis;
+ # https://www.dmtf.org/sites/default/files/standards/documents/DSP0134_2.8.0.pdf
+ $chassis[2] = 'unknown';
+ # note: 13 is all-in-one which we take as a mac type system
+ $chassis[3] = 'desktop';
+ $chassis[4] = 'desktop';
+ $chassis[6] = 'desktop';
+ $chassis[7] = 'desktop';
+ $chassis[13] = 'desktop';
+ $chassis[15] = 'desktop';
+ $chassis[24] = 'desktop';
+ # 5 - pizza box was a 1 U desktop enclosure, but some old laptops also id this way
+ $chassis[5] = 'pizza-box';
+ $chassis[9] = 'laptop';
+ # note: lenovo T420 shows as 10, notebook, but it's not a notebook
+ $chassis[10] = 'laptop';
+ $chassis[16] = 'laptop';
+ $chassis[14] = 'notebook';
+ $chassis[8] = 'portable';
+ $chassis[11] = 'portable';
+ $chassis[17] = 'server';
+ $chassis[23] = 'server';
+ $chassis[25] = 'server';
+ $chassis[27] = 'blade';
+ $chassis[25] = 'blade';
+ $chassis[29] = 'blade';
+ $chassis[12] = 'docking-station';
+ $chassis[18] = 'expansion-chassis';
+ $chassis[19] = 'sub-chassis';
+ $chassis[20] = 'bus-expansion';
+ $chassis[21] = 'peripheral';
+ $chassis[22] = 'RAID';
+ $chassis[26] = 'compact-PCI';
+ $device = $chassis[$chasis_id] if $chassis[$chasis_id];
+ eval $end if $b_log;
+ return $device;
+}
+
+sub get_device_vm {
+ eval $start if $b_log;
+ my ($manufacturer,$product_name) = @_;
+ my $vm;
+ if ( my $program = main::check_program('systemd-detect-virt') ){
+ my $vm_test = (main::grabber("$program 2>/dev/null"))[0];
+ if ($vm_test){
+ # kvm vbox reports as oracle, usually, unless they change it
+ if (lc($vm_test) eq 'oracle'){
+ $vm = 'virtualbox';
+ }
+ elsif ( $vm_test ne 'none'){
+ $vm = $vm_test;
+ }
+ }
+ }
+ if (!$vm || lc($vm) eq 'bochs') {
+ if (-e '/proc/vz'){$vm = 'openvz'}
+ elsif (-e '/proc/xen'){$vm = 'xen'}
+ elsif (-e '/dev/vzfs'){$vm = 'virtuozzo'}
+ elsif (my $program = main::check_program('lsmod')){
+ my @vm_data = main::grabber("$program 2>/dev/null");
+ if (@vm_data){
+ if (grep {/kqemu/i} @vm_data){$vm = 'kqemu'}
+ elsif (grep {/kvm/i} @vm_data){$vm = 'kvm'}
+ elsif (grep {/qemu/i} @vm_data){$vm = 'qemu'}
+ }
+ }
+ }
+ # this will catch many Linux systems and some BSDs
+ if (!$vm || lc($vm) eq 'bochs' ) {
+ my @vm_data = (@pci,@sysctl,@dmesg_boot);
+ if (-e '/dev/disk/by-id'){
+ my @dev = glob('/dev/disk/by-id/*');
+ @vm_data = (@vm_data,@dev);
+ }
+ if ( grep {/innotek|vbox|virtualbox/i} @vm_data){
+ $vm = 'virtualbox';
+ }
+ elsif (grep {/vmware/i} @vm_data){
+ $vm = 'vmware';
+ }
+ elsif (grep {/Virtual HD/i} @vm_data){
+ $vm = 'hyper-v';
+ }
+ if (!$vm && (my $file = main::system_files('cpuinfo'))){
+ my @info = main::reader($file);
+ $vm = 'virtual-machine' if grep {/^flags.*hypervisor/} @info;
+ }
+ if (!$vm && -e '/dev/vda' || -e '/dev/vdb' || -e '/dev/xvda' || -e '/dev/xvdb' ){
+ $vm = 'virtual-machine';
+ }
+ }
+ if (!$vm && $product_name){
+ if ($product_name eq 'VMware'){
+ $vm = 'vmware';
+ }
+ elsif ($product_name eq 'VirtualBox'){
+ $vm = 'virtualbox';
+ }
+ elsif ($product_name eq 'KVM'){
+ $vm = 'kvm';
+ }
+ elsif ($product_name eq 'Bochs'){
+ $vm = 'qemu';
+ }
+ }
+ if (!$vm && $manufacturer && $manufacturer eq 'Xen'){
+ $vm = 'xen';
+ }
+ eval $end if $b_log;
+ return $vm;
+}
+
+}
+
+## NetworkData
+{
+package NetworkData;
+my ($b_ip_run,@ifs_found);
+sub get {
+ eval $start if $b_log;
+ my (@data,@rows);
+ my $num = 0;
+ if (($b_arm || $b_mips) && !$b_soc_net && !$b_pci_tool){
+ # do nothing, but keep the test conditions to force
+ # the non arm case to always run
+ }
+ else {
+ @data = card_data();
+ @rows = (@rows,@data) if @data;
+ }
+ @data = usb_data();
+ @rows = (@rows,@data) if @data;
+ # note: rasberry pi uses usb networking only
+ if (!@rows && ($b_arm || $b_mips)){
+ my $key = ($b_arm) ? 'ARM' : 'MIPS';
+ @data = ({
+ main::key($num++,$key) => main::row_defaults(lc($key) . '-pci',''),
+ },);
+ @rows = (@rows,@data);
+ }
+ if ($show{'network-advanced'}){
+ # @ifs_found = ();
+ # shift @ifs_found;
+ # pop @ifs_found;
+ if (!$bsd_type){
+ @data = advanced_data_sys('check','',0,'','');
+ @rows = (@rows,@data) if @data;
+ }
+ else {
+ @data = advanced_data_bsd('check');
+ @rows = (@rows,@data) if @data;
+ }
+ }
+ if ($show{'ip'}){
+ @data = wan_ip();
+ @rows = (@rows,@data);
+ }
+ eval $end if $b_log;
+ return @rows;
+}
+# 1 type_id
+# 2 bus_id
+# 3 sub_id
+# 4 device
+# 5 vendor_id
+# 6 chip_id
+# 7 rev
+# 8 port
+# 9 driver
+# 10 modules
+# 11 driver nu (bsds)
+sub card_data {
+ eval $start if $b_log;
+ my ($b_wifi,@rows,@data,%holder);
+ my ($j,$num) = (0,1);
+ foreach (@pci){
+ $num = 1;
+ my @row = @$_;
+ #print "$row[0] $row[3]\n";
+ # NOTE: class 06 subclass 80
+ # https://www-s.acm.illinois.edu/sigops/2007/roll_your_own/7.c.1.html
+ if (($row[0] && $row[0] =~ /^(eth|ethernet|ethernet-phy|network|wifi|wlan)$/ )|| ($row[1] && $row[1] eq '0680' ) ){
+ #print "$row[0] $row[3]\n";
+ $j = scalar @rows;
+ my $driver = $row[9];
+ my $chip_id = "$row[5]:$row[6]";
+ # working around a virtuo bug same chip id is used on two nics
+ if (!defined $holder{$chip_id}){
+ $holder{$chip_id} = 0;
+ }
+ else {
+ $holder{$chip_id}++;
+ }
+ # first check if it's a known wifi id'ed card, if so, no print of duplex/speed
+ $b_wifi = check_wifi($row[4]);
+ my $card = $row[4];
+ $card = ($card) ? main::pci_cleaner($card,'output') : 'N/A';
+ #$card ||= 'N/A';
+ $driver ||= 'N/A';
+ @data = ({
+ main::key($num++,'Card') => $card,
+ },);
+ @rows = (@rows,@data);
+ #if ($extra > 2 && $b_pci_tool && $row[11]){
+ # my $item = main::get_pci_vendor($row[4],$row[11]);
+ # $rows[$j]{main::key($num++,'model')} = $item if $item;
+ #}
+ if ($row[1] eq '0680'){
+ $rows[$j]{main::key($num++,'type')} = 'network bridge';
+ }
+ $rows[$j]{main::key($num++,'driver')} = $driver;
+ if ($extra > 0){
+ if ($row[9] && !$bsd_type){
+ my $version = main::get_module_version($row[9]);
+ $version ||= 'N/A';
+ $rows[$j]{main::key($num++,'v')} = $version;
+ }
+ $row[8] ||= 'N/A';
+ # as far as I know, wifi has no port, but in case it does in future, use it
+ $rows[$j]{main::key($num++,'port')} = $row[8] if (!$b_wifi || ( $b_wifi && $row[8] ne 'N/A') );
+ my $bus_id = 'N/A';
+ # note: for arm/mips we want to see the single item bus id, why not?
+ if ($row[2] && $row[3]){$bus_id = "$row[2].$row[3]"}
+ elsif ($row[2]){$bus_id = $row[2]}
+ elsif ($row[3]){$bus_id = $row[3]}
+ $rows[$j]{main::key($num++,'bus ID')} = $bus_id;
+ }
+ if ($extra > 1){
+ $rows[$j]{main::key($num++,'chip ID')} = $chip_id;
+ }
+ if ($show{'network-advanced'}){
+ if (!$bsd_type){
+ @data = advanced_data_sys($row[5],$row[6],$holder{$chip_id},$b_wifi,'');
+ }
+ else {
+ @data = advanced_data_bsd("$row[9]$row[11]",$b_wifi);
+ }
+ @rows = (@rows,@data);
+ }
+ }
+ #print "$row[0]\n";
+ }
+ # @rows = ();
+ # we want to handle ARM errors in main get
+ if (!@rows && !$b_arm){
+ my $key = 'Message';
+ @data = ({
+ main::key($num++,$key) => main::row_defaults('pci-card-data',''),
+ },);
+ @rows = (@rows,@data);
+
+ }
+ #my $ref = $pci[-1];
+ #print $$ref[0],"\n";
+ eval $end if $b_log;
+ return @rows;
+}
+sub usb_data {
+ eval $start if $b_log;
+ my (@data,@rows,@temp2,$b_wifi,$driver,$path,$product,$product2,$test,$vendor,$vendor2);
+ my ($j,$num) = (0,1);
+ return if !@usb;
+ foreach my $ref (@usb){
+ my @row = @$ref;
+ # a device will always be the second or > device on the bus
+ if ($row[1] > 1){
+ $num = 1;
+ ($product,$product2,$test,$vendor,$vendor2) = ('','','','','');
+ if ($usb_level == 1){
+ $product = main::cleaner($row[3]);
+ }
+ else {
+ foreach my $line (@row){
+ my @working = split /:/, $line;
+ if ($working[0] eq 'idVendor' && $working[2]){
+ $vendor = main::cleaner($working[2]);
+ }
+ if ($working[0] eq 'idProduct' && $working[2]){
+ $product = main::cleaner($working[2]);
+ }
+ if ($working[0] eq 'iVendor' && $working[2]){
+ $product2 = main::cleaner($working[2]);
+ }
+ if ($working[0] eq 'iProduct' && $working[2]){
+ $product2 = main::cleaner($working[2]);
+ }
+ if ($working[0] eq 'Descriptor_Configuration'){
+ last;
+ }
+ }
+ if ($vendor && $product){
+ $product = ($product =~ /$vendor/) ? $product: "$vendor $product";
+ }
+ elsif ($vendor && $product2){
+ $product = ($product2 =~ /$vendor/) ? $product2: "$vendor $product2";
+ }
+ elsif ($vendor2 && $product){
+ $product = ($product =~ /$vendor2/) ? $product: "$vendor2 $product";
+ }
+ elsif ($vendor2 && $product2){
+ $product = ($product2 =~ /$vendor2/) ? $product2: "$vendor2 $product2";
+ }
+ elsif ($vendor){
+ $product = $vendor;
+ }
+ elsif ($vendor2){
+ $product = $vendor2;
+ }
+ $test = "$vendor $product $vendor2 $vendor2";
+ }
+ if ($product && network_device($test)){
+ @temp2 = main::get_usb_drivers($row[0],$row[2]) if !$bsd_type && -d "/sys/devices";
+ if (@temp2){
+ $driver = $temp2[0] if $temp2[0];
+ $path = $temp2[1] if $temp2[1];
+ }
+ $driver ||= 'usb-network';
+ @data = ({
+ main::key($num++,'Card') => $product,
+ main::key($num++,'type') => 'USB',
+ main::key($num++,'driver') => $driver,
+ },);
+ $b_wifi = check_wifi($product);
+ @rows = (@rows,@data);
+ if ($extra > 0){
+ $rows[$j]{main::key($num++,'bus ID')} = "$row[0]:$row[1]";
+ }
+ if ($extra > 1){
+ $rows[$j]{main::key($num++,'chip ID')} = $row[2];
+ }
+ if ($show{'network-advanced'}){
+ if (!$bsd_type){
+ my (@temp,$vendor,$chip);
+ @temp = split (/:/, $row[2]) if $row[2];
+ ($vendor,$chip) = ($temp[0],$temp[1]) if @temp;
+ @data = advanced_data_sys($vendor,$chip,0,$b_wifi,$path);
+ }
+ # NOTE: we need the driver.number, like wlp0 to get a match, and
+ # we can't get that from usb data, so we have to let it fall back down
+ # to the check function for BSDs.
+ #else {
+ # @data = advanced_data_bsd($row[2],$b_wifi);
+ #}
+ @rows = (@rows,@data) if @data;
+ }
+ $j = scalar @rows;
+ }
+ }
+ }
+ eval $end if $b_log;
+ return @rows;
+}
+sub advanced_data_sys {
+ eval $start if $b_log;
+ return if ! -d '/sys/class/net';
+ my ($vendor,$chip,$count,$b_wifi,$path_usb) = @_;
+ my $num = 0;
+ my $key = 'IF';
+ my ($b_check,$b_usb,$if,$path,@paths,@row,@rows);
+ # ntoe: we've already gotten the base path, now we
+ # we just need to get the IF path, which is one level in:
+ # usb1/1-1/1-1:1.0/net/enp0s20f0u1/
+ if ($path_usb){
+ $b_usb = 1;
+ @paths = main::globber("${path_usb}*/net/*");
+ }
+ else {
+ @paths = main::globber('/sys/class/net/*');
+ }
+ @paths = grep {!/\/lo$/} @paths;
+ if ( $count > 0 && $count < scalar @paths ){
+ @paths = splice @paths, $count, scalar @paths;
+ }
+ if ($vendor eq 'check'){
+ $b_check = 1;
+ $key = 'IF-ID';
+ }
+ #print join '; ', @paths, $count, "\n";
+ foreach (@paths){
+ my ($data1,$data2,$duplex,$mac,$speed,$state);
+ # for usb, we already know where we are
+ if (!$b_usb){
+ if (!$b_arm || $b_pci_tool ){
+ $path = "$_/device/vendor";
+ $data1 = (main::reader($path))[0] if -e $path;
+ $data1 =~ s/^0x// if $data1;
+ $path = "$_/device/device";
+ $data2 = (main::reader($path))[0] if -e $path;
+ $data2 =~ s/^0x// if $data2;
+ # this is a fix for a redhat bug in virtio
+ $data2 = (defined $data2 && $data2 eq '0001' && defined $chip && $chip eq '1000') ? '1000' : $data2;
+ }
+ elsif ($b_arm) {
+ $path = Cwd::abs_path($_);
+ $path =~ /($chip)/;
+ if ($1){
+ $data1 = $vendor;
+ $data2 = $chip;
+ }
+ }
+ }
+ #print "d1:$data1 v:$vendor d2:$data2 c:$chip\n";
+ if ( $b_usb || $b_check || ( $data1 && $data2 && $data1 eq $vendor && $data2 eq $chip )) {
+ $if = $_;
+ $if =~ s/^\/.+\///;
+ # print "top: if: $if ifs: @ifs_found\n";
+ next if ($b_check && grep {/$if/} @ifs_found);
+ $path = "$_/duplex";
+ $duplex = (main::reader($path))[0] if -e $path;
+ $duplex ||= 'N/A';
+ $path = "$_/address";
+ $mac = (main::reader($path))[0] if -e $path;
+ $mac = main::apply_filter($mac);
+ $path = "$_/speed";
+ $speed = (main::reader($path))[0] if -e $path;
+ $speed ||= 'N/A';
+ $path = "$_/operstate";
+ $state = (main::reader($path))[0] if -e $path;
+ $state ||= 'N/A';
+ #print "$speed \n";
+ @row = ({
+ main::key($num++,$key) => $if,
+ main::key($num++,'state') => $state,
+ },);
+ #my $j = scalar @row - 1;
+ push (@ifs_found, $if) if (!$b_check && (! grep {/$if/} @ifs_found));
+ # print "push: if: $if ifs: @ifs_found\n";
+ # no print out for wifi since it doesn't have duplex/speed data available
+ # note that some cards show 'unknown' for state, so only testing explicitly
+ # for 'down' string in that to skip showing speed/duplex
+ # /sys/class/net/$if/wireless : nont always there, but worth a try: wlan/wl/ww/wlp
+ $b_wifi = 1 if !$b_wifi && ( -e "$_$if/wireless" || $if =~ /^(wl|ww)/);
+ if (!$b_wifi && $state ne 'down' && $state ne 'no'){
+ # make sure the value is strictly numeric before appending Mbps
+ $speed = ($speed =~ /^[0-9]+$/) ? "$speed Mbps" : $speed;
+ $row[0]{main::key($num++,'speed')} = $speed;
+ $row[0]{main::key($num++,'duplex')} = $duplex;
+ }
+ $row[0]{main::key($num++,'mac')} = $mac;
+ if ($b_check){
+ @rows = (@rows,@row);
+ }
+ else {
+ @rows = @row;
+ }
+ if ($show{'ip'}){
+ @row = if_ip($if);
+ @rows = (@rows,@row);
+ }
+ last if !$b_check;
+ }
+ }
+ eval $end if $b_log;
+ return @rows;
+}
+sub advanced_data_bsd {
+ eval $start if $b_log;
+ return if ! @ifs_bsd;
+ my ($if,$b_wifi) = @_;
+ my (@data,@row,@rows,$working_if);
+ my ($b_check,$state,$speed,$duplex,$mac);
+ my $num = 0;
+ my $key = 'IF';
+ my $j = 0;
+ if ($if eq 'check'){
+ $b_check = 1;
+ $key = 'IF-ID';
+ }
+ foreach my $ref (@ifs_bsd){
+ if (ref $ref ne 'ARRAY'){
+ $working_if = $ref;
+ # print "$working_if\n";
+ next;
+ }
+ else {
+ @data = @$ref;
+ }
+ if ( $b_check || $working_if eq $if){
+ $if = $working_if if $b_check;
+ # print "top: if: $if ifs: @ifs_found\n";
+ next if ($b_check && grep {/$if/} @ifs_found);
+ foreach my $line (@data){
+ # ($state,$speed,$duplex,$mac)
+ $duplex = $data[2];
+ $duplex ||= 'N/A';
+ $mac = main::apply_filter($data[3]);
+ $speed = $data[1];
+ $speed ||= 'N/A';
+ $state = $data[0];
+ $state ||= 'N/A';
+ #print "$speed \n";
+ @row = ({
+ main::key($num++,$key) => $if,
+ main::key($num++,'state') => $state,
+ },);
+ push (@ifs_found, $if) if (!$b_check && (! grep {/$if/} @ifs_found ));
+ # print "push: if: $if ifs: @ifs_found\n";
+ # no print out for wifi since it doesn't have duplex/speed data available
+ # note that some cards show 'unknown' for state, so only testing explicitly
+ # for 'down' string in that to skip showing speed/duplex
+ if (!$b_wifi && $state ne 'down' && $state ne 'no'){
+ # make sure the value is strictly numeric before appending Mbps
+ $speed = ($speed =~ /^[0-9]+$/) ? "$speed Mbps" : $speed;
+ $row[0]{main::key($num++,'speed')} = $speed;
+ $row[0]{main::key($num++,'duplex')} = $duplex;
+ }
+ $row[0]{main::key($num++,'mac')} = $mac;
+ }
+ @rows = (@rows,@row);
+ if ($show{'ip'}){
+ @row = if_ip($if) if $if;
+ @rows = (@rows,@row) if @row;
+ }
+ }
+ }
+ eval $end if $b_log;
+ return @rows;
+}
+## values:
+# 0 - ipv
+# 1 - ip
+# 2 - broadcast, if found
+# 3 - scope, if found
+# 4 - scope if, if different from if
+sub if_ip {
+ eval $start if $b_log;
+ my ($if) = @_;
+ my (@data,@row,@rows,$working_if);
+ my $num = 0;
+ my $j = 0;
+ $b_ip_run = 1;
+ OUTER:
+ foreach my $ref (@ifs){
+ if (ref $ref ne 'ARRAY'){
+ $working_if = $ref;
+ # print "if:$if wif:$working_if\n";
+ next;
+ }
+ else {
+ @data = @$ref;
+ # print "ref:$ref\n";
+ }
+ if ($working_if eq $if){
+ foreach my $ref2 (@data){
+ $j = scalar @rows;
+ $num = 1;
+ if ($limit > 0 && $j >= $limit){
+ @row = ({
+ main::key($num++,'Message') => main::row_defaults('output-limit',scalar @data),
+ },);
+ @rows = (@rows,@row);
+ last OUTER;
+ }
+ my @data2 = @$ref2;
+ #print "$data2[0] $data2[1]\n";
+ my ($ipv,$ip,$broadcast,$scope,$scope_id);
+ $ipv = ($data2[0])? $data2[0]: 'N/A';
+ $ip = main::apply_filter($data2[1]);
+ $scope = ($data2[3])? $data2[3]: 'N/A';
+ if ($if ne 'all'){
+ if (defined $data2[4] && $working_if ne $data2[4]){
+ # scope global temporary deprecated dynamic
+ # scope global dynamic
+ # scope global temporary deprecated dynamic
+ # scope site temporary deprecated dynamic
+ # scope global dynamic noprefixroute enx403cfc00ac68
+ # scope global eth0
+ # scope link
+ # scope site dynamic
+ # scope link
+ # trim off if at end of multi word string if found
+ $data2[4] =~ s/\s$if$// if $data2[4] =~ /[^\s]+\s$if$/;
+ my $key = ($data2[4] =~ /deprecated|dynamic|temporary|noprefixroute/ ) ? 'type':'virtual' ;
+ @row = ({
+ main::key($num++,"IP v$ipv") => $ip,
+ main::key($num++,$key) => $data2[4],
+ main::key($num++,'scope') => $scope,
+ },);
+ }
+ else {
+ @row = ({
+ main::key($num++,"IP v$ipv") => $ip,
+ main::key($num++,'scope') => $scope,
+ },);
+ }
+ }
+ else {
+ @row = ({
+ main::key($num++,'IF') => $if,
+ main::key($num++,"IP v$ipv") => $ip,
+ main::key($num++,'scope') => $scope,
+ },);
+ }
+ @rows = (@rows,@row);
+ if ($extra > 1 && $data2[2]){
+ $broadcast = main::apply_filter($data2[2]);
+ $rows[$j]{main::key($num++,'broadcast')} = $broadcast;
+ }
+ }
+ }
+ }
+ eval $end if $b_log;
+ return @rows;
+}
+# get ip using downloader to stdout. This is a clean, text only IP output url,
+# single line only, ending in the ip address. May have to modify this in the future
+# to handle ipv4 and ipv6 addresses but should not be necessary.
+# ip=$( echo 2001:0db8:85a3:0000:0000:8a2e:0370:7334 | gawk --re-interval '
+# ip=$( wget -q -O - $WAN_IP_URL | gawk --re-interval '
+# this generates a direct dns based ipv4 ip address, but if opendns.com goes down,
+# the fall backs will still work.
+# note: consistently slower than domain based:
+# dig +short +time=1 +tries=1 myip.opendns.com. A @208.67.222.222
+sub wan_ip {
+ eval $start if $b_log;
+ my (@data,$ip);
+ my $num = 0;
+ # time: 0.06 - 0.07 seconds
+ if (my $program = main::check_program('dig')){
+ $ip = (main::grabber("$program +short +time=1 +tries=1 myip.opendns.com \@resolver1.opendns.com 2>/dev/null"))[0];
+ }
+ else {
+ # note: tests: akamai: 0.055 - 0.065 icanhazip.com: 0.177 0.164
+ # smxi: 0.525, so almost 10x slower. Dig is fast too
+ # leaving smxi as last test because I know it will always be up.
+ my @urls = qw( http://whatismyip.akamai.com/ http://icanhazip.com/ https://smxi.org/opt/ip.php);
+ foreach (@urls){
+ $ip = main::download_file('stdout',$_);
+ if ($ip){
+ # print "$_\n";
+ chomp $ip;
+ $ip = (split /\s+/, $ip)[-1];
+ last;
+ }
+ }
+ }
+ if ($ip && $show{'filter'}){
+ $ip = $filter_string;
+ }
+ $ip ||= main::row_defaults('IP', 'WAN IP');
+ @data = ({
+ main::key($num++,'WAN IP') => $ip,
+ },);
+ eval $end if $b_log;
+ return @data;
+}
+
+### USB networking search string data, because some brands can have other products than
+### wifi/nic cards, they need further identifiers, with wildcards.
+### putting the most common and likely first, then the less common, then some specifics
+
+# Wi-Fi.*Adapter Wireless.*Adapter Ethernet.*Adapter WLAN.*Adapter
+# Network.*Adapter 802\.11 Atheros Atmel D-Link.*Adapter D-Link.*Wireless Linksys
+# Netgea Ralink Realtek.*Network Realtek.*Wireless Realtek.*WLAN Belkin.*Wireless
+# Belkin.*WLAN Belkin.*Network Actiontec.*Wireless Actiontec.*Network AirLink.*Wireless
+# Asus.*Network Asus.*Wireless Buffalo.*Wireless Davicom DWA-.*RangeBooster DWA-.*Wireless
+# ENUWI-.*Wireless LG.*Wi-Fi Rosewill.*Wireless RNX-.*Wireless Samsung.*LinkStick
+# Samsung.*Wireless Sony.*Wireless TEW-.*Wireless TP-Link.*Wireless
+# WG[0-9][0-9][0-9].*Wireless WNA[0-9][0-9][0-9] WNDA[0-9][0-9][0-9]
+# Zonet.*ZEW.*Wireless
+sub network_device {
+ eval $start if $b_log;
+ my ($device_string) = @_;
+ my ($b_network);
+ # belkin=050d; d-link=07d1; netgear=0846; ralink=148f; realtek=0bda;
+ # Atmel makes other stuff
+ my @tests = qw(wifi Wi-Fi.*Adapter Ethernet \bLAN\b WLAN Network 802\.11
+ Wireless.*Adapter 54\sMbps Network 100\/1000 Mobile\sBroadband Atheros D-Link.*Adapter
+ Dell.*Wireless D-Link.*Wireless Linksys Netgea Ralink Realtek.*Network Realtek.*Wireless
+ Belkin.*Wireless Actiontec.*Wireless AirLink.*Wireless Asus.*Wireless
+ Buffalo.*Wireless Davicom DWA-.*RangeBooster DWA-.*Wireless
+ ENUWI-.*Wireless LG.*Wi-Fi Rosewill.*Wireless RNX-.*Wireless Samsung.*LinkStick
+ Samsung.*Wireless Sony.*Wireless TEW-.*Wireless TP-Link.*Wireless
+ WG[0-9][0-9][0-9].*Wireless WNA[0-9][0-9][0-9] WNDA[0-9][0-9][0-9]
+ Zonet.*ZEW.*Wireless 050d:935b 0bda:8189 0bda:8197
+ );
+ foreach (@tests){
+ if ($device_string =~ /$_/i ){
+ $b_network = 1;
+ last;
+ }
+ }
+ eval $end if $b_log;
+ return $b_network;
+}
+sub check_wifi {
+ my ($item) = @_;
+ my $b_wifi = ($item =~ /wireless|wifi|wi-fi|wlan|802\.11|centrino/i) ? 1 : 0;
+ return $b_wifi;
+}
+}
+
+## OpticalData
+{
+package OpticalData;
+
+sub get {
+ eval $start if $b_log;
+ my (@data,@rows,$key1,$val1);
+ my $num = 0;
+ if ($bsd_type){
+ #@data = optical_data_bsd();
+ $key1 = 'Optical Report';
+ $val1 = main::row_defaults('optical-data-bsd');
+ @data = ({main::key($num++,$key1) => $val1,});
+ if ( @dm_boot_optical){
+ @data = optical_data_bsd();
+ }
+ else{
+ my $file = main::system_files('dmesg-boot');
+ if ( $file && ! -r $file ){
+ $val1 = main::row_defaults('dmesg-boot-permissions');
+ }
+ elsif (!$file){
+ $val1 = main::row_defaults('dmesg-boot-missing');
+ }
+ else {
+ $val1 = main::row_defaults('optical-data-bsd');
+ }
+ $key1 = 'Optical Report';
+ @data = ({main::key($num++,$key1) => $val1,});
+ }
+ }
+ else {
+ @data = optical_data_linux();
+ }
+ if (!@data){
+ $key1 = 'Message';
+ $val1 = main::row_defaults('optical-data');
+ @data = ({main::key($num++,$key1) => $val1,});
+ }
+ @rows = (@rows,@data);
+ eval $end if $b_log;
+ return @rows;
+}
+sub create_output {
+ eval $start if $b_log;
+ my (%devices) = @_;
+ my (@data,@rows);
+ my $num = 0;
+ my $j = 0;
+ # build floppy if any
+ foreach my $key (sort keys %devices){
+ if ($devices{$key}{'type'} eq 'floppy'){
+ @data = ({ main::key($num++,ucfirst($devices{$key}{'type'})) => "/dev/$key"});
+ @rows = (@rows,@data);
+ delete $devices{$key};
+ }
+ }
+ foreach my $key (sort keys %devices){
+ $j = scalar @rows;
+ $num = 1;
+ my $vendor = $devices{$key}{'vendor'};
+ $vendor ||= 'N/A';
+ my $model = $devices{$key}{'model'};
+ $model ||= 'N/A';
+ @data = ({
+ main::key($num++,ucfirst($devices{$key}{'type'})) => "/dev/$key",
+ main::key($num++,'vendor') => $vendor,
+ main::key($num++,'model') => $model,
+ });
+ @rows = (@rows,@data);
+ if ($extra > 0){
+ my $rev = $devices{$key}{'rev'};
+ $rev ||= 'N/A';
+ $rows[$j]{ main::key($num++,'rev')} = $rev;
+ }
+ if ($extra > 1 && $devices{$key}{'serial'}){
+ $rows[$j]{ main::key($num++,'serial')} = main::apply_filter($devices{$key}{'serial'});
+ }
+ my $ref = $devices{$key}{'links'};
+ my $links = (@$ref) ? join ',', sort @$ref: 'N/A' ;
+ $rows[$j]{ main::key($num++,'dev-links')} = $links;
+ if ($show{'optical'}){
+ $j = scalar @rows;
+ my $speed = $devices{$key}{'speed'};
+ $speed ||= 'N/A';
+ my ($audio,$multisession) = ('','');
+ if (defined $devices{$key}{'multisession'}){
+ $multisession = ( $devices{$key}{'multisession'} == 1 ) ? 'yes' : 'no' ;
+ }
+ $multisession ||= 'N/A';
+ if (defined $devices{$key}{'audio'}){
+ $audio = ( $devices{$key}{'audio'} == 1 ) ? 'yes' : 'no' ;
+ }
+ $audio ||= 'N/A';
+ my $dvd = 'N/A';
+ my (@rw,$rws);
+ if (defined $devices{$key}{'dvd'}){
+ $dvd = ( $devices{$key}{'dvd'} == 1 ) ? 'yes' : 'no' ;
+ }
+ if ($devices{$key}{'cdr'}){
+ push @rw, 'cd-r';
+ }
+ if ($devices{$key}{'cdrw'}){
+ push @rw, 'cd-rw';
+ }
+ if ($devices{$key}{'dvdr'}){
+ push @rw, 'dvd-r';
+ }
+ if ($devices{$key}{'dvdram'}){
+ push @rw, 'dvd-ram';
+ }
+ $rws = (@rw) ? join ',', @rw: 'none' ;
+ @data = ({
+ main::key($num++,'Features') => '',
+ main::key($num++,'speed') => $speed,
+ main::key($num++,'multisession') => $multisession,
+ main::key($num++,'audio') => $audio,
+ main::key($num++,'dvd') => $dvd,
+ main::key($num++,'rw') => $rws,
+ });
+ @rows = (@rows,@data);
+
+ if ($extra > 0 ){
+ my $state = $devices{$key}{'state'};
+ $state ||= 'N/A';
+ $rows[$j]{ main::key($num++,'state')} = $state;
+ }
+ }
+ }
+ #print Data::Dumper::Dumper \%devices;
+ eval $end if $b_log;
+ return @rows;
+}
+sub optical_data_bsd {
+ eval $start if $b_log;
+ my (@data,%devices,@rows,@temp);
+ my ($count,$i,$working) = (0,0,'');
+ foreach (@dm_boot_optical){
+ $_ =~ s/(cd[0-9]+)\(([^:]+):([0-9]+):([0-9]+)\):/$1:$2-$3.$4,/;
+ my @row = split /:\s*/, $_;
+ next if ! defined $row[1];
+ if ($working ne $row[0]){
+ # print "$id_holder $row[0]\n";
+ $working = $row[0];
+ }
+ # no dots, note: ada2: 2861588MB BUT: ada2: 600.000MB/s
+ if (! exists $devices{$working}){
+ $devices{$working} = ({});
+ $devices{$working}{'links'} = ([]);
+ $devices{$working}{'model'} = '';
+ $devices{$working}{'rev'} = '';
+ $devices{$working}{'state'} = '';
+ $devices{$working}{'vendor'} = '';
+ $devices{$working}{'temp'} = '';
+ $devices{$working}{'type'} = ($working =~ /^cd/) ? 'optical' : 'unknown';
+ }
+ #print "$_\n";
+ if ($bsd_type ne 'openbsd'){
+ if ($row[1] && $row[1] =~ /^<([^>]+)>/){
+ $devices{$working}{'model'} = $1;
+ $count = ($devices{$working}{'model'} =~ tr/ //);
+ if ($count && $count > 1){
+ @temp = split /\s+/, $devices{$working}{'model'};
+ $devices{$working}{'vendor'} = $temp[0];
+ my $index = ($#temp > 2 ) ? ($#temp - 1): $#temp;
+ $devices{$working}{'model'} = join ' ', @temp[1..$index];
+ $devices{$working}{'rev'} = $temp[-1] if $count > 2;
+ }
+ if ($show{'optical'}){
+ if (/\bDVD\b/){
+ $devices{$working}{'dvd'} = 1;
+ }
+ if (/\bRW\b/){
+ $devices{$working}{'cdrw'} = 1;
+ $devices{$working}{'dvdr'} = 1 if $devices{$working}{'dvd'};
+ }
+ }
+ }
+ if ($row[1] && $row[1] =~ /^Serial/){
+ @temp = split /\s+/,$row[1];
+ $devices{$working}{'serial'} = $temp[-1];
+ }
+ if ($show{'optical'}){
+ if ($row[1] =~ /^([0-9\.]+[MGTP][B]?\/s)/){
+ $devices{$working}{'speed'} = $1;
+ $devices{$working}{'speed'} =~ s/\.[0-9]+//;
+ }
+ if (/\bDVD[-]?RAM\b/){
+ $devices{$working}{'cdr'} = 1;
+ $devices{$working}{'dvdram'} = 1;
+ }
+ if ($row[2] && $row[2] =~ /,\s(.*)$/){
+ $devices{$working}{'state'} = $1;
+ $devices{$working}{'state'} =~ s/\s+-\s+/, /;
+ }
+ }
+ }
+ else {
+ if ($row[2] && $row[2] =~ /<([^>]+)>/){
+ $devices{$working}{'model'} = $1;
+ $count = ($devices{$working}{'model'} =~ tr/,//);
+ #print "c: $count $row[2]\n";
+ if ($count && $count > 1){
+ @temp = split /,\s*/, $devices{$working}{'model'};
+ $devices{$working}{'vendor'} = $temp[0];
+ $devices{$working}{'model'} = $temp[1];
+ $devices{$working}{'rev'} = $temp[2];
+ }
+ if ($show{'optical'}){
+ if (/\bDVD\b/){
+ $devices{$working}{'dvd'} = 1;
+ }
+ if (/\bRW\b/){
+ $devices{$working}{'cdrw'} = 1;
+ $devices{$working}{'dvdr'} = 1 if $devices{$working}{'dvd'};
+ }
+ if (/\bDVD[-]?RAM\b/){
+ $devices{$working}{'cdr'} = 1;
+ $devices{$working}{'dvdram'} = 1;
+ }
+ }
+ }
+ if ($show{'optical'}){
+ #print "$row[1]\n";
+ if (($row[1] =~ tr/,//) > 1){
+ @temp = split /,\s*/, $row[1];
+ $devices{$working}{'speed'} = $temp[2];
+ }
+
+ }
+ }
+ }
+
+ main::log_data('dump','%devices',\%devices) if $b_log;
+ #print Data::Dumper::Dumper \%devices;
+ @rows = create_output(%devices) if %devices;
+ eval $end if $b_log;
+ return @rows;
+}
+sub optical_data_linux {
+ eval $start if $b_log;
+ my (@data,%devices,@info,@rows);
+ @data = main::globber('/dev/dvd* /dev/cdr* /dev/scd* /dev/sr* /dev/fd[0-9]');
+ # Newer kernel is NOT linking all optical drives. Some, but not all.
+ # Get the actual disk dev location, first try default which is easier to run,
+ # need to preserve line breaks
+ foreach (@data){
+ my $working = readlink($_);
+ $working = ($working) ? $working: $_;
+ next if $working =~ /random/;
+ # possible fix: puppy has these in /mnt not /dev they say
+ $working =~ s/\/(dev|media|mnt)\///;
+ $_ =~ s/\/(dev|media|mnt)\///;
+ if (! defined $devices{$working}){
+ my @temp = ($_ ne $working) ? ([$_]) : ([]);
+ $devices{$working} = ({'links' => @temp});
+ $devices{$working}{'type'} = ($working =~ /^fd/) ? 'floppy' : 'optical' ;
+ }
+ else {
+ my $ref = $devices{$working}{'links'};
+ push @$ref, $_ if $_ ne $working;
+ }
+ #print "$working\n";
+ }
+ if ($show{'optical'} && -e '/proc/sys/dev/cdrom/info'){
+ @info = main::reader('/proc/sys/dev/cdrom/info','strip');
+ }
+ #print join '; ', @data, "\n";
+ foreach my $key (keys %devices){
+ next if $devices{$key}{'type'} eq 'floppy';
+ my $device = "/sys/block/$key/device";
+ if ( -d $device){
+ if (-e "$device/vendor"){
+ $devices{$key}{'vendor'} = (main::reader("$device/vendor"))[0];
+ $devices{$key}{'vendor'} = main::cleaner($devices{$key}{'vendor'});
+ $devices{$key}{'state'} = (main::reader("$device/state"))[0];
+ $devices{$key}{'model'} = (main::reader("$device/model"))[0];
+ $devices{$key}{'model'} = main::cleaner($devices{$key}{'model'});
+ $devices{$key}{'rev'} = (main::reader("$device/rev"))[0];
+ }
+ }
+ elsif ( -e "/proc/ide/$_/model"){
+ $devices{$key}{'vendor'} = (main::reader("/proc/ide/$_/model"))[0];
+ $devices{$key}{'vendor'} = main::cleaner($devices{$key}{'vendor'});
+ }
+ if ($show{'optical'} && @info){
+ my $index = 0;
+ foreach my $item (@info){
+ next if $item =~ /^\s*$/;
+ my @split = split '\s+', $item;
+ if ($item =~ /^drive name:/){
+ foreach my $id (@split){
+ last if ($id eq $key);
+ $index++;
+ }
+ last if ! $index; # index will be > 0 if it was found
+ }
+ elsif ($item =~/^drive speed:/) {
+ $devices{$key}{'speed'} = $split[$index];
+ }
+ elsif ($item =~/^Can read multisession:/) {
+ $devices{$key}{'multisession'}=$split[$index+1];
+ }
+ elsif ($item =~/^Can read MCN:/) {
+ $devices{$key}{'mcn'}=$split[$index+1];
+ }
+ elsif ($item =~/^Can play audio:/) {
+ $devices{$key}{'audio'}=$split[$index+1];
+ }
+ elsif ($item =~/^Can write CD-R:/) {
+ $devices{$key}{'cdr'}=$split[$index+1];
+ }
+ elsif ($item =~/^Can write CD-RW:/) {
+ $devices{$key}{'cdrw'}=$split[$index+1];
+ }
+ elsif ($item =~/^Can read DVD:/) {
+ $devices{$key}{'dvd'}=$split[$index+1];
+ }
+ elsif ($item =~/^Can write DVD-R:/) {
+ $devices{$key}{'dvdr'}=$split[$index+1];
+ }
+ elsif ($item =~/^Can write DVD-RAM:/) {
+ $devices{$key}{'dvdram'}=$split[$index+1];
+ }
+ }
+ }
+ }
+ main::log_data('dump','%devices',\%devices) if $b_log;
+ #print Data::Dumper::Dumper \%devices;
+ @rows = create_output(%devices) if %devices;
+ eval $end if $b_log;
+ return @rows;
+}
+
+}
+
+## PartitionData
+{
+package PartitionData;
+
+sub get {
+ eval $start if $b_log;
+ my (@rows,$key1,$val1);
+ my $num = 0;
+ partition_data() if !$b_partitions;
+ if (!@partitions) {
+ $key1 = 'Message';
+ #$val1 = ($bsd_type && $bsd_type eq 'darwin') ?
+ # main::row_defaults('darwin-feature') : main::row_defaults('partition-data');
+ $val1 = main::row_defaults('partition-data');
+ @rows = ({main::key($num++,$key1) => $val1,});
+ }
+ else {
+ @rows = create_output();
+ }
+ eval $end if $b_log;
+ return @rows;
+}
+sub create_output {
+ eval $start if $b_log;
+ my $num = 0;
+ my $j = 0;
+ my (@data,@data2,%part,@rows,$dev,$dev_type,$fs);
+ @partitions = sort { $a->{'id'} cmp $b->{'id'} } @partitions;
+ foreach my $ref (@partitions){
+ my %row = %$ref;
+ $num = 1;
+ next if $row{'type'} eq 'secondary' && $show{'partition'};
+ @data2 = main::get_size($row{'size'}) if (defined $row{'size'});
+ my $size = (@data2) ? $data2[0] . ' ' . $data2[1]: 'N/A';
+ @data2 = main::get_size($row{'used'}) if (defined $row{'used'});
+ my $used = (@data2) ? $data2[0] . ' ' . $data2[1]: 'N/A';
+ my $percent = (defined $row{'percent-used'}) ? ' (' . $row{'percent-used'} . '%)' : '';
+ %part = ();
+ if (defined $row{'dev-base'}){
+ if ($row{'dev-base'} =~ /^non-dev-/){
+ $row{'dev-base'} =~ s/^non-dev-//;
+ $dev_type = 'raid';
+ $dev = $row{'dev-base'};
+ }
+ # note: I have seen this: beta:data/ for sshfs path
+ elsif ($row{'dev-base'} =~ /^\/\/|:\//){
+ $dev_type = 'remote';
+ $dev = $row{'dev-base'};
+ }
+ # an error has occurred almost for sure
+ elsif (!$row{'dev-base'}){
+ $dev_type = 'dev';
+ $dev = main::row_defaults('unknown-dev');
+ }
+ else {
+ $dev_type = 'dev';
+ $dev = '/dev/' . $row{'dev-base'};
+ }
+ }
+ else {
+ $dev_type = 'dev';
+ }
+ $fs = ($row{'fs'}) ? lc($row{'fs'}): 'N/A';
+ $dev ||= 'N/A';
+ $j = scalar @rows;
+ @data = ({
+ main::key($num++,'ID') => $row{'id'},
+ main::key($num++,'size') => $size,
+ main::key($num++,'used') => $used . $percent,
+ main::key($num++,'fs') => $fs,
+ main::key($num++,$dev_type) => $dev,
+ });
+ @rows = (@rows,@data);
+ if ($show{'label'}){
+ $rows[$j]{main::key($num++,'label')} = ($row{'label'}) ? $row{'label'}: 'N/A';
+ }
+ if ($show{'uuid'}){
+ $rows[$j]{main::key($num++,'uuid')} = ($row{'uuid'}) ? $row{'uuid'}: 'N/A';
+ }
+ }
+ eval $end if $b_log;
+ return @rows;
+}
+
+sub partition_data {
+ eval $start if $b_log;
+ #return if $bsd_type && $bsd_type eq 'darwin'; # darwin has muated output, of course
+ my (@data,@rows,@mapper,@mount,@partitions_working,%part);
+ my ($b_fake_map,$b_fs,$b_load,$cols,$roots) = (0,1,0,6,0);
+ my ($back_size,$back_used) = (4,3);
+ my ($dev_base,$fs,$id,$label,$percent_used,$size,$type,$uuid,$used);
+ $b_partitions = 1;
+ set_lsblk() if !$bsd_type && !$b_lsblk;
+ # set labels, uuid, gpart
+ set_label_uuid() if !$b_label_uuid;
+ # most current OS support -T and -k, but -P means different things
+ # in freebsd. However since most use is from linux, we make that default
+ if (!$bsd_type){
+ @partitions_working = main::grabber("df -P -T -k 2>/dev/null");
+ if (-d '/dev/mapper'){
+ @mapper = main::globber('/dev/mapper/*');
+ }
+ }
+ else {
+ # this is missing the file system data
+ if ($bsd_type ne 'darwin'){
+ @partitions_working = main::grabber("df -T -k 2>/dev/null");
+ }
+ #Filesystem 1024-blocks Used Available Capacity iused ifree %iused Mounted on
+ else {
+ $cols = 8;
+ $b_fake_map = 1;
+ ($back_size,$back_used) = (7,6);
+ }
+ }
+ # busybox only supports -k and -P, openbsd, darwin
+ if (!@partitions_working){
+ @partitions_working = main::grabber("df -k 2>/dev/null");
+ $b_fs = 0;
+ $cols = 5 if !$bsd_type || $bsd_type ne 'darwin';
+ if (my $path = main::check_program('mount')){
+ @mount = main::grabber("$path 2>/dev/null");
+ }
+ }
+ # determine positions
+ my $row1 = shift @partitions_working;
+ # new kernels/df have rootfs and / repeated, creating two entries for the same partition
+ # so check for two string endings of / then slice out the rootfs one, I could check for it
+ # before slicing it out, but doing that would require the same action twice re code execution
+ foreach (@partitions_working){
+ if (/\s\/$/){
+ $roots++;
+ }
+ }
+ @partitions_working = grep {!/^rootfs/} @partitions_working if $roots > 1;
+ my $filters = '^(aufs|cgroup.*|cgmfs|configfs|debugfs|\/dev|dev|\/dev/loop[0-9]*|';
+ $filters .= 'devfs|devtmpfs|fdescfs|iso9660|linprocfs|none|procfs|\/run(\/.*)?|';
+ $filters .= 'run|shm|squashfs|sys|\/sys\/.*|sysfs|tmpfs|type|udev|unionfs|vartmp)$';
+ foreach (@partitions_working){
+ # stupid apple bullshit
+ $_ =~ s/^map\s+([\S]+)/map:\/$1/ if $b_fake_map;
+ my @row = split /\s+/, $_;
+ if ($row[0] =~ /$filters/ || $row[0] =~ /^ROOT/i || ($b_fs && $row[1] eq 'tmpfs')){
+ next;
+ }
+ $dev_base = '';
+ $fs = '';
+ $id = '';
+ $label = '';
+ $size = 0;
+ $used = 0;
+ %part = ();
+ $percent_used = 0;
+ $type = '';
+ $uuid = '';
+ $b_load = 0;
+ # NOTE: using -P for linux fixes line wraps, and for bsds, assuming they don't use such long file names
+ if ($row[0] =~ /^\/dev\/|:\/|\/\//){
+ # this could point to by-label or by-uuid so get that first. In theory, abs_path should
+ # drill down to get the real path, but it isn't always working.
+ if ($row[0] eq '/dev/root'){
+ $row[0] = get_root();
+ }
+ # sometimes paths are set using /dev/disk/by-[label|uuid] so we need to get the /dev/xxx path
+ if ($row[0] =~ /by-label|by-uuid/){
+ $row[0] = Cwd::abs_path($row[0]);
+ }
+ elsif ($row[0] =~ /mapper\// && @mapper){
+ $row[0] = get_mapper($row[0],@mapper);
+ }
+ $dev_base = $row[0];
+ $dev_base =~ s/^\/dev\///;
+ %part = check_lsblk($dev_base,0) if @lsblk;
+ }
+ # this handles zfs type devices/partitions, which do not start with / but contain /
+ # note: Main/jails/transmission_1 path can be > 1 deep
+ # Main zfs 3678031340 8156 3678023184 0% /mnt/Main
+ if (!$dev_base && ($row[0] =~ /^([^\/]+\/)(.+)/ || ($row[0] =~ /^[^\/]+$/ && $row[1] =~ /^(btrfs|zfs)$/ ) ) ){
+ $dev_base = "non-dev-$row[0]";
+ }
+ # this handles yet another fredforfaen special case where a mounted drive
+ # has the search string in its name
+ if ($row[-1] =~ /^\/$|^\/boot$|^\/var$|^\/var\/tmp$|^\/var\/log$|^\/home$|^\/opt$|^\/tmp$|^\/usr$/){
+ $b_load = 1;
+ # note, older df in bsd do not have file system column
+ $type = 'main';
+ }
+ elsif ($row[$cols] !~ /^\/$|^\/boot$|^\/var$|^\/var\/tmp$|^\/var\/log$|^\/home$|^\/opt$|^\/tmp$|^\/usr$|^filesystem/){
+ $b_load = 1;
+ $type = 'secondary';
+ }
+ if ($b_load){
+ if (!$bsd_type){
+ if ($b_fs){
+ $fs = (%part && $part{'fs'}) ? $part{'fs'} : $row[1];
+ }
+ else {
+ $fs = get_mounts_fs($row[0],@mount);
+ }
+ if ($show{'label'}) {
+ if (%part && $part{'label'}) {
+ $label = $part{'label'};
+ }
+ elsif ( @labels){
+ $label = get_label($row[0]);
+ }
+ }
+ if ($show{'uuid'}) {
+ if (%part && $part{'uuid'}) {
+ $uuid = $part{'uuid'};
+ }
+ elsif ( @uuids){
+ $uuid = get_uuid($row[0]);
+ }
+ }
+ }
+ else {
+ $fs = ($b_fs) ? $row[1]: get_mounts_fs($row[0],@mount);
+ if (@gpart && ($show{'label'} || $show{'uuid'} ) ){
+ my @extra = get_bsd_label_uuid("$dev_base");
+ if (@extra){
+ $label = $extra[0];
+ $uuid = $extra[1];
+ }
+ }
+ }
+ $id = join ' ', @row[$cols .. $#row];
+ $id =~ s/\/home\/[^\/]+\/(.*)/\/home\/$filter_string\/$1/ if $show{'filter'};
+ $size = $row[$cols - $back_size];
+ $used = $row[$cols - $back_used];
+ $percent_used = sprintf( "%.1f", ( $used/$size )*100 ) if ($size);
+ @data = ({
+ 'id' => $id,
+ 'dev-base' => $dev_base,
+ 'fs' => $fs,
+ 'label' => $label,
+ 'size' => $size,
+ 'type' => $type,
+ 'used' => $used,
+ 'uuid' => $uuid,
+ 'percent-used' => $percent_used,
+ });
+ @partitions = (@partitions,@data);
+ }
+ }
+ @data = swap_data();
+ @partitions = (@partitions,@data);
+ main::log_data('dump','@partitions',\@partitions) if $b_log;
+ # print Data::Dumper::Dumper \@partitions;
+ eval $end if $b_log;
+}
+
+sub swap_data {
+ eval $start if $b_log;
+ my (@swap,@working,$path,$label,$uuid);
+ my ($s,$j,$size_id,$used_id) = (1,0,2,3);
+ if (!$bsd_type){
+ # faster, avoid subshell, same as swapon -s
+ if ( -r '/proc/swaps'){
+ @working = main::reader("/proc/swaps");
+ }
+ elsif ( $path = main::check_program('swapon') ){
+ # note: while -s is deprecated, --show --bytes is not supported
+ # on older systems
+ @working = main::grabber("$path -s 2>/dev/null");
+ }
+ }
+ else {
+ if ( $path = main::check_program('swapctl') ){
+ # output in in KB blocks
+ @working = main::grabber("$path -l -k 2>/dev/null");
+ }
+ ($size_id,$used_id) = (1,2);
+ }
+ # now add the swap partition data, don't want to show swap files, just partitions,
+ # though this can include /dev/ramzswap0. Note: you can also use /proc/swaps for this
+ # data, it's the same exact output as swapon -s
+ foreach (@working){
+ next if ! /^\/dev/ || /^\/dev\/(ramzwap|zram)/;
+ my @data = split /\s+/, $_;
+ my $dev_base = $data[0];
+ $dev_base =~ s/^\/dev\///;
+ my $size = $data[$size_id];
+ my $used = $data[$used_id];
+ my $percent_used = sprintf( "%.1f", ( $used/$size )*100 );
+ if ($show{'label'} && @labels){
+ $label = get_label($data[0]);
+ }
+ if ($show{'uuid'} && @uuids){
+ $uuid = get_uuid($data[0]);
+ }
+ if ($bsd_type && @gpart && ($show{'label'} || $show{'uuid'} ) ){
+ my @extra = get_bsd_label_uuid("$dev_base");
+ if (@extra){
+ $label = $extra[0];
+ $uuid = $extra[1];
+ }
+ }
+ @data = ({
+ 'id' => "swap-$s",
+ 'dev-base' => $dev_base,
+ 'fs' => 'swap',
+ 'label' => $label,
+ 'size' => $size,
+ 'type' => 'main',
+ 'used' => $used,
+ 'uuid' => $uuid,
+ 'percent-used' => $percent_used,
+ });
+ @swap = (@swap,@data);
+ $s++;
+ }
+ eval $end if $b_log;
+ return @swap;
+}
+sub get_mounts_fs {
+ eval $start if $b_log;
+ my ($item,@mount) = @_;
+ $item =~ s/map:\/(\S+)/map $1/ if $bsd_type && $bsd_type eq 'darwin';
+ return 'N/A' if ! @mount;
+ my ($fs) = ('');
+ # linux: /dev/sdb6 on /var/www/m type ext4 (rw,relatime,data=ordered)
+ # /dev/sda3 on /root.dev/ugw type ext3 (rw,relatime,errors=continue,user_xattr,acl,barrier=1,data=journal)
+ # bsd: /dev/ada0s1a on / (ufs, local, soft-updates)
+ foreach (@mount){
+ if ($bsd_type && $_ =~ /^$item\son.*\(([^,\s\)]+)[,\s]*.*\)/){
+ $fs = $1;
+ last;
+ }
+ elsif (!$bsd_type && $_ =~ /^$item\son.*\stype\s([\S]+)\s\([^\)]+\)/){
+ $fs = $1;
+ last;
+ }
+ }
+ eval $end if $b_log;
+ main::log_data('data',"fs: $fs") if $b_log;
+ return $fs;
+}
+# 1. Name: ada1p1
+# label: (null)
+# label: ssd-root
+# rawuuid: b710678b-f196-11e1-98fd-021fc614aca9
+sub get_bsd_label_uuid {
+ eval $start if $b_log;
+ my ($item) = @_;
+ my (@data,$b_found);
+ foreach (@gpart){
+ my @working = split /\s*:\s*/, $_;
+ if ($_ =~ /^[0-9]+\.\sName:/ && $working[1] eq $item){
+ $b_found = 1;
+ }
+ elsif ($_ =~ /^[0-9]+\.\sName:/ && $working[1] ne $item){
+ $b_found = 0;
+ }
+ if ($b_found){
+ if ($working[0] eq 'label'){
+ $data[0] = $working[1];
+ $data[0] =~ s/\(|\)//g; # eg: label:(null) - we want to show null
+ }
+ if ($working[0] eq 'rawuuid'){
+ $data[1] = $working[1];
+ $data[0] =~ s/\(|\)//g;
+ }
+ }
+ }
+ main::log_data('dump','@data',\@data) if $b_log;
+ eval $end if $b_log;
+ return @data;
+}
+sub set_label_uuid {
+ eval $start if $b_log;
+ $b_label_uuid = 1;
+ if ( $show{'unmounted'} || $show{'label'} || $show{'uuid'} ){
+ if (!$bsd_type){
+ if (-d '/dev/disk/by-label'){
+ @labels = main::globber('/dev/disk/by-label/*');
+ }
+ if (-d '/dev/disk/by-uuid'){
+ @uuids = main::globber('/dev/disk/by-uuid/*');
+ }
+ }
+ else {
+ if ( my $path = main::check_program('gpart')){
+ @gpart = main::grabber("$path list 2>/dev/null",'strip');
+ }
+ }
+ }
+ eval $end if $b_log;
+}
+sub set_lsblk {
+ eval $start if $b_log;
+ $b_lsblk = 1;
+ my (@temp,@working);
+ if (my $program = main::check_program('lsblk')){
+ @working = main::grabber("$program -bP --output NAME,TYPE,RM,FSTYPE,SIZE,LABEL,UUID,SERIAL,MOUNTPOINT 2>/dev/null");
+ foreach (@working){
+ if (/NAME="([^"]*)"\s+TYPE="([^"]*)"\s+RM="([^"]*)"\s+FSTYPE="([^"]*)"\s+SIZE="([^"]*)"\s+LABEL="([^"]*)"\s+UUID="([^"]*)"\s+SERIAL="([^"]*)"\s+MOUNTPOINT="([^"]*)"/){
+ my $size = ($5) ? $5/1024: 0;
+ # some versions of lsblk do not return serial, fs, uuid, or label
+ my @temp = ({
+ 'name' => $1,
+ 'type' => $2,
+ 'rm' => $3,
+ 'fs' => $4,
+ 'size' => $size,
+ 'label' => $6,
+ 'uuid' => $7,
+ 'serial' => $8,
+ 'mount' => $9,
+ });
+ @lsblk = (@lsblk,@temp);
+ }
+ }
+ }
+ # print Data::Dumper::Dumper \@lsblk;
+ main::log_data('dump','@lsblk',\@lsblk) if $b_log;
+ eval $end if $b_log;
+}
+sub check_lsblk {
+ eval $start if $b_log;
+ my ($name,$b_size) = @_;
+ my (%part,@row);
+ foreach my $ref (@lsblk){
+ my %row = %$ref;
+ next if ! $row{'name'};
+ if ($name eq $row{'name'}){
+ %part = %row;
+ last;
+ }
+ }
+ # print Data::Dumper::Dumper \%part;
+ main::log_data('dump','%part',\%part) if $b_log;
+ eval $end if $b_log;
+ return %part;
+}
+sub get_label {
+ eval $start if $b_log;
+ my ($item) = @_;
+ my $label = '';
+ foreach (@labels){
+ if ($item eq Cwd::abs_path($_)){
+ $label = $_;
+ $label =~ s/\/dev\/disk\/by-label\///;
+ $label =~ s/\\x20/ /g;
+ $label =~ s%\\x2f%/%g;
+ last;
+ }
+ }
+ $label ||= 'N/A';
+ eval $end if $b_log;
+ return $label;
+}
+# args: $1 - dev item $2 - @mapper
+# check for mapper, then get actual dev item if mapped
+# /dev/mapper/ will usually be a symbolic link to the real /dev id
+sub get_mapper {
+ eval $start if $b_log;
+ my ($item,@mapper) = @_;
+ my $mapped = '';
+ foreach (@mapper){
+ if ($item eq $_){
+ my $temp = Cwd::abs_path($_);
+ $mapped = $temp if $temp;
+ last;
+ }
+ }
+ $mapped ||= $item;
+ eval $end if $b_log;
+ return $mapped;
+}
+sub get_root {
+ eval $start if $b_log;
+ my ($path) = ('/dev/root');
+ # note: the path may be a symbolic link to by-label/by-uuid but not
+ # sure how far in abs_path resolves the path.
+ my $temp = Cwd::abs_path($path);
+ $path = $temp if $temp;
+ # note: it's a kernel config option to have /dev/root be a sym link
+ # or not, if it isn't, path will remain /dev/root, if so, then try mount
+ if ($path eq '/dev/root' && (my $program = main::check_program('mount'))){
+ my @data = main::grabber("$program 2>/dev/null");
+ # /dev/sda2 on / type ext4 (rw,noatime,data=ordered)
+ foreach (@data){
+ if (/^([\S]+)\son\s\/\s/){
+ $path = $1;
+ # note: we'll be handing off any uuid/label paths to the next
+ # check tools after get_root() above, so don't trim those.
+ $path =~ s/.*\/// if $path !~ /by-uuid|by-label/;
+ last;
+ }
+ }
+ }
+ eval $end if $b_log;
+ return $path;
+}
+
+sub get_uuid {
+ eval $start if $b_log;
+ my ($item) = @_;
+ my $uuid = '';
+ foreach (@uuids){
+ if ($item eq Cwd::abs_path($_)){
+ $uuid = $_;
+ $uuid =~ s/\/dev\/disk\/by-uuid\///;
+ last;
+ }
+ }
+ $uuid ||= 'N/A';
+ eval $end if $b_log;
+ return $uuid;
+}
+}
+
+## ProcessData
+{
+package ProcessData;
+
+sub get {
+ eval $start if $b_log;
+ my (@processes,@rows);
+ if ($show{'ps-cpu'}){
+ @rows = cpu_processes();
+ @processes = (@processes,@rows);
+ }
+ if ($show{'ps-mem'}){
+ @rows = mem_processes();
+ @processes = (@processes,@rows);
+ }
+ return @processes;
+ eval $end if $b_log;
+}
+sub cpu_processes {
+ eval $start if $b_log;
+ my ($j,$num,$cpu,$cpu_mem,$mem) = (0,0,'','','');
+ my (@processes);
+ my $count = ($b_irc)? 5: $ps_count;
+ my @rows = sort {
+ my @a = split(/\s+/,$a);
+ my @b = split(/\s+/,$b);
+ $b[2] <=> $a[2] } @ps_aux;
+ # if there's a count limit, for irc, etc, only use that much of the data
+ @rows = splice @rows,0,$count;
+
+ $j = scalar @rows;
+ # $cpu_mem = ' - Memory: MiB / % used' if $extra > 0;
+ my $throttled = throttled($ps_count,$count,$j);
+ #my $header = "CPU % used - Command - pid$cpu_mem - top";
+ #my $header = "Top $count by CPU";
+ my @data = ({
+ main::key($num++,'CPU top') => "$count$throttled",
+ },);
+ @processes = (@processes,@data);
+ my $i = 1;
+ foreach (@rows){
+ $num = 1;
+ $j = scalar @processes;
+ my @row = split /\s+/, $_;
+ my @command = process_starter(scalar @row, $row[10],$row[11]);
+ @data = ({
+ main::key($num++,$i++) => '',
+ main::key($num++,'cpu') => $row[2] . '%',
+ main::key($num++,'command') => $command[0],
+ },);
+ @processes = (@processes,@data);
+ if ($command[1]) {
+ $processes[$j]{main::key($num++,'started by')} = $command[1];
+ }
+ $processes[$j]{main::key($num++,'pid')} = $row[1];
+ if ($extra > 0){
+ my $decimals = ($row[5]/1024 > 10 ) ? 1 : 2;
+ $mem = (defined $row[5]) ? sprintf( "%.${decimals}f", $row[5]/1024 ) . ' MiB' : 'N/A';
+ $mem .= ' (' . $row[3] . '%)';
+ $processes[$j]{main::key($num++,'mem')} = $mem;
+ }
+ #print Data::Dumper::Dumper \@processes, "i: $i; j: $j ";
+ }
+ eval $end if $b_log;
+ return @processes;
+}
+sub mem_processes {
+ eval $start if $b_log;
+ my ($j,$num,$cpu,$cpu_mem,$mem) = (0,0,'','','');
+ my (@data,@processes,$memory);
+ my $count = ($b_irc)? 5: $ps_count;
+ my @rows = sort {
+ my @a = split(/\s+/,$a);
+ my @b = split(/\s+/,$b);
+ $b[5] <=> $a[5] } @ps_aux;
+ @rows = splice @rows,0,$count;
+ #print Data::Dumper::Dumper \@rows;
+ @processes = main::memory_data_full('process') if !$b_mem;
+ $j = scalar @rows;
+ my $throttled = throttled($ps_count,$count,$j);
+ #$cpu_mem = ' - CPU: % used' if $extra > 0;
+ #my $header = "Memory MiB/% used - Command - pid$cpu_mem - top";
+ #my $header = "Top $count by Memory";
+ @data = ({
+ main::key($num++,'Memory top') => "$count$throttled",
+ },);
+ @processes = (@processes,@data);
+ my $i = 1;
+ foreach (@rows){
+ $num = 1;
+ $j = scalar @processes;
+ my @row = split /\s+/, $_;
+ my $decimals = ($row[5]/1024 > 10 ) ? 1 : 2;
+ $mem = ($row[5]) ? sprintf( "%.${decimals}f", $row[5]/1024 ) . ' MiB' : 'N/A';
+ my @command = process_starter(scalar @row, $row[10],$row[11]);
+ $mem .= " (" . $row[3] . "%)";
+ @data = ({
+ main::key($num++,$i++) => '',
+ main::key($num++,'mem') => $mem,
+ main::key($num++,'command') => $command[0],
+ },);
+ @processes = (@processes,@data);
+ if ($command[1]) {
+ $processes[$j]{main::key($num++,'started by')} = $command[1];
+ }
+ $processes[$j]{main::key($num++,'pid')} = $row[1];
+ if ($extra > 0){
+ $cpu = $row[2] . '%';
+ $processes[$j]{main::key($num++,'cpu')} = $cpu;
+ }
+ #print Data::Dumper::Dumper \@processes, "i: $i; j: $j ";
+ }
+ eval $end if $b_log;
+ return @processes;
+}
+sub process_starter {
+ my ($count, $row10, $row11) = @_;
+ my (@return);
+ # note: [migration/0] would clear with a simple basename
+ if ($count > 11 && $row11 =~ /^\//){
+ $row11 =~ s/^\/.*\///;
+ $return[0] = $row11;
+ $row10 =~ s/^\/.*\///;
+ $return[1] = $row10;
+ }
+ else {
+ $row10 =~ s/^\/.*\///;
+ $return[0] = $row10;
+ $return[1] = '';
+ }
+ return @return;
+}
+sub throttled {
+ my ($ps_count,$count,$j) = @_;
+ my $throttled = '';
+ if ($count > $j){
+ $throttled = " ( $j processes)";
+ }
+ elsif ($count < $ps_count){
+ $throttled = " (throttled from $ps_count)";
+ }
+ return $throttled;
+}
+}
+
+## RaidData
+{
+package RaidData;
+# debugger switches
+my ($b_md,$b_zfs);
+
+sub get {
+ eval $start if $b_log;
+ my (@rows,$key1,$val1);
+ my $num = 0;
+ raid_data() if !$b_raid;
+ #print 'get: ', Data::Dumper::Dumper \@raid;
+ if (!@raid && !@hardware_raid){
+ if ($show{'raid-forced'}){
+ $key1 = 'Message';
+ $val1 = main::row_defaults('raid-data');
+ }
+ }
+ else {
+ @rows = create_output();
+ }
+ if (!@rows && $key1){
+ @rows = ({main::key($num++,$key1) => $val1,});
+ }
+ eval $end if $b_log;
+ ($b_md,$b_zfs,@hardware_raid) = undef;
+ return @rows;
+}
+sub create_output {
+ eval $start if $b_log;
+ my (@arrays,@arrays_holder,@components,@components_good,@data,@failed,@rows,
+ @sizes,@spare,@temp);
+ my ($allocated,$available,$blocks_avail,$chunk_raid,$component_string,$raid,
+ $ref2,$ref3,$report_size,$size,$status);
+ my ($b_row_1_sizes);
+ my ($i,$j,$num,$status_id) = (0,0,0,0);
+ #print Data::Dumper::Dumper \@raid;
+ if (@hardware_raid){
+ foreach my $ref (@hardware_raid){
+ my %row = %$ref;
+ $num = 1;
+ my $device = ($row{'device'}) ? $row{'device'}: 'N/A';
+ my $driver = ($row{'driver'}) ? $row{'driver'}: 'N/A';
+ @data = ({
+ main::key($num++,'Hardware') => $device,
+ });
+ @rows = (@rows,@data);
+ $j = scalar @rows - 1;
+ $rows[$j]{main::key($num++,'vendor')} = $row{'vendor'} if $row{'vendor'};
+ $rows[$j]{main::key($num++,'driver')} = $driver;
+ if ($extra > 0){
+ my $driver_version = ($row{'driver-version'}) ? $row{'driver-version'}: 'N/A' ;
+ $rows[$j]{main::key($num++,'v')} = $driver_version;
+ if ($extra > 2){
+ my $port= ($row{'port'}) ? $row{'port'}: 'N/A' ;
+ $rows[$j]{main::key($num++,'port')} = $port;
+ }
+ my $bus_id = (defined $row{'bus-id'} && defined $row{'sub-id'}) ? "$row{'bus-id'}.$row{'sub-id'}": 'N/A' ;
+ $rows[$j]{main::key($num++,'bus ID')} = $bus_id;
+ }
+ if ($extra > 1){
+ my $chip_id = (defined $row{'vendor-id'} && defined $row{'chip-id'}) ? "$row{'vendor-id'}.$row{'chip-id'}": 'N/A' ;
+ $rows[$j]{main::key($num++,'chip ID')} = $chip_id;
+ }
+ if ($extra > 2){
+ my $rev= (defined $row{'rev'} && $row{'rev'}) ? $row{'rev'}: 'N/A' ;
+ $rows[$j]{main::key($num++,'rev')} = $rev;
+ }
+ }
+ }
+ if ($extra > 2 && $raid[0]{'system-supported'}){
+ @data = ({
+ main::key($num++,'Supported md-raid types') => $raid[0]{'system-supported'},
+ });
+ @rows = (@rows,@data);
+ }
+ foreach my $ref (@raid){
+ $j = scalar @rows;
+ my %row = %$ref;
+ $b_row_1_sizes = 0;
+ next if !%row;
+ $num = 1;
+ @data = ({
+ main::key($num++,'Device') => $row{'id'},
+ main::key($num++,'type') => $row{'type'},
+ main::key($num++,'status') => $row{'status'},
+ });
+ @rows = (@rows,@data);
+ if ($row{'type'} eq 'mdraid'){
+ $blocks_avail = 'blocks';
+ $chunk_raid = 'chunk size';
+ $report_size = 'report';
+ if ($extra > 0){
+ $available = ($row{'blocks'}) ? $row{'blocks'} : 'N/A';
+ }
+ $size = ($row{'report'}) ? $row{'report'}: '';
+ $size .= " $row{'u-data'}" if $size;
+ $size ||= 'N/A';
+ $status_id = 2;
+ }
+ else {
+ $blocks_avail = 'free';
+ $chunk_raid = 'allocated';
+ $report_size = 'size';
+ @sizes = ($row{'size'}) ? main::get_size($row{'size'}) : ();
+ $size = (@sizes) ? "$sizes[0] $sizes[1]" : '';
+ @sizes = ($row{'free'}) ? main::get_size($row{'free'}) : ();
+ $available = (@sizes) ? "$sizes[0] $sizes[1]" : '';
+ if ($extra > 2){
+ @sizes = ($row{'allocated'}) ? main::get_size($row{'allocated'}) : ();
+ $allocated = (@sizes) ? "$sizes[0] $sizes[1]" : '';
+ }
+ $status_id = 1;
+ }
+ $ref2 = $row{'arrays'};
+ @arrays = @$ref2;
+ @arrays = grep {defined $_} @arrays;
+ @arrays_holder = @arrays;
+ if (($row{'type'} eq 'mdraid' && $extra == 0 ) || !defined $arrays[0]{'raid'} ){
+ $raid = (defined $arrays[0]{'raid'}) ? $arrays[0]{'raid'}: 'no-raid';
+ $rows[$j]{main::key($num++,'raid')} = $raid;
+ }
+ if ( ( $row{'type'} eq 'zfs' || ($row{'type'} eq 'mdraid' && $extra == 0 ) ) && $size){
+ #print "here 0\n";
+ $rows[$j]{main::key($num++,$report_size)} = $size;
+ $size = '';
+ $b_row_1_sizes = 1;
+ }
+ if ( $row{'type'} eq 'zfs' && $available){
+ $rows[$j]{main::key($num++,$blocks_avail)} = $available;
+ $available = '';
+ $b_row_1_sizes = 1;
+ }
+ if ( $row{'type'} eq 'zfs' && $allocated){
+ $rows[$j]{main::key($num++,$chunk_raid)} = $allocated;
+ $allocated = '';
+ }
+ $i = 0;
+ my $count = scalar @arrays;
+ foreach $ref3 (@arrays){
+ my %row2 = %$ref3;
+ if ($count > 1){
+ $j = scalar @rows;
+ $num = 1;
+ @sizes = ($row2{'size'}) ? main::get_size($row2{'size'}) : ();
+ $size = (@sizes) ? "$sizes[0] $sizes[1]" : 'N/A';
+ @sizes = ($row2{'free'}) ? main::get_size($row2{'free'}) : ();
+ $available = (@sizes) ? "$sizes[0] $sizes[1]" : '';
+ $raid = (defined $row2{'raid'}) ? $row2{'raid'}: 'no-raid';
+ $status = ($row2{'status'}) ? $row2{'status'}: 'N/A';
+ @data = ({
+ main::key($num++,'array') => $raid,
+ main::key($num++,'status') => $status,
+ main::key($num++,'size') => $size,
+ main::key($num++,'free') => $available,
+ });
+ @rows = (@rows,@data);
+ }
+ # items like cache may have one component, with a size on that component
+ elsif (!$b_row_1_sizes && $row{'type'} eq 'zfs'){
+ #print "here $count\n";
+ @sizes = ($row2{'size'}) ? main::get_size($row2{'size'}) : ();
+ $size = (@sizes) ? "$sizes[0] $sizes[1]" : '';
+ @sizes = ($row2{'free'}) ? main::get_size($row2{'free'}) : ();
+ $available = (@sizes) ? "$sizes[0] $sizes[1]" : '';
+ $rows[$j]{main::key($num++,'size')} = $size;
+ $rows[$j]{main::key($num++,'free')} = $available;
+ if ($extra > 2){
+ @sizes = ($row{'allocated'}) ? main::get_size($row2{'allocated'}) : ();
+ $allocated = (@sizes) ? "$sizes[0] $sizes[1]" : '';
+ if ($allocated){
+ $rows[$j]{main::key($num++,$chunk_raid)} = $allocated;
+ }
+ }
+ }
+ $ref3 = $row2{'components'};
+ @components = (ref $ref3 eq 'ARRAY') ? @$ref3 : ();
+ @failed = ();
+ @spare = ();
+ @components_good = ();
+ # @spare = split(/\s+/, $row{'unused'}) if $row{'unused'};
+ foreach my $item (@components){
+ @temp = split /~/, $item;
+ if (defined $temp[$status_id] && $temp[$status_id] =~ /^(F|DEGRADED|FAULTED|UNAVAIL)$/){
+ $temp[0] = "$temp[0]~$temp[1]" if $status_id == 2;
+ push @failed, $temp[0];
+ }
+ elsif (defined $temp[$status_id] && $temp[$status_id] =~ /(S|OFFLINE)$/){
+ $temp[0] = "$temp[0]~$temp[1]" if $status_id == 2;
+ push @spare, $temp[0];
+ }
+ else {
+ $temp[0] = ($status_id == 2) ? "$temp[0]~$temp[1]" : $temp[0];
+ push @components_good, $temp[0];
+ }
+ }
+ $component_string = (@components_good) ? join ' ', @components_good : 'N/A';
+ $rows[$j]{main::key($num++,'Components')} = '';
+ $rows[$j]{main::key($num++,'online')} = $component_string;
+ if (@failed){
+ $rows[$j]{main::key($num++,'FAILED')} = join ' ', @failed;
+ }
+ if (@spare){
+ $rows[$j]{main::key($num++,'spare')} = join ' ', @spare;
+ }
+ if ($row{'type'} eq 'mdraid' && $extra > 0 ){
+ $j = scalar @rows;
+ $num = 1;
+ #print Data::Dumper::Dumper \@arrays_holder;
+ $rows[$j]{main::key($num++,'Info')} = '';
+ $raid = (defined $arrays_holder[0]{'raid'}) ? $arrays_holder[0]{'raid'}: 'no-raid';
+ $rows[$j]{main::key($num++,'raid')} = $raid;
+ $rows[$j]{main::key($num++,$blocks_avail)} = $available;
+ if ($size){
+ $rows[$j]{main::key($num++,$report_size)} = $size;
+ }
+ my $chunk = ($row{'chunk-size'}) ? $row{'chunk-size'}: 'N/A';
+ $rows[$j]{main::key($num++,$chunk_raid)} = $chunk;
+ if ($extra > 1){
+ if ($row{'bitmap'}){
+ $rows[$j]{main::key($num++,'bitmap')} = $row{'bitmap'};
+ }
+ if ($row{'super-block'}){
+ $rows[$j]{main::key($num++,'super blocks')} = $row{'super-block'};
+ }
+ if ($row{'algorithm'}){
+ $rows[$j]{main::key($num++,'algorithm')} = $row{'algorithm'};
+ }
+ }
+ }
+ $i++;
+ }
+ if ($row{'recovery-percent'}){
+ $j = scalar @rows;
+ $num = 1;
+ my $percent = $row{'recovery-percent'};
+ if ($extra > 1 && $row{'progress-bar'}){
+ $percent .= " $row{'progress-bar'}"
+ }
+ $rows[$j]{main::key($num++,'Recovering')} = $percent;
+ my $finish = ($row{'recovery-finish'})?$row{'recovery-finish'} : 'N/A';
+ $rows[$j]{main::key($num++,'time remaining')} = $finish;
+ if ($extra > 0){
+ if ($row{'sectors-recovered'}){
+ $rows[$j]{main::key($num++,'sectors')} = $row{'sectors-recovered'};
+ }
+ }
+ if ($extra > 1 && $row{'recovery-speed'}){
+ $rows[$j]{main::key($num++,'speed')} = $row{'recovery-speed'};
+ }
+ }
+ }
+ eval $end if $b_log;
+ #print Data::Dumper::Dumper \@rows;
+ return @rows;
+}
+sub raid_data {
+ eval $start if $b_log;
+ my (@data);
+ $b_raid = 1;
+ if ($b_hardware_raid){
+ hardware_raid();
+ }
+ if ($b_md || (my $file = main::system_files('mdstat') )){
+ @data = mdraid_data($file);
+ @raid = (@raid,@data) if @data;
+ }
+ if ($b_zfs || (my $path = main::check_program('zpool') )){
+ @data = zfs_data($path);
+ @raid = (@raid,@data) if @data;
+ }
+ main::log_data('dump','@raid',\@raid) if $b_log;
+ #print Data::Dumper::Dumper \@raid;
+ eval $end if $b_log;
+}
+# 0 type
+# 1 type_id
+# 2 bus_id
+# 3 sub_id
+# 4 device
+# 5 vendor_id
+# 6 chip_id
+# 7 rev
+# 8 port
+# 9 driver
+# 10 modules
+sub hardware_raid {
+ eval $start if $b_log;
+ my ($driver,$vendor,@data,@working);
+ foreach my $ref (@pci){
+ @working = @$ref;
+ next if $working[1] ne '0104';
+ $driver = ($working[9]) ? lc($working[9]): '';
+ $driver =~ s/-/_/g if $driver;
+ my $driver_version = ($driver) ? main::get_module_version($driver): '';
+ if ($extra > 2 && $b_pci_tool && $working[11]){
+ $vendor = main::get_pci_vendor($working[4],$working[11]);
+ }
+ @data = ({
+ 'bus-id' => $working[2],
+ 'chip-id' => $working[6],
+ 'device' => $working[4],
+ 'driver' => $driver,
+ 'driver-version' => $driver_version,
+ 'port' => $working[8],
+ 'rev' => $working[7],
+ 'sub-id' => $working[3],
+ 'vendor-id' => $working[5],
+ 'vendor' => $vendor,
+ });
+ @hardware_raid = (@hardware_raid,@data);
+ }
+ # print Data::Dumper::Dumper \@hardware_raid;
+ main::log_data('dump','@hardware_raid',\@hardware_raid) if $b_log;
+ eval $end if $b_log;
+}
+sub mdraid_data {
+ eval $start if $b_log;
+ my ($mdstat) = @_;
+ my $j = 0;
+ #$mdstat = "$ENV{'HOME'}/bin/scripts/inxi/data/raid/md-4-device-1.txt";
+ #$mdstat = "$ENV{'HOME'}/bin/scripts/inxi/data/raid/md-rebuild-1.txt";
+ #$mdstat = "$ENV{'HOME'}/bin/scripts/inxi/data/raid/md-2-mirror-fserver2-1.txt";
+ #$mdstat = "$ENV{'HOME'}/bin/scripts/inxi/data/raid/md-2-raid10-abucodonosor.txt";
+ my @working = main::reader($mdstat,'strip');
+ #print Data::Dumper::Dumper \@working;
+ my (@data,@mdraid,@temp,$b_found,$system,$unused);
+ # NOTE: a system with empty mdstat will still show these values
+ if ($working[0] && $working[0] =~ /^Personalities/){
+ $system = ( split /:\s*/, $working[0])[1];
+ $system =~ s/\[|\]//g if $system;
+ shift @working;
+ }
+ if ($working[-1] && $working[-1] =~ /^used\sdevices/){
+ $unused = ( split /:\s*/, $working[0])[1];
+ $unused =~ s/<|>|none//g if $unused;
+ pop @working;
+ }
+ foreach (@working){
+ $_ =~ s/\s*:\s*/:/;
+ # print "$_\n";
+ #md126 : active (auto-read-only) raid1 sdq1[0]
+ if (/^(md[0-9]+)\s*:\s*([^\s]+)(\s\([^)]+\))?\s([^\s]+)\s(.*)/){
+ my $id = $1;
+ my $status = $2;
+ my $raid = $4;
+ my $component_string = $5;
+ @temp = ();
+ $raid =~ s/^raid1$/mirror/;
+ $raid =~ s/^raid/raid-/;
+ $raid = 'mirror' if $raid eq '1';
+ # remember, these include the [x] id, so remove that for disk/unmounted
+ my @components = split /\s+/, $component_string;
+ foreach my $component (@components){
+ $component =~ /([\S]+)\[([0-9]+)\]\(?([SF])?\)?/;
+ my $string = "$1~";
+ $string .= (defined $2) ? "c$2" : '';
+ $string .= (defined $3) ? "~$3" : '';
+ push @temp, $string;
+ }
+ @components = @temp;
+ #print "$component_string\n";
+ $j = scalar @mdraid;
+ @data = ({
+ 'id' => $id,
+ 'arrays' => ([],),
+ 'status' => $status,
+ 'type' => 'mdraid',
+ });
+ @mdraid = (@mdraid,@data);
+ $mdraid[$j]{'arrays'}[0]{'raid'} = $raid;
+ $mdraid[$j]{'arrays'}[0]{'components'} = \@components;
+ }
+ #print "$_\n";
+ if ($_ =~ /^([0-9]+)\sblocks/){
+ $mdraid[$j]{'blocks'} = $1;
+ }
+ if ($_ =~ /super\s([0-9\.]+)\s/){
+ $mdraid[$j]{'super-block'} = $1;
+ }
+ if ($_ =~ /algorithm\s([0-9\.]+)\s/){
+ $mdraid[$j]{'algorithm'} = $1;
+ }
+ if ($_ =~ /\[([0-9]+\/[0-9]+)\]\s\[([U_]+)\]/){
+ $mdraid[$j]{'report'} = $1;
+ $mdraid[$j]{'u-data'} = $2;
+ }
+ if ($_ =~ /resync=([\S]+)/){
+ $mdraid[$j]{'resync'} = $1;
+ }
+ if ($_ =~ /([0-9]+[km])\schunk/i){
+ $mdraid[$j]{'chunk-size'} = $1;
+ }
+ if ($_ =~ /(\[[=]*>[\.]*\]).*(resync|recovery)\s*=\s*([0-9\.]+%)?(\s\(([0-9\/]+)\))?/){
+ $mdraid[$j]{'progress-bar'} = $1;
+ $mdraid[$j]{'recovery-percent'} = $3 if $3;
+ $mdraid[$j]{'sectors-recovered'} = $5 if $5;
+ }
+ if ($_ =~ /finish\s*=\s*([\S]+)\s+speed\s*=\s*([\S]+)/){
+ $mdraid[$j]{'recovery-finish'} = $1;
+ $mdraid[$j]{'recovery-speed'} = $2;
+ }
+ #print 'mdraid loop: ', Data::Dumper::Dumper \@mdraid;
+ }
+ if (@mdraid){
+ $mdraid[0]{'system-supported'} = $system if $system;
+ $mdraid[0]{'unused'} = $unused if $unused;
+ }
+ #print Data::Dumper::Dumper \@mdraid;
+ eval $end if $b_log;
+ return @mdraid;
+}
+
+sub zfs_data {
+ eval $start if $b_log;
+ my ($zpool) = @_;
+ my (@components,@data,@zfs);
+ my ($allocated,$free,$ref,$size,$status);
+ my $b_v = 1;
+ my ($i,$j,$k) = (0,0,0);
+ #my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/raid/zpool-list-1-mirror-main-solestar.txt";
+ #my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/raid/zpool-list-2-mirror-main-solestar.txt";
+ #my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/raid/zpool-list-v-tank-1.txt";
+ #my @working = main::reader($file);$zpool = '';
+ my @working = main::grabber("$zpool list -v 2>/dev/null");
+ DiskData::set_glabel() if $bsd_type && !$b_glabel;
+ # bsd sed does not support inserting a true \n so use this trick
+ # some zfs does not have -v
+ if (!@working){
+ @working = main::grabber("$zpool list 2>/dev/null");
+ $b_v = 0;
+ }
+ #print Data::Dumper::Dumper \@working;
+ main::log_data('dump','@working',\@working) if $b_log;
+ if (!@working){
+ main::log_data('data','no zpool list data') if $b_log;
+ eval $end if $b_log;
+ return ();
+ }
+ my ($status_i) = (0);
+ # NAME SIZE ALLOC FREE EXPANDSZ FRAG CAP DEDUP HEALTH ALTROOT
+ my $test = shift @working; # get rid of first header line
+ if ($test){
+ foreach (split /\s+/, $test){
+ last if $_ eq 'HEALTH';
+ $status_i++;
+ }
+ }
+ foreach (@working){
+ my @row = split /\s+/, $_;
+ if (/^[\S]+/){
+ @components = ();
+ $i = 0;
+ $size = ($row[1] && $row[1] ne '-')? main::translate_size($row[1]): '';
+ $allocated = ($row[2] && $row[2] ne '-')? main::translate_size($row[2]): '';
+ $free = ($row[3] && $row[3] ne '-')? main::translate_size($row[3]): '';
+ $status = (defined $row[$status_i] && $row[$status_i] ne '') ? $row[$status_i]: 'no-status';
+ $j = scalar @zfs;
+ @data = ({
+ 'id' => $row[0],
+ 'allocated' => $allocated,
+ 'arrays' => ([],),
+ 'free' => $free,
+ 'size' => $size,
+ 'status' => $status,
+ 'type' => 'zfs',
+ });
+ @zfs = (@zfs,@data);
+ }
+ #print Data::Dumper::Dumper \@zfs;
+ # raid level is the second item in the output, unless it is not, sometimes it is absent
+ if ($row[1] =~ /raid|mirror/){
+ $row[1] =~ s/^raid1/mirror/;
+ #$row[1] =~ s/^raid/raid-/; # need to match in zpool status <device>
+ $ref = $zfs[$j]{'arrays'};
+ $k = scalar @$ref;
+ $zfs[$j]{'arrays'}[$k]{'raid'} = $row[1];
+ $i = 0;
+ $zfs[$j]{'arrays'}[$k]{'size'} = ($row[2] && $row[2] ne '-') ? main::translate_size($row[2]) : '';
+ $zfs[$j]{'arrays'}[$k]{'allocated'} = ($row[3] && $row[3] ne '-') ? main::translate_size($row[3]) : '';
+ $zfs[$j]{'arrays'}[$k]{'free'} = ($row[4] && $row[4] ne '-') ? main::translate_size($row[4]) : '';
+ }
+ # https://blogs.oracle.com/eschrock/entry/zfs_hot_spares
+ elsif ($row[1] =~ /spares/){
+ next;
+ }
+ # the first is a member of a raid array
+ # ada2 - - - - - -
+ # this second is a single device not in an array
+ # ada0s2 25.9G 14.6G 11.3G - 0% 56%
+ # gptid/3838f796-5c46-11e6-a931-d05099ac4dc2 - - - - - -
+ elsif ($row[1] =~ /^([a-z0-9]+[0-9]+|([\S]+)\/.*)$/ &&
+ ($row[2] eq '-' || $row[2] =~ /^[0-9\.]+[MGTP]$/ )){
+ $row[1] =~ /^([a-z0-9]+[0-9]+|([\S]+)\/.*)\s*(DEGRADED|FAULTED|OFFLINE)?$/;
+ my $working = $1;
+ my $state = ($3) ? $3 : '';
+ if ($working =~ /[\S]+\// && @glabel){
+ $working = DiskData::match_glabel($working);
+ }
+ # kind of a hack, things like cache may not show size/free
+ # data since they have no array row, but they might show it in
+ # component row:
+ # ada0s2 25.9G 19.6G 6.25G - 0% 75%
+ if (!$zfs[$j]{'size'} && $row[2] && $row[2] ne '-') {
+ $size = ($row[2])? main::translate_size($row[2]): '';
+ $zfs[$j]{'arrays'}[$k]{'size'} = $size;
+ }
+ if (!$zfs[$j]{'allocated'} && $row[3] && $row[3] ne '-') {
+ $allocated = ($row[3])? main::translate_size($row[3]): '';
+ $zfs[$j]{'arrays'}[$k]{'allocated'} = $allocated;
+ }
+ if (!$zfs[$j]{'free'} && $row[4] && $row[4] ne '-') {
+ $free = ($row[4])? main::translate_size($row[4]): '';
+ $zfs[$j]{'arrays'}[$k]{'free'} = $free;
+ }
+ $zfs[$j]{'arrays'}[$k]{'components'}[$i] = $working . '~' . $state;
+ $i++;
+ }
+ }
+ # print Data::Dumper::Dumper \@zfs;
+ # clear out undefined arrrays values
+ $j = 0;
+ foreach $ref (@zfs){
+ my %row = %$ref;
+ my $ref2 = $row{'arrays'};
+ my @arrays = (ref $ref2 eq 'ARRAY' ) ? @$ref2 : ();
+ @arrays = grep {defined $_} @arrays;
+ $zfs[$j]{'arrays'} = \@arrays;
+ $j++;
+ }
+ @zfs = zfs_status($zpool,@zfs);
+ # print Data::Dumper::Dumper \@zfs;
+ eval $end if $b_log;
+ return @zfs;
+}
+sub zfs_status {
+ eval $start if $b_log;
+ my ($zpool,@zfs) = @_;
+ my ($cmd,$status,$file,$raid,@arrays,@pool_status,@temp);
+ my ($i,$j,$k,$l) = (0,0,0,0);
+ foreach my $ref (@zfs){
+ my %row = %$ref;
+ $i = 0;
+ $k = 0;
+ #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/raid/zpool-status-1-mirror-main-solestar.txt";
+ #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/raid/zpool-status-2-mirror-main-solestar.txt";
+ #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/raid/zpool-status-tank-1.txt";
+ #@pool_status = main::reader($file,'strip');
+ $cmd = "$zpool status $row{'id'} 2>/dev/null";
+ @pool_status = main::grabber($cmd,"\n",'strip');
+ main::log_data('cmd',$cmd) if $b_log;
+ my $ref2 = $row{'arrays'};
+ @arrays = (ref $ref2 eq 'ARRAY' ) ? @$ref2 : ();
+ #print "$row{'id'} rs:$row{'status'}\n";
+ $status = ($row{'status'} && $row{'status'} eq 'no-status') ? check_status($row{'id'},@pool_status): $row{'status'};
+ $zfs[$j]{'status'} = $status if $status;
+ #@arrays = grep {defined $_} @arrays;
+ #print "$row{id} $#arrays\n";
+ #print Data::Dumper::Dumper \@arrays;
+ foreach my $array (@arrays){
+ #print 'ref: ', ref $array, "\n";
+ #next if ref $array ne 'HASH';
+ my %row2 = %$array;
+ my $ref3 = $row2{'components'};
+ my @components = (ref $ref3 eq 'ARRAY') ? @$ref3 : ();
+ $l = 0;
+ # zpool status: mirror-0 ONLINE 2 0 0
+ $raid = ($row2{'raid'}) ? "$row2{'raid'}-$i": $row2{'raid'};
+ $status = ($raid) ? check_status($raid,@pool_status): '';
+ $zfs[$j]{'arrays'}[$k]{'status'} = $status;
+ #print "$raid i:$i j:$j k:$k $status\n";
+ foreach my $component (@components){
+ my @temp = split /~/, $component;
+ $status = ($temp[0]) ? check_status($temp[0],@pool_status): '';
+ $zfs[$j]{'arrays'}[$k]{'components'}[$l] .= $status if $status;
+ $l++;
+ }
+ $k++;
+ # haven't seen a raid5/6 type array yet
+ $i++ if $row2{'raid'}; # && $row2{'raid'} eq 'mirror';
+ }
+ $j++;
+ }
+ eval $end if $b_log;
+ return @zfs;
+}
+sub check_status {
+ eval $start if $b_log;
+ my ($item,@pool_status) = @_;
+ my ($status) = ('');
+ foreach (@pool_status){
+ my @temp = split /\s+/, $_;
+ if ($temp[0] eq $item){
+ last if !$temp[1];
+ $status = $temp[1];
+ last;
+ }
+ }
+ eval $end if $b_log;
+ return $status;
+}
+}
+
+## RamData
+{
+package RamData;
+
+sub get {
+ my (@data,@rows,$key1,@ram,$val1);
+ my $num = 0;
+ my $ref = $alerts{'dmidecode'};
+ @rows = main::memory_data_full('ram') if !$b_mem;
+ if ( $$ref{'action'} ne 'use'){
+ $key1 = $$ref{'action'};
+ $val1 = $$ref{$key1};
+ @data = ({
+ main::key($num++,'RAM Report') => '',
+ main::key($num++,$key1) => $val1,
+ });
+ @rows = (@rows,@data);
+ }
+ else {
+ @ram = dmidecode_data();
+ if (@ram){
+ @data = create_output(@ram);
+ }
+ else {
+ $key1 = 'message';
+ $val1 = main::row_defaults('ram-data');
+ @data = ({
+ main::key($num++,'RAM Report') => '',
+ main::key($num++,$key1) => $val1,
+ });
+ }
+ @rows = (@rows,@data);
+ }
+ eval $end if $b_log;
+ return @rows;
+}
+
+sub create_output {
+ eval $start if $b_log;
+ my (@ram) = @_;
+ return if !@ram;
+ my $num = 0;
+ my $j = 0;
+ my (@data,@rows);
+ foreach (@ram){
+ $j = scalar @rows;
+ my %ref = %$_;
+ $num = 1;
+ @data = ({
+ main::key($num++,'Array') => '',
+ main::key($num++,'capacity') => process_size($ref{'capacity'}),
+ });
+ @rows = (@rows,@data);
+ if ($ref{'cap-qualifier'}){
+ $rows[$j]{main::key($num++,'note')} = $ref{'cap-qualifier'};
+ }
+ $rows[$j]{main::key($num++,'slots')} = $ref{'slots'};
+ $rows[$j]{main::key($num++,'EC')} = $ref{'eec'};
+ if ($extra > 0 ){
+ $rows[$j]{main::key($num++,'max module size')} = process_size($ref{'max-module-size'});
+ if ($ref{'mod-qualifier'}){
+ $rows[$j]{main::key($num++,'note')} = $ref{'mod-qualifier'};
+ }
+ }
+ foreach my $ref2 ($ref{'modules'}){
+ my @modules = @$ref2;
+ # print Data::Dumper::Dumper \@modules;
+ foreach my $ref3 ( @modules){
+ $num = 1;
+ $j = scalar @rows;
+ # multi array setups will start index at next from previous array
+ next if ref $ref3 ne 'HASH';
+ my %mod = %$ref3;
+ $mod{'locator'} ||= 'N/A';
+ @data = ({
+ main::key($num++,'Device') => $mod{'locator'},
+ main::key($num++,'size') => process_size($mod{'size'}),
+ });
+ @rows = (@rows,@data);
+ next if ($mod{'size'} =~ /\D/);
+ if ($extra > 1 && $mod{'type'} ){
+ $rows[$j]{main::key($num++,'info')} = $mod{'type'};
+ }
+ $rows[$j]{main::key($num++,'speed')} = $mod{'speed'};
+ if ($extra > 0 ){
+ $mod{'device-type'} ||= 'N/A';
+ $rows[$j]{main::key($num++,'type')} = $mod{'device-type'};
+ if ($extra > 2 && $mod{'device-type'} ne 'N/A'){
+ $mod{'device-type-detail'} ||= 'N/A';
+ $rows[$j]{main::key($num++,'detail')} = $mod{'device-type-detail'};
+ }
+ }
+ if ($extra > 2 ){
+ $mod{'data-width'} ||= 'N/A';
+ $rows[$j]{main::key($num++,'bus width')} = $mod{'data-width'};
+ $mod{'total-width'} ||= 'N/A';
+ $rows[$j]{main::key($num++,'total')} = $mod{'total-width'};
+ }
+ if ($extra > 1 ){
+ $mod{'manufacturer'} ||= 'N/A';
+ $rows[$j]{main::key($num++,'manufacturer')} = $mod{'manufacturer'};
+ $mod{'part-number'} ||= 'N/A';
+ $rows[$j]{main::key($num++,'part-no')} = $mod{'part-number'};
+ }
+ if ($extra > 2 ){
+ $mod{'serial'} = main::apply_filter($mod{'serial'});
+ $rows[$j]{main::key($num++,'serial')} = $mod{'serial'};
+ }
+ }
+ }
+ }
+ eval $end if $b_log;
+ return @rows;
+}
+
+sub dmidecode_data {
+ eval $start if $b_log;
+ my ($b_5,$handle,@ram,@temp);
+ my ($derived_module_size,$max_cap_5,$max_cap_16,$max_module_size) = (0,0,0,0);
+ my ($i,$j,$k) = (0,0,0);
+ foreach (@dmi){
+ my @ref = @$_;
+ # Portable Battery
+ if ($ref[0] == 5){
+ $ram[$k] = ({}) if !$ram[$k];
+ foreach my $item (@ref){
+ @temp = split /:\s*/, $item;
+ next if ! $temp[1];
+ if ($temp[0] eq 'Maximum Memory Module Size'){
+ $max_module_size = calculate_size($temp[1],$max_module_size);
+ $ram[$k]{'max-module-size'} = $max_module_size;
+ }
+ elsif ($temp[0] eq 'Maximum Total Memory Size'){
+ $max_cap_5 = calculate_size($temp[1],$max_cap_5);
+ $ram[$k]{'max-capacity-5'} = $max_cap_5;
+ }
+ elsif ($temp[0] eq 'Memory Module Voltage'){
+ $temp[1] =~ s/\s*V.*$//;
+ $ram[$k]{'voltage'} = $temp[1];
+ }
+ elsif ($temp[0] eq 'Associated Memory Slots'){
+ $ram[$k]{'slots-5'} = $temp[1];
+ }
+ }
+ $ram[$k]{'modules'} = ([],);
+ #print Data::Dumper::Dumper \@ram;
+ $b_5 = 1;
+ }
+ elsif ($ref[0] == 6){
+ my ($size,$speed,$type) = (0,0,0);
+ foreach my $item (@ref){
+ @temp = split /:\s*/, $item;
+ next if ! $temp[1];
+ if ($temp[0] eq 'Installed Size'){
+ # get module size
+
+ $size = calculate_size($temp[1],0);
+ # get data after module size
+ $temp[1] =~ s/ Connection\)?//;
+ $temp[1] =~ s/^[0-9]+\s*[MGTP]B\s*\(?//;
+ $type = lc($temp[1]);
+ }
+ elsif ($temp[0] eq 'Current Speed'){
+ $speed = $temp[1];
+ }
+ }
+ $ram[$k]{'modules'}[$j] = ({
+ 'size' => $size,
+ 'speed-ns' => $speed,
+ 'type' => $type,
+ });
+ #print Data::Dumper::Dumper \@ram;
+ $j++;
+ }
+ elsif ($ref[0] == 16){
+ $handle = $ref[1];
+ $ram[$handle] = $ram[$k] if $ram[$k];
+ $ram[$k] = undef;
+ $ram[$handle] = ({}) if !$ram[$handle];
+ foreach my $item (@ref){
+ @temp = split /:\s*/, $item;
+ next if ! $temp[1];
+ if ($temp[0] eq 'Maximum Capacity'){
+ $max_cap_16 = calculate_size($temp[1],$max_cap_16);
+ $ram[$handle]{'max-capacity-16'} = $max_cap_16;
+ }
+ # note: these 3 have cleaned data in set_dmidecode_data, so replace stuff manually
+ elsif ($temp[0] eq 'Location'){
+ $temp[1] =~ s/\sOr\sMotherboard//;
+ $temp[1] ||= 'System Board';
+ $ram[$handle]{'location'} = $temp[1];
+ }
+ elsif ($temp[0] eq 'Use'){
+ $temp[1] ||= 'System Memory';
+ $ram[$handle]{'use'} = $temp[1];
+ }
+ elsif ($temp[0] eq 'Error Correction Type'){
+ $temp[1] ||= 'None';
+ $ram[$handle]{'eec'} = $temp[1];
+ }
+ elsif ($temp[0] eq 'Number Of Devices'){
+ $ram[$handle]{'slots-16'} = $temp[1];
+ }
+ #print "0: $temp[0]\n";
+ }
+ $ram[$handle]{'derived-module-size'} = 0;
+ $ram[$handle]{'device-count-found'} = 0;
+ $ram[$handle]{'used-capacity'} = 0;
+ #print "s16: $ram[$handle]{'slots-16'}\n";
+ }
+ elsif ($ref[0] == 17){
+ my ($bank_locator,$configured_clock_speed,$data_width) = ('','','');
+ my ($device_type,$device_type_detail,$form_factor,$locator,$main_locator) = ('','','','','');
+ my ($manufacturer,$part_number,$serial,$speed,$total_width) = ('','','','','');
+ my ($device_size,$i_data,$i_total,$working_size) = (0,0,0,0);
+ foreach my $item (@ref){
+ @temp = split /:\s*/, $item;
+ next if ! $temp[1];
+ if ($temp[0] eq 'Array Handle'){
+ $handle = hex($temp[1]);
+ }
+ elsif ($temp[0] eq 'Data Width'){
+ $data_width = $temp[1];
+ }
+ elsif ($temp[0] eq 'Total Width'){
+ $total_width = $temp[1];
+ }
+ # do not try to guess from installed modules, only use this to correct type 5 data
+ elsif ($temp[0] eq 'Size'){
+ # we want any non real size data to be preserved
+ if ( $temp[1] =~ /^[0-9]+\s*[MTPG]B/ ) {
+ $derived_module_size = calculate_size($temp[1],$derived_module_size);
+ $working_size = calculate_size($temp[1],0);
+ $device_size = $working_size;
+ }
+ else {
+ $device_size = $temp[1];
+ }
+ }
+ elsif ($temp[0] eq 'Locator'){
+ $temp[1] =~ s/RAM slot #/Slot/;
+ $locator = $temp[1];
+ }
+ elsif ($temp[0] eq 'Bank Locator'){
+ $bank_locator = $temp[1];
+ }
+ elsif ($temp[0] eq 'Form Factor'){
+ $form_factor = $temp[1];
+ }
+ elsif ($temp[0] eq 'Type'){
+ $device_type = $temp[1];
+ }
+ elsif ($temp[0] eq 'Type Detail'){
+ $device_type_detail = $temp[1];
+ }
+ elsif ($temp[0] eq 'Speed'){
+ $speed = $temp[1];
+ }
+ elsif ($temp[0] eq 'Configured Clock Speed'){
+ $configured_clock_speed = $temp[1];
+ }
+ elsif ($temp[0] eq 'Manufacturer'){
+ $temp[1] = main::dmi_cleaner($temp[1]);
+ $manufacturer = $temp[1];
+ }
+ elsif ($temp[0] eq 'Part Number'){
+ $temp[1] =~ s/(^[0]+$||.*Module.*|Undefined.*|PartNum.*|\[Empty\]|^To be filled.*)//g;
+ $part_number = $temp[1];
+ }
+ elsif ($temp[0] eq 'Serial Number'){
+ $temp[1] =~ s/(^[0]+$|Undefined.*|SerNum.*|\[Empty\]|^To be filled.*)//g;
+ $serial = $temp[1];
+ }
+ }
+ # because of the wide range of bank/slot type data, we will just use
+ # the one that seems most likely to be right. Some have: Bank: SO DIMM 0 slot: J6A
+ # so we dump the useless data and use the one most likely to be visibly correct
+ if ( $bank_locator =~ /DIMM/ ) {
+ $main_locator = $bank_locator;
+ }
+ else {
+ $main_locator = $locator;
+ }
+ if ($working_size =~ /^[0-9][0-9]+$/) {
+ $ram[$handle]{'device-count-found'}++;
+ # build up actual capacity found for override tests
+ $ram[$handle]{'used-capacity'} += $working_size;
+ }
+ # sometimes the data is just wrong, they reverse total/data. data I believe is
+ # used for the actual memory bus width, total is some synthetic thing, sometimes missing.
+ # note that we do not want a regular string comparison, because 128 bit memory buses are
+ # in our future, and 128 bits < 64 bits with string compare
+ $data_width =~ /(^[0-9]+).*/;
+ $i_data = $1;
+ $total_width =~ /(^[0-9]+).*/;
+ $i_total = $1;
+ if ($i_data && $i_total && $i_data > $i_total){
+ my $temp_width = $data_width;
+ $data_width = $total_width;
+ $total_width = $temp_width;
+ }
+ $ram[$handle]{'derived-module-size'} = $derived_module_size;
+ $ram[$handle]{'modules'}[$i]{'configured-clock-speed'} = $configured_clock_speed;
+ $ram[$handle]{'modules'}[$i]{'data-width'} = $data_width;
+ $ram[$handle]{'modules'}[$i]{'size'} = $device_size;
+ $ram[$handle]{'modules'}[$i]{'device-type'} = $device_type;
+ $ram[$handle]{'modules'}[$i]{'device-type-detail'} = lc($device_type_detail);
+ $ram[$handle]{'modules'}[$i]{'form-factor'} = $form_factor;
+ $ram[$handle]{'modules'}[$i]{'locator'} = $main_locator;
+ $ram[$handle]{'modules'}[$i]{'manufacturer'} = $manufacturer;
+ $ram[$handle]{'modules'}[$i]{'part-number'} = $part_number;
+ $ram[$handle]{'modules'}[$i]{'serial'} = $serial;
+ $ram[$handle]{'modules'}[$i]{'speed'} = $speed;
+ $ram[$handle]{'modules'}[$i]{'total-width'} = $total_width;
+ $i++
+ }
+ elsif ($ref[0] < 17 ){
+ next;
+ }
+ elsif ($ref[0] > 17 ){
+ last;
+ }
+ }
+ @ram = data_processor(@ram) if @ram;
+ main::log_data('dump','@ram',\@ram) if $b_log;
+ # print Data::Dumper::Dumper \@ram;
+ eval $end if $b_log;
+ return @ram;
+}
+sub data_processor {
+ eval $start if $b_log;
+ my (@ram) = @_;
+ my $b_debug = 0;
+ my (@return,@temp);
+ my $est = 'est.';
+
+ foreach (@ram){
+ # because we use the actual array handle as the index,
+ # there will be many undefined keys
+ next if ! defined $_;
+ my %ref = %$_;
+ my ($max_cap,$max_mod_size) = (0,0);
+ my ($alt_cap,$est_cap,$est_mod,$unit) = (0,'','','');
+ $max_cap = $ref{'max-capacity-16'};
+ # make sure they are integers not string if empty
+ $ref{'slots-5'} ||= 0;
+ $ref{'slots-16'} ||= 0;
+ $ref{'max-capacity-5'} ||= 0;
+ $ref{'max-module-size'} ||= 0;
+ #$ref{'max-module-size'} = 0;# debugger
+ # 1: if max cap 1 is null, and max cap 2 not null, use 2
+ if ($b_debug){
+ print "1: mms: $ref{'max-module-size'} :dms: $ref{'derived-module-size'} :mc: $max_cap :uc: $ref{'used-capacity'}\n";
+ print "1a: s5: $ref{'slots-5'} s16: $ref{'slots-16'}\n";
+ }
+ if (!$max_cap && $ref{'max-capacity-5'}) {
+ $max_cap = $ref{'max-capacity-5'};
+ }
+ if ($b_debug){
+ print "2: mms: $ref{'max-module-size'} :dms: $ref{'derived-module-size'} :mc: $max_cap :uc: $ref{'used-capacity'}\n";
+ }
+ # 2: now check to see if actually found module sizes are > than listed max module, replace if >
+ if ( $ref{'max-module-size'} && $ref{'derived-module-size'} &&
+ $ref{'derived-module-size'} > $ref{'max-module-size'} ){
+ $ref{'max-module-size'} = $ref{'derived-module-size'};
+ $est_mod = $est;
+ }
+ if ($b_debug){
+ print "3: dcf: $ref{'device-count-found'} :dms: $ref{'derived-module-size'} :mc: $max_cap :uc: $ref{'used-capacity'}\n";
+ }
+ # note: some cases memory capacity == max module size, so one stick will fill it
+ # but I think only with cases of 2 slots does this happen, so if > 2, use the count of slots.
+ if ($max_cap && ($ref{'device-count-found'} || $ref{'slots-16'}) ){
+ # first check that actual memory found is not greater than listed max cap, or
+ # checking to see module count * max mod size is not > used capacity
+ if ($ref{'used-capacity'} && $ref{'max-capacity-16'}){
+ if ($ref{'used-capacity'} > $max_cap){
+ if ($ref{'max-module-size'} &&
+ $ref{'used-capacity'} < ($ref{'slots-16'} * $ref{'max-module-size'} )){
+ $max_cap = $ref{'slots-16'} * $ref{'max-module-size'};
+ $est_cap = $est;
+ print "A\n" if $b_debug;
+ }
+ elsif ($ref{'derived-module-size'} &&
+ $ref{'used-capacity'} < ($ref{'slots-16'} * $ref{'derived-module-size'}) ){
+ $max_cap = $ref{'slots-16'} * $ref{'derived-module-size'};
+ $est_cap = $est;
+ print "B\n" if $b_debug;
+ }
+ else {
+ $max_cap = $ref{'used-capacity'};
+ $est_cap = $est;
+ print "C\n" if $b_debug;
+ }
+ }
+ }
+ # note that second case will never really activate except on virtual machines and maybe
+ # mobile devices
+ if (!$est_cap){
+ # do not do this for only single modules found, max mod size can be equal to the array size
+ if ($ref{'slots-16'} > 1 && $ref{'device-count-found'} > 1 &&
+ $max_cap < ($ref{'derived-module-size'} * $ref{'slots-16'} ) ){
+ $max_cap = $ref{'derived-module-size'} * $ref{'slots-16'};
+ $est_cap = $est;
+ print "D\n" if $b_debug;
+ }
+ elsif ($ref{'device-count-found'} > 0 && $max_cap < ( $ref{'derived-module-size'} * $ref{'device-count-found'} )){
+ $max_cap = $ref{'derived-module-size'} * $ref{'device-count-found'};
+ $est_cap = $est;
+ print "E\n" if $b_debug;
+ }
+ ## handle cases where we have type 5 data: mms x device count equals type 5 max cap
+ # however do not use it if cap / devices equals the derived module size
+ elsif ($ref{'max-module-size'} > 0 &&
+ ($ref{'max-module-size'} * $ref{'slots-16'}) == $ref{'max-capacity-5'} &&
+ $ref{'max-capacity-5'} != $ref{'max-capacity-16'} &&
+ $ref{'derived-module-size'} != ($ref{'max-capacity-16'}/$ref{'slots-16'}) ){
+ $max_cap = $ref{'max-capacity-5'};
+ $est_cap = $est;
+ print "F\n" if $b_debug;
+ }
+
+ }
+ if ($b_debug){
+ print "4: mms: $ref{'max-module-size'} :dms: $ref{'derived-module-size'} :mc: $max_cap :uc: $ref{'used-capacity'}\n";
+ }
+ # some cases of type 5 have too big module max size, just dump the data then since
+ # we cannot know if it is valid or not, and a guess can be wrong easily
+ if ($ref{'max-module-size'} && $max_cap && $ref{'max-module-size'} > $max_cap){
+ $ref{'max-module-size'} = 0;
+ }
+ if ($b_debug){
+ print "5: dms: $ref{'derived-module-size'} :s16: $ref{'slots-16'} :mc: $max_cap\n";
+ }
+
+ # now prep for rebuilding the ram array data
+ if (!$ref{'max-module-size'}){
+ # ie: 2x4gB
+ if (!$est_cap && $ref{'derived-module-size'} > 0 && $max_cap > ($ref{'derived-module-size'} * $ref{'slots-16'} * 4) ){
+ $est_cap = 'check';
+ print "G\n" if $b_debug;
+ }
+ if ($max_cap && ($ref{'slots-16'} || $ref{'slots-5'})){
+ my $slots = 0;
+ if ($ref{'slots-16'} && $ref{'slots-16'} >= $ref{'slots-5'}){
+ $slots = $ref{'slots-16'};
+ }
+ elsif ($ref{'slots-5'} && $ref{'slots-5'} > $ref{'slots-16'}){
+ $slots = $ref{'slots-5'};
+ }
+ if ($ref{'derived-module-size'} * $slots > $max_cap){
+ $ref{'max-module-size'} = $ref{'derived-module-size'};
+ }
+ else {
+ $ref{'max-module-size'} = sprintf("%.f",$max_cap/$slots);
+ }
+ $est_mod = $est;
+ }
+ }
+ # case where listed max cap is too big for actual slots x max cap, eg:
+ # listed max cap, 8gb, max mod 2gb, slots 2
+ else {
+ if (!$est_cap && $ref{'max-module-size'} > 0){
+ if ($max_cap > ( $ref{'max-module-size'} * $ref{'slots-16'})){
+ $est_cap = 'check';
+ print "H\n" if $b_debug;
+ }
+ }
+ }
+ }
+ @temp = ({
+ 'capacity' => $max_cap,
+ 'cap-qualifier' => $est_cap,
+ 'eec' => $ref{'eec'},
+ 'location' => $ref{'location'},
+ 'max-module-size' => $ref{'max-module-size'},
+ 'mod-qualifier' => $est_mod,
+ 'modules' => $ref{'modules'},
+ 'slots' => $ref{'slots-16'},
+ 'use' => $ref{'use'},
+ 'voltage' => $ref{'voltage'},
+ });
+ @return = (@return,@temp);
+ }
+ eval $end if $b_log;
+ return @return;
+}
+sub process_size {
+ my ($size) = @_;
+ my ($b_trim,$unit) = (0,'');
+ return 'N/A' if ( ! $size );
+ return $size if $size =~ /\D/;
+ if ( $size < 1024 ){
+ $unit='MiB';
+ }
+ elsif ( $size < 1024000 ){
+ $size = $size / 1024;
+ $unit='GiB';
+ $b_trim = 1;
+ }
+ elsif ( $size < 1024000000 ){
+ $size = $size / 1024000;
+ $unit='TiB';
+ $b_trim = 1;
+ }
+ # we only want a max 2 decimal places, and only when it's
+ # a unit > MB
+ $size = sprintf("%.2f",$size) if $b_trim;
+ $size =~ s/\.[0]+$//;
+ $size = "$size $unit";
+ return $size;
+}
+sub calculate_size {
+ my ($data, $size) = @_;
+ if ( $data =~ /^[0-9]+\s*[GMTP]B/) {
+ if ( $data =~ /([0-9]+)\s*GB/ ) {
+ $data = $1 * 1024;
+ }
+ elsif ( $data =~ /([0-9]+)\s*MB/ ) {
+ $data = $1;
+ }
+ elsif ( $data =~ /([0-9]+)\s*TB/ ) {
+ $data = $1 * 1024 * 1000;
+ }
+ elsif ( $data =~ /([0-9]+)\s*PB/ ) {
+ $data = $1 * 1024 * 1000 * 1000;
+ }
+ if ($data =~ /^[0-9][0-9]+$/ && $data > $size ) {
+ $size=$data;
+ }
+ }
+ else {
+ $size = 0;
+ }
+ return $size;
+}
+}
+
+## RepoData
+{
+package RepoData;
+
+# easier to keep these package global, but undef after done
+my (@dbg_files,$debugger_dir);
+my $num = 0;
+sub get {
+ eval $start if $b_log;
+ ($debugger_dir) = @_;
+ my (@data,@rows);
+ if ($bsd_type){
+ @rows = get_repos_bsd();
+ }
+ else {
+ @rows = get_repos_linux();
+ }
+ if ($debugger_dir){
+ @rows = @dbg_files;
+ undef @dbg_files;
+ undef $debugger_dir;
+ }
+ else {
+ if (!@rows){
+ my $pm = (!$bsd_type) ? 'package manager': 'OS type';
+ @data = (
+ {main::key($num++,'Alert') => "No repo data detected. Does $self_name support your $pm?"},
+ );
+ @rows = (@data);
+ }
+ }
+ eval $end if $b_log;
+ return @rows;
+}
+sub get_repos_linux {
+ eval $start if $b_log;
+ my (@content,@data,@data2,@data3,@files,$repo,@repos,@rows);
+ my ($key,$path);
+ my $apk = '/etc/apk/repositories';
+ my $apt = '/etc/apt/sources.list';
+ my $eopkg_dir = '/var/lib/eopkg/';
+ my $pacman = '/etc/pacman.conf';
+ my $pacman_g2 = '/etc/pacman-g2.conf';
+ my $pisi_dir = '/etc/pisi/';
+ my $portage_dir = '/etc/portage/repos.conf/';
+ my $slackpkg = '/etc/slackpkg/mirrors';
+ my $slackpkg_plus = '/etc/slackpkg/slackpkgplus.conf';
+ my $yum_conf = '/etc/yum.conf';
+ my $yum_repo_dir = '/etc/yum.repos.d/';
+ my $zypp_repo_dir = '/etc/zypp/repos.d/';
+ my $b_test = 0;
+ # apt - debian, buntus, also sometimes some yum/rpm repos may create
+ # apt repos here as well
+ if (-f $apt || -d "$apt.d"){
+ my ($apt_arch,$apt_comp,$apt_suites,$apt_types,@apt_urls,@apt_working,
+ $b_apt_enabled,$file,$string);
+ my $counter = 0;
+ @files = main::globber('/etc/apt/sources.list.d/*.list');
+ push @files, $apt;
+ main::log_data('data',"apt repo files:\n" . main::joiner(\@files, "\n", 'unset') ) if $b_log;
+ foreach ( sort @files){
+ # altlinux uses rpms in apt files!
+ @data = repo_builder($_,'apt','^\s*(deb|rpm)') if -r $_;
+ @rows = (@rows,@data);
+ }
+ #@files = main::globber("$ENV{'HOME'}/bin/scripts/inxi/data/repo/apt/*.sources");
+ @files = main::globber('/etc/apt/sources.list.d/*.sources');
+ main::log_data('data',"apt deb822 repo files:\n" . main::joiner(\@files, "\n", 'unset') ) if $b_log;
+ foreach $file (@files){
+ @data2 = main::reader($file,'strip');
+ my $count = scalar @data2;
+ push @dbg_files, $file if $debugger_dir;
+ #print "$file\n";
+ @apt_urls = ();
+ @apt_working = ();
+ $counter = 0;
+ $b_apt_enabled = 1;
+ foreach my $row (@data2){
+ $counter++;
+ next if $row =~ /^\s*$|^\s*#/;
+ #print "row:$row\n";
+ if ($row =~ /^Types:\s*(.*)/){
+ my $type_holder= $1;
+ #print "ath:$type_holder\n";
+ if ($apt_types && @apt_working){
+ if ($b_apt_enabled){
+ #print "1: url builder\n";
+ foreach $repo (@apt_working){
+ $string = $apt_types;
+ $string .= ' [arch=' . $apt_arch . ']' if $apt_arch;
+ $string .= ' ' . $repo;
+ $string .= ' ' . $apt_suites if $apt_suites ;
+ $string .= ' ' . $apt_comp if $apt_comp;
+
+ #print "s1:$string\n";
+ push @data3, $string;
+ }
+ }
+ #print join "\n",@data3,"\n";
+ @apt_urls = (@apt_urls,@data3);
+ @data3 = ();
+ @apt_working = ();
+ $apt_arch = '';
+ $apt_comp = '';
+ $apt_suites = '';
+ $apt_types = '';
+ }
+ $apt_types = $type_holder;
+ $b_apt_enabled = 1;
+ }
+ if ($row =~ /^Enabled:\s*(.*)/){
+ my $status = $1;
+ $b_apt_enabled = ($status =~ /no/i) ? 0: 1;
+ }
+ if ($row =~ /:\//){
+ my $url = $row;
+ $url =~ s/^URIs:\s*//;
+ push @apt_working, $url if $url;
+ }
+ if ($row =~ /^Suites:\s*(.*)/){
+ $apt_suites = $1;
+ }
+ if ($row =~ /^Components:\s*(.*)/){
+ $apt_comp = $1;
+ }
+ if ($row =~ /^Architectures:\s*(.*)/){
+ $apt_arch = $1;
+ }
+ # we've hit the last line!!
+ if ($counter == $count && @apt_working){
+ #print "2: url builder\n";
+ if ($b_apt_enabled){
+ foreach $repo (@apt_working){
+ my $string = $apt_types;
+ $string .= ' [arch=' . $apt_arch . ']' if $apt_arch;
+ $string .= ' ' . $repo;
+ $string .= ' ' . $apt_suites if $apt_suites ;
+ $string .= ' ' . $apt_comp if $apt_comp;
+ #print "s2:$string\n";
+ push @data3, $string;
+ }
+ }
+ #print join "\n",@data3,"\n";
+ @apt_urls = (@apt_urls,@data3);
+ @data3 = ();
+ @apt_working = ();
+ $apt_arch = '';
+ $apt_comp = '';
+ $apt_suites = '';
+ $apt_types = '';
+ }
+ }
+ if (@apt_urls){
+ $key = repo_builder('active','apt');
+ @apt_urls = url_cleaner(@apt_urls);
+ }
+ else {
+ $key = repo_builder('missing','apt');
+ }
+ @data = (
+ {main::key($num++,$key) => $file},
+ [@apt_urls],
+ );
+ @rows = (@rows,@data);
+ }
+ @files = ();
+ }
+ # pacman: Arch and derived
+ if (-f $pacman || -f $pacman_g2){
+ $repo = 'pacman';
+ if (-f $pacman_g2 ){
+ $pacman = $pacman_g2;
+ $repo = 'pacman-g2';
+ }
+ @files = main::reader($pacman,'strip');
+ if (@files){
+ @repos = grep {/^\s*Server/i} @files;
+ @files = grep {/^\s*Include/i} @files;
+ }
+ if (@files){
+ @files = map {
+ my @working = split( /\s+=\s+/, $_);
+ $working[1];
+ } @files;
+ }
+ @files = sort(@files);
+ @files = main::uniq(@files);
+ unshift @files, $pacman if @repos;
+ foreach (@files){
+ if (-f $_){
+ @data = repo_builder($_,$repo,'^\s*Server','\s*=\s*',1);
+ @rows = (@rows,@data);
+ }
+ else {
+ # set it so the debugger knows the file wasn't there
+ push @dbg_files, $_ if $debugger_dir;
+ @data = (
+ {main::key($num++,'File listed in') => $pacman},
+ [("$_ does not seem to exist.")],
+ );
+ @rows = (@rows,@data);
+ }
+ }
+ if (!@rows){
+ @data = (
+ {main::key($num++,repo_builder('missing','no-files')) => $pacman },
+ );
+ @rows = (@rows,@data);
+ }
+ }
+ # slackware
+ if (-f $slackpkg || -f $slackpkg_plus){
+ #$slackpkg = "$ENV{HOME}/bin/scripts/inxi/data/repo/slackware/slackpkg-2.conf";
+ if (-f $slackpkg){
+ @data = repo_builder($slackpkg,'slackpkg','^[[:space:]]*[^#]+');
+ @rows = (@rows,@data);
+ }
+ if (-f $slackpkg_plus){
+ push @dbg_files, $slackpkg_plus if $debugger_dir;
+ @data = main::reader($slackpkg_plus,'strip');
+ my (@repoplus_list,$active_repos);
+ foreach my $row (@data){
+ @data2 = split /\s*=\s*/, $row;
+ @data2 = map { $_ =~ s/^\s+|\s+$//g ; $_ } @data2;
+ last if $data2[0] =~ /^SLACKPKGPLUS/ && $data2[1] eq 'off';
+ # REPOPLUS=( slackpkgplus restricted alienbob ktown multilib slacky)
+ if ($data2[0] =~ /^REPOPLUS/){
+ @repoplus_list = split /\s+/, $data2[1];
+ @repoplus_list = map {s/\(|\)//g; $_} @repoplus_list;
+ $active_repos = join ('|',@repoplus_list);
+
+ }
+ # MIRRORPLUS['multilib']=http://taper.alienbase.nl/mirrors/people/alien/multilib/14.1/
+ if ($active_repos && $data2[0] =~ /^MIRRORPLUS/){
+ $data2[0] =~ s/MIRRORPLUS\[\'|\'\]//g;
+ if ($data2[0] =~ /$active_repos/){
+ push @content,"$data2[0] ~ $data2[1]";
+ }
+ }
+ }
+ if (! @content){
+ $key = repo_builder('missing','slackpkg+');
+ }
+ else {
+ @content = url_cleaner(@content);
+ $key = repo_builder('active','slackpkg+');
+ }
+ @data = (
+ {main::key($num++,$key) => $slackpkg_plus},
+ [@content],
+ );
+ @data = url_cleaner(@data);
+ @rows = (@rows,@data);
+ @content = ();
+ }
+ }
+ # redhat/suse
+ if (-d $yum_repo_dir || -f $yum_conf || -d $zypp_repo_dir){
+ if (-d $yum_repo_dir || -f $yum_conf){
+ @files = main::globber("$yum_repo_dir*.repo");
+ push @files, $yum_conf if -f $yum_conf;
+ $repo = 'yum';
+ }
+ elsif (-d $zypp_repo_dir){
+ @files = main::globber("$zypp_repo_dir*.repo");
+ main::log_data('data',"zypp repo files:\n" . main::joiner(\@files, "\n", 'unset')) if $b_log;
+ $repo = 'zypp';
+ }
+ #$repo = 'yum';
+ #push @files, "$ENV{'HOME'}/bin/scripts/inxi/data/repo/yum/rpmfusion-nonfree-1.repo";
+ if (@files){
+ foreach (sort @files){
+ @data2 = main::reader($_);
+ push @dbg_files, $_ if $debugger_dir;
+ my ($enabled,$url,$title) = (undef,'','');
+ foreach my $line (@data2){
+ # this is a hack, assuming that each item has these fields listed, we collect the 3
+ # items one by one, then when the url/enabled fields are set, we print it out and
+ # reset the data. Not elegant but it works. Note that if enabled was not present
+ # we assume it is enabled then, and print the line, reset the variables. This will
+ # miss the last item, so it is printed if found in END
+ if ($line =~ /^\[(.+)\]/){
+ my $temp = $1;
+ if ($url && $title && defined $enabled){
+ if ($enabled > 0){
+ push @content, "$title ~ $url";
+ }
+ ($enabled,$url,$title) = (undef,'','');
+ }
+ $title = $temp;
+ }
+ # Note: it looks like enabled comes before url
+ elsif ($line =~ /^(metalink|mirrorlist|baseurl)\s*=\s*(.*)/){
+ $url = $2;
+ }
+ # note: enabled = 1. enabled = 0 means disabled
+ elsif ($line =~ /^enabled\s*=\s*([01])/){
+ $enabled = $1;
+ }
+ # print out the line if all 3 values are found, otherwise if a new
+ # repoTitle is hit above, it will print out the line there instead
+ if ($url && $title && defined $enabled){
+ if ($enabled > 0){
+ push @content, "$title ~ $url";
+ }
+ ($enabled,$url,$title) = (0,'','');
+ }
+ }
+ # print the last one if there is data for it
+ if ($url && $title && $enabled){
+ push @content, "$title ~ $url";
+ }
+
+ if (! @content){
+ $key = repo_builder('missing',$repo);
+ }
+ else {
+ @content = url_cleaner(@content);
+ $key = repo_builder('active',$repo);
+ }
+ @data = (
+ {main::key($num++,$key) => $_},
+ [@content],
+ );
+ @rows = (@rows,@data);
+ @content = ();
+ }
+ }
+ # print Data::Dumper::Dumper \@rows;
+ }
+ # gentoo
+ if (-d $portage_dir && main::check_program('emerge')){
+ @files = main::globber("$portage_dir*.conf");
+ $repo = 'portage';
+ if (@files){
+ foreach (sort @files){
+ @data2 = main::reader($_);
+ push @dbg_files, $_ if $debugger_dir;
+ my ($enabled,$url,$title) = (undef,'','');
+ foreach my $line (@data2){
+ # this is a hack, assuming that each item has these fields listed, we collect the 3
+ # items one by one, then when the url/enabled fields are set, we print it out and
+ # reset the data. Not elegant but it works. Note that if enabled was not present
+ # we assume it is enabled then, and print the line, reset the variables. This will
+ # miss the last item, so it is printed if found in END
+ if ($line =~ /^\[(.+)\]/){
+ my $temp = $1;
+ if ($url && $title && defined $enabled){
+ if ($enabled > 0){
+ push @content, "$title ~ $url";
+ }
+ ($enabled,$url,$title) = (undef,'','');
+ }
+ $title = $temp;
+ }
+ elsif ($line =~ /^(sync-uri)\s*=\s*(.*)/){
+ $url = $2;
+ }
+ # note: enabled = 1. enabled = 0 means disabled
+ elsif ($line =~ /^auto-sync\s*=\s*([01])/){
+ $enabled = $1;
+ }
+ # print out the line if all 3 values are found, otherwise if a new
+ # repoTitle is hit above, it will print out the line there instead
+ if ($url && $title && defined $enabled){
+ if ($enabled > 0){
+ push @content, "$title ~ $url";
+ }
+ ($enabled,$url,$title) = (undef,'','');
+ }
+ }
+ # print the last one if there is data for it
+ if ($url && $title && $enabled){
+ push @content, "$title ~ $url";
+ }
+ if (! @content){
+ $key = repo_builder('missing','portage');
+ }
+ else {
+ @content = url_cleaner(@content);
+ $key = repo_builder('active','portage');
+ }
+ @data = (
+ {main::key($num++,$key) => $_},
+ [@content],
+ );
+ @rows = (@rows,@data);
+ @content = ();
+ }
+ }
+ }
+ # Alpine linux
+ if (-f $apk){
+ @data = repo_builder($apk,'apk','^\s*[^#]+');
+ @rows = (@rows,@data);
+ }
+ # Mandriva/Mageia using: urpmq
+ if ( $path = main::check_program('urpmq') ){
+ @data2 = main::grabber("$path --list-media active --list-url","\n",'strip');
+ main::writer("$debugger_dir/system-repo-data-urpmq.txt",@data2) if $debugger_dir;
+ # now we need to create the structure: repo info: repo path
+ # we do that by looping through the lines of the output and then
+ # putting it back into the <data>:<url> format print repos expects to see
+ # note this structure in the data, so store first line and make start of line
+ # then when it's an http line, add it, and create the full line collection.
+ # Contrib ftp://ftp.uwsg.indiana.edu/linux/mandrake/official/2011/x86_64/media/contrib/release
+ # Contrib Updates ftp://ftp.uwsg.indiana.edu/linux/mandrake/official/2011/x86_64/media/contrib/updates
+ # Non-free ftp://ftp.uwsg.indiana.edu/linux/mandrake/official/2011/x86_64/media/non-free/release
+ # Non-free Updates ftp://ftp.uwsg.indiana.edu/linux/mandrake/official/2011/x86_64/media/non-free/updates
+ # Nonfree Updates (Local19) /mnt/data/mirrors/mageia/distrib/cauldron/x86_64/media/nonfree/updates
+ foreach (@data2){
+ # need to dump leading/trailing spaces and clear out color codes for irc output
+ $_ =~ s/\x1B\[([0-9]{1,2}(;[0-9]{1,2})?)?[m|K]//g;
+ $_ =~ s/\e\[([0-9];)?[0-9]+m//g;
+ # urpmq output is the same each line, repo name space repo url, can be:
+ # rsync://, ftp://, file://, http:// OR repo is locally mounted on FS in some cases
+ if (/(.+)\s([\S]+:\/\/.+)/){
+ # pack the repo url
+ push @content, $1;
+ @content = url_cleaner(@content);
+ # get the repo
+ $repo = $2;
+ @data = (
+ {main::key($num++,'urpmq repo') => $repo},
+ [@content],
+ );
+ @rows = (@rows,@data);
+ @content = ();
+ }
+ }
+ }
+ # Pardus/Solus
+ if ( (-d $pisi_dir && ( $path = main::check_program('pisi') ) ) ||
+ (-d $eopkg_dir && ( $path = main::check_program('eopkg') ) ) ){
+ #$path = 'eopkg';
+ my $which = ($path =~ /pisi$/) ? 'pisi': 'eopkg';
+ my $cmd = ($which eq 'pisi') ? "$path list-repo": "$path lr";
+ #my $file = "$ENV{HOME}/bin/scripts/inxi/data/repo/solus/eopkg-2.txt";
+ #@data2 = main::reader($file,'strip');
+ @data2 = main::grabber("$cmd 2>/dev/null","\n",'strip');
+ main::writer("$debugger_dir/system-repo-data-$which.txt",@data2) if $debugger_dir;
+ # now we need to create the structure: repo info: repo path
+ # we do that by looping through the lines of the output and then
+ # putting it back into the <data>:<url> format print repos expects to see
+ # note this structure in the data, so store first line and make start of line
+ # then when it's an http line, add it, and create the full line collection.
+ # Pardus-2009.1 [Aktiv]
+ # http://packages.pardus.org.tr/pardus-2009.1/pisi-index.xml.bz2
+ # Contrib [Aktiv]
+ # http://packages.pardus.org.tr/contrib-2009/pisi-index.xml.bz2
+ # Solus [inactive]
+ # https://packages.solus-project.com/shannon/eopkg-index.xml.xz
+ foreach (@data2){
+ next if /^\s*$/;
+ # need to dump leading/trailing spaces and clear out color codes for irc output
+ $_ =~ s/\x1B\[([0-9]{1,2}(;[0-9]{1,2})?)?[m|K]//g;
+ $_ =~ s/\e\[([0-9];)?[0-9]+m//g;
+ if (/^\/|:\/\//){
+ push @content, $_ if $repo;
+ }
+ # Local [inactive] Unstable [active]
+ elsif ( /^(.*)\s\[([\S]+)\]/){
+ $repo = $1;
+ $repo = ($2 =~ /^activ/i) ? $repo : '';
+ }
+ if ($repo && @content){
+ @content = url_cleaner(@content);
+ $key = repo_builder('active',$which);
+ @data = (
+ {main::key($num++,$key) => $repo},
+ [@content],
+ );
+ @rows = (@rows,@data);
+ $repo = '';
+ @content = ();
+ }
+ }
+ # last one if present
+ if ($repo && @content){
+ @content = url_cleaner(@content);
+ $key = repo_builder('active',$which);
+ @data = (
+ {main::key($num++,$key) => $repo},
+ [@content],
+ );
+ @rows = (@rows,@data);
+ }
+ }
+ # print Dumper \@rows;
+ eval $end if $b_log;
+ return @rows;
+}
+sub get_repos_bsd {
+ eval $start if $b_log;
+ my (@content,@data,@data2,@data3,@files,@rows);
+ my ($key);
+ my $bsd_pkg = '/usr/local/etc/pkg/repos/';
+ my $freebsd = '/etc/freebsd-update.conf';
+ my $freebsd_pkg = '/etc/pkg/FreeBSD.conf';
+ my $netbsd = '/usr/pkg/etc/pkgin/repositories.conf';
+ my $openbsd = '/etc/pkg.conf';
+ my $openbsd2 = '/etc/installurl';
+ my $portsnap = '/etc/portsnap.conf';
+ if ( -f $portsnap || -f $freebsd || -d $bsd_pkg){
+ if ( -f $portsnap ) {
+ @data = repo_builder($portsnap,'portsnap','^\s*SERVERNAME','\s*=\s*',1);
+ @rows = (@rows,@data);
+ }
+ if ( -f $freebsd ){
+ @data = repo_builder($freebsd,'freebsd','^\s*ServerName','\s+',1);
+ @rows = (@rows,@data);
+ }
+# if ( -f $freebsd_pkg ){
+# @data = repo_builder($freebsd_pkg,'freebsd-pkg','^\s*url',':\s+',1);
+# @rows = (@rows,@data);
+# }
+ if ( -d $bsd_pkg || -f $freebsd_pkg){
+ @files = main::globber('/usr/local/etc/pkg/repos/*.conf');
+ push @files, $freebsd_pkg if -f $freebsd_pkg;
+ if (@files){
+ my ($url);
+ foreach (@files){
+ push @dbg_files, $_ if $debugger_dir;
+ # these will be result sets separated by an empty line
+ # first dump all lines that start with #
+ @content = main::reader($_,'strip');
+ # then do some clean up on the lines
+ @content = map { $_ =~ s/{|}|,|\*//g; $_; } @content if @content;
+ # get all rows not starting with a # and starting with a non space character
+ my $url = '';
+ foreach my $line (@content){
+ if ($line !~ /^\s*$/){
+ my @data2 = split /\s*:\s*/, $line;
+ @data2 = map { $_ =~ s/^\s+|\s+$//g; $_; } @data2;
+ if ($data2[0] eq 'url'){
+ $url = "$data2[1]:$data2[2]";
+ $url =~ s/"|,//g;
+ }
+ #print "url:$url\n" if $url;
+ if ($data2[0] eq 'enabled'){
+ if ($url && $data2[1] eq 'yes'){
+ push @data3, "$url"
+ }
+ $url = '';
+ }
+ }
+ }
+ if (! @data3){
+ $key = repo_builder('missing','bsd-package');
+ }
+ else {
+ @data3 = url_cleaner(@data3);
+ $key = repo_builder('active','bsd-package');
+ }
+ @data = (
+ {main::key($num++,$key) => $_},
+ [@data3],
+ );
+ @rows = (@rows,@data);
+ @data3 = ();
+ }
+ }
+ }
+ }
+ elsif (-f $openbsd || -f $openbsd2) {
+ if (-f $openbsd){
+ @data = repo_builder($openbsd,'openbsd','^installpath','\s*=\s*',1);
+ @rows = (@rows,@data);
+ }
+ if (-f $openbsd2){
+ @data = repo_builder($openbsd2,'openbsd','^(http|ftp)','',1);
+ @rows = (@rows,@data);
+ }
+ }
+ elsif (-f $netbsd){
+ # not an empty row, and not a row starting with #
+ @data = repo_builder($netbsd,'netbsd','^\s*[^#]+$');
+ @rows = (@rows,@data);
+ }
+ # BSDs do not default always to having repo files, so show correct error
+ # mesage in that case
+ if (!@rows){
+ if ($bsd_type eq 'freebsd'){
+ $key = repo_builder('missing','freebsd-nf');
+ }
+ elsif ($bsd_type eq 'openbsd'){
+ $key = repo_builder('missing','openbsd-nf');
+ }
+ elsif ($bsd_type eq 'netbsd'){
+ $key = repo_builder('missing','netbsd-nf');
+ }
+ else {
+ $key = repo_builder('missing','bsd-nf');
+ }
+ @data = (
+ {main::key($num++,'Message') => $key},
+ [()],
+ );
+ @rows = (@rows,@data);
+ }
+ eval $start if $b_log;
+ return @rows;
+}
+sub repo_builder {
+ eval $start if $b_log;
+ my ($file,$type,$search,$split,$count) = @_;
+ my (@content,@data,$missing,$key);
+ my %unfound = (
+ 'apk' => 'No active APK repos in',
+ 'apt' => 'No active apt repos in',
+ 'bsd-package' => 'No enabled BSD pkg servers in',
+ 'bsd-nf' => 'No BSD pkg server files found',
+ 'eopkg' => 'No active eopkg repos found',
+ 'pacman' => 'No active pacman repos in',
+ 'pacman-g2' => 'No active pacman-g2 repos in',
+ 'pisi' => 'No active pisi repos found',
+ 'portage' => 'No enabled portage sources in',
+ 'portsnap' => 'No ports servers in',
+ 'freebsd' => 'No FreeBSD update servers in',
+ 'freebsd-nf' => 'No FreeBSD update server files found',
+ 'freebsd-pkg' => 'No FreeBSD default pkg server in',
+ 'openbsd' => 'No OpenBSD pkg mirrors in',
+ 'openbsd-nf' => 'No OpenBSD pkg mirror files found',
+ 'netbsd' => 'No NetBSD pkg servers in',
+ 'netbsd-nf' => 'No NetBSD pkg server files found',
+ 'no-files' => 'No repo files found in',
+ 'slackpkg' => 'No active slackpkg repos in',
+ 'slackpkg+' => 'No active slackpkg+ repos in',
+ 'yum' => 'No active yum repos in',
+ 'zypp' => 'No active zypp repos in',
+ );
+ $missing = $unfound{$type};
+ return $missing if $file eq 'missing';
+ my %keys = (
+ 'apk' => 'APK repo',
+ 'apt' => 'Active apt repos in',
+ 'bsd-package' => 'BSD enabled pkg servers in',
+ 'eopkg' => 'Active eopkg repo',
+ 'freebsd' => 'FreeBSD update server',
+ 'freebsd-pkg' => 'FreeBSD default pkg server',
+ 'pacman' => 'Active pacman repo servers in',
+ 'pacman-g2' => 'Active pacman-g2 repo servers in',
+ 'pisi' => 'Active pisi repo',
+ 'portage' => 'Enabled portage sources in',
+ 'portsnap' => 'BSD ports server',
+ 'openbsd' => 'OpenBSD pkg mirror',
+ 'netbsd' => 'NetBSD pkg servers',
+ 'slackpkg' => 'slackpkg repos in',
+ 'slackpkg+' => 'slackpkg+ repos in',
+ 'yum' => 'Active yum repos in',
+ 'zypp' => 'Active zypp repos in',
+ );
+ $key = $keys{$type};
+ return $key if $file eq 'active';
+ push @dbg_files, $file if $debugger_dir;
+ @content = main::reader($file);
+ @content = grep {/$search/i && !/^\s*$/} @content if @content;
+ @content = data_cleaner(@content);
+ if ($split){
+ @content = map {
+ my @inner = split (/$split/, $_);
+ $inner[$count];
+ } @content;
+ }
+ if (!@content){
+ $key = $missing;
+ }
+ else {
+ @content = url_cleaner(@content);
+ }
+ @data = (
+ {main::key($num++,$key) => $file},
+ [@content],
+ );
+ eval $end if $b_log;
+ return @data;
+}
+sub data_cleaner {
+ my (@content) = @_;
+ # basics: trim white space, get rid of double spaces
+ @content = map { $_ =~ s/^\s+|\s+$//g; $_ =~ s/\s\s+/ /g; $_} @content;
+ return @content;
+}
+# clean if irc
+sub url_cleaner {
+ my (@content) = @_;
+ @content = map { $_ =~ s/:\//: \//; $_} @content if $b_irc;
+ return @content;
+}
+sub file_path {
+ my ($filename,$dir) = @_;
+ my ($working);
+ $working = $filename;
+ $working =~ s/^\///;
+ $working =~ s/\//-/g;
+ $working = "$dir/file-repo-$working.txt";
+ return $working;
+}
+}
+
+## SensorData
+{
+package SensorData;
+my (@sensors_data);
+my ($b_ipmi) = (0);
+sub get {
+ eval $start if $b_log;
+ my ($key1,$program,$val1,@data,@rows,%sensors);
+ my $num = 0;
+ my $source = 'sensors';
+ # we're allowing 1 or 2 ipmi tools, first the gnu one, then the
+ # almost certain to be present in BSDs
+ if ( $b_ipmi ||
+ ( main::globber('/dev/ipmi**') &&
+ ( ( $program = main::check_program('ipmi-sensors') ) ||
+ ( $program = main::check_program('ipmitool') ) ) ) ){
+ if ($b_ipmi || $b_root){
+ %sensors = ipmi_data($program);
+ @data = create_output('ipmi',%sensors);
+ if (!@data) {
+ $key1 = 'Message';
+ $val1 = main::row_defaults('sensors-data-ipmi');
+ #$val1 = main::row_defaults('dev');
+ @data = ({main::key($num++,$key1) => $val1,});
+ }
+ @rows = (@rows,@data);
+ $source = 'lm-sensors'; # trips per sensor type output
+ }
+ else {
+ $key1 = 'Permissions';
+ $val1 = main::row_defaults('sensors-ipmi-root');
+ @data = ({main::key($num++,$key1) => $val1,});
+ @rows = (@rows,@data);
+ }
+ }
+ my $ref = $alerts{'sensors'};
+ if ( $$ref{'action'} ne 'use'){
+ #print "here 1\n";
+ $key1 = $$ref{'action'};
+ $val1 = $$ref{$key1};
+ $key1 = ucfirst($key1);
+ @data = ({main::key($num++,$key1) => $val1,});
+ @rows = (@rows,@data);
+ }
+ else {
+ %sensors = lm_sensors_data();
+ @data = create_output($source,%sensors);
+ #print "here 2\n";
+ if (!@data) {
+ $key1 = 'Message';
+ $val1 = main::row_defaults('sensors-data-linux');
+ @data = ({main::key($num++,$key1) => $val1,});
+ }
+ @rows = (@rows,@data);
+ }
+ undef @sensors_data;
+ eval $end if $b_log;
+ return @rows;
+}
+sub create_output {
+ eval $start if $b_log;
+ my ($source,%sensors) = @_;
+ # note: might revisit this, since gpu sensors data might be present
+ return if ! %sensors;
+ my (@gpu,@data,@rows,@fan_default,@fan_main);
+ my ($data_source) = ('');
+ my $fan_number = 0;
+ my $num = 0;
+ my $j = 0;
+ @gpu = gpu_data() if ( $source eq 'sensors' || $source eq 'lm-sensors' );
+ my $temp_unit = (defined $sensors{'temp-unit'}) ? " $sensors{'temp-unit'}": '';
+ my $cpu_temp = (defined $sensors{'cpu-temp'}) ? $sensors{'cpu-temp'} . $temp_unit: 'N/A';
+ my $mobo_temp = (defined $sensors{'mobo-temp'}) ? $sensors{'mobo-temp'} . $temp_unit: 'N/A';
+ my $cpu1_key = ($sensors{'cpu2-temp'}) ? 'cpu-1': 'cpu' ;
+ $data_source = $source if ($source eq 'ipmi' || $source eq 'lm-sensors');
+ @data = ({
+ main::key($num++,'System Temperatures') => $data_source,
+ main::key($num++,$cpu1_key) => $cpu_temp,
+ });
+ @rows = (@rows,@data);
+ if ($sensors{'cpu2-temp'}){
+ $rows[$j]{main::key($num++,'cpu-2')} = $sensors{'cpu2-temp'} . $temp_unit;
+ }
+ if ($sensors{'cpu3-temp'}){
+ $rows[$j]{main::key($num++,'cpu-3')} = $sensors{'cpu3-temp'} . $temp_unit;
+ }
+ if ($sensors{'cpu4-temp'}){
+ $rows[$j]{main::key($num++,'cpu-4')} = $sensors{'cpu4-temp'} . $temp_unit;
+ }
+ $rows[$j]{main::key($num++,'mobo')} = $mobo_temp;
+ if (defined $sensors{'sodimm-temp'}){
+ my $sodimm_temp = $sensors{'sodimm-temp'} . $temp_unit;
+ $rows[$j]{main::key($num++,'sodimm')} = $sodimm_temp;
+ }
+ if (defined $sensors{'psu-temp'}){
+ my $psu_temp = $sensors{'psu-temp'} . $temp_unit;
+ $rows[$j]{main::key($num++,'psu')} = $psu_temp;
+ }
+ if (defined $sensors{'ambient-temp'}){
+ my $ambient_temp = $sensors{'ambient-temp'} . $temp_unit;
+ $rows[$j]{main::key($num++,'ambient')} = $ambient_temp;
+ }
+ if (scalar @gpu == 1){
+ my $gpu_temp = $gpu[0]{'temp'};
+ my $gpu_type = $gpu[0]{'type'};
+ my $gpu_unit = (defined $gpu[0]{'temp-unit'} && $gpu_temp ) ? " $gpu[0]{'temp-unit'}" : ' C';
+ $rows[$j]{main::key($num++,'gpu')} = $gpu_type;
+ $rows[$j]{main::key($num++,'temp')} = $gpu_temp . $gpu_unit;
+ }
+ $j = scalar @rows;
+ my $ref_main = $sensors{'fan-main'};
+ my $ref_default = $sensors{'fan-default'};
+ @fan_main = @$ref_main if @$ref_main;
+ @fan_default = @$ref_default if @$ref_default;
+ my $fan_def = ($data_source) ? $data_source : '';
+ if (!@fan_main && !@fan_default){
+ $fan_def = ($fan_def) ? "$data_source N/A" : 'N/A';
+ }
+ $rows[$j]{main::key($num++,'Fan Speeds (RPM)')} = $fan_def;
+ my $b_cpu = 0;
+ for (my $i = 0; $i < scalar @fan_main; $i++){
+ next if $i == 0;# starts at 1, not 0
+ if (defined $fan_main[$i]){
+ if ($i == 1 || ($i == 2 && !$b_cpu )){
+ $rows[$j]{main::key($num++,'cpu')} = $fan_main[$i];
+ $b_cpu = 1;
+ }
+ elsif ($i == 2 && $b_cpu){
+ $rows[$j]{main::key($num++,'mobo')} = $fan_main[$i];
+ }
+ elsif ($i == 3){
+ $rows[$j]{main::key($num++,'psu')} = $fan_main[$i];
+ }
+ elsif ($i == 4){
+ $rows[$j]{main::key($num++,'sodimm')} = $fan_main[$i];
+ }
+ elsif ($i > 4){
+ $fan_number = $i - 4;
+ $rows[$j]{main::key($num++,"case-$fan_number")} = $fan_main[$i];
+ }
+ }
+ }
+ for (my $i = 0; $i < scalar @fan_default; $i++){
+ next if $i == 0;# starts at 1, not 0
+ if (defined $fan_default[$i]){
+ $rows[$j]{main::key($num++,"fan-$i")} = $fan_default[$i];
+ }
+ }
+ $rows[$j]{main::key($num++,'psu')} = $sensors{'fan-psu'} if defined $sensors{'fan-psu'};
+ $rows[$j]{main::key($num++,'psu-1')} = $sensors{'fan-psu1'} if defined $sensors{'fan-psu1'};
+ $rows[$j]{main::key($num++,'psu-2')} = $sensors{'fan-psu2'} if defined $sensors{'fan-psu2'};
+ # note: so far, only nvidia-settings returns speed, and that's in percent
+ if (scalar @gpu == 1 && defined $gpu[0]{'fan-speed'}){
+ my $gpu_fan = $gpu[0]{'fan-speed'} . $gpu[0]{'speed-unit'};
+ my $gpu_type = $gpu[0]{'type'};
+ $rows[$j]{main::key($num++,'gpu')} = $gpu_type;
+ $rows[$j]{main::key($num++,'fan')} = $gpu_fan;
+ }
+ if (scalar @gpu > 1){
+ $j = scalar @rows;
+ $rows[$j]{main::key($num++,'GPU')} = '';
+ my $gpu_unit = (defined $gpu[0]{'temp-unit'} ) ? " $gpu[0]{'temp-unit'}" : ' C';
+ foreach my $ref (@gpu){
+ my %info = %$ref;
+ # speed unit is either '' or %
+ my $gpu_fan = (defined $info{'fan-speed'}) ? $info{'fan-speed'} . $info{'speed-unit'}: undef ;
+ my $gpu_type = $info{'type'};
+ my $gpu_temp = (defined $info{'temp'} ) ? $info{'temp'} . $gpu_unit: 'N/A';
+ $rows[$j]{main::key($num++,'device')} = $gpu_type;
+ if (defined $info{'screen'} ){
+ $rows[$j]{main::key($num++,'screen')} = $info{'screen'};
+ }
+ $rows[$j]{main::key($num++,'temp')} = $gpu_temp;
+ if (defined $gpu_fan){
+ $rows[$j]{main::key($num++,'fan')} = $gpu_fan;
+ }
+ }
+ }
+ if ($extra > 0 && ($source eq 'ipmi' ||
+ ($sensors{'volts-12'} || $sensors{'volts-5'} || $sensors{'volts-3.3'} || $sensors{'volts-vbat'}))){
+ $j = scalar @rows;
+ $sensors{'volts-12'} ||= 'N/A';
+ $sensors{'volts-5'} ||= 'N/A';
+ $sensors{'volts-3.3'} ||= 'N/A';
+ $sensors{'volts-vbat'} ||= 'N/A';
+ $rows[$j]{main::key($num++,'Voltages')} = $data_source;
+ $rows[$j]{main::key($num++,'12v')} = $sensors{'volts-12'};
+ $rows[$j]{main::key($num++,'5v')} = $sensors{'volts-5'};
+ $rows[$j]{main::key($num++,'3.3v')} = $sensors{'volts-3.3'};
+ $rows[$j]{main::key($num++,'vbat')} = $sensors{'volts-vbat'};
+ if ($extra > 1 && $source eq 'ipmi' ){
+ $sensors{'volts-dimm-p1'} ||= 'N/A';
+ $sensors{'volts-dimm-p2'} ||= 'N/A';
+ $rows[$j]{main::key($num++,'dimm-p1')} = $sensors{'volts-dimm-p1'} if $sensors{'volts-dimm-p1'};
+ $rows[$j]{main::key($num++,'dimm-p2')} = $sensors{'volts-dimm-p2'} if $sensors{'volts-dimm-p2'};
+ $rows[$j]{main::key($num++,'soc-p1')} = $sensors{'volts-soc-p1'} if $sensors{'volts-soc-p1'};
+ $rows[$j]{main::key($num++,'soc-p2')} = $sensors{'volts-soc-p2'} if $sensors{'volts-soc-p2'};
+ }
+ }
+ eval $end if $b_log;
+ return @rows;
+}
+sub ipmi_data {
+ eval $start if $b_log;
+ my ($program) = @_;
+ my ($b_cpu_0,$cmd,$file,@data,$fan_working,%sensors,@row,$sys_fan_nu,
+ $temp_working,$working_unit);
+ $program ||= 'ipmi-sensors'; # only for debugging, will always exist if reaches here
+ my ($b_ipmitool,$i_key,$i_value,$i_unit);
+ if ($program =~ /ipmi-sensors$/){
+ $cmd = $program;
+ ($b_ipmitool,$i_key,$i_value,$i_unit) = (0,1,3,4);
+ }
+ else {
+ $cmd = "$program sensors";
+ ($b_ipmitool,$i_key,$i_value,$i_unit) = (1,0,1,2);
+ }
+ @data = main::grabber("$cmd 2>/dev/null");
+ #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/ipmitool/ipmitool-sensors-archerseven-1.txt";
+ #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/ipmitool/ipmitool-sensors-crazy-epyc-1.txt";
+ #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/ipmitool/ipmi-sensors-crazy-epyc-1.txt";$program='ipmi-sensors';
+ #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/ipmitool/ipmitool-sensors-RK016013.txt";$program='ipmi-sensors';
+ #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/ipmitool/ipmi-sensors-lathander.txt";
+ #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/ipmitool/ipmi-sensors-zwerg.txt";
+ #@data = main::reader($file);
+ return if ! @data;
+ foreach (@data){
+ next if /^\s*$/;
+ # print "$_\n";
+ @row = split /\s*\|\s*/, $_;
+ next if $row[$i_value] !~ /^[0-9\.]+$/i;
+ # print "$row[$i_key] - $row[$i_value]\n";
+ if ($row[$i_key] =~ /^(System[\s_]Temp|System[\s_]?Board)$/i){
+ $sensors{'mobo-temp'} = int($row[$i_value]);
+ $working_unit = $row[$i_unit];
+ $working_unit =~ s/degrees\s// if $b_ipmitool;
+ $sensors{'temp-unit'} = set_temp_unit($sensors{'temp-unit'},$working_unit) if $working_unit;
+ }
+ elsif ($row[$i_key] =~ /^(Ambient)$/i){
+ $sensors{'ambient-temp'} = int($row[$i_value]);
+ $working_unit = $row[$i_unit];
+ $working_unit =~ s/degrees\s// if $b_ipmitool;
+ $sensors{'temp-unit'} = set_temp_unit($sensors{'temp-unit'},$working_unit) if $working_unit;
+ }
+ # Platform Control Hub (PCH), it is the X370 chip on the Crosshair VI Hero.
+ # VRM: voltage regulator module
+ # NOTE: CPU0_TEMP CPU1_TEMP is possible, unfortunately; CPU Temp Interf
+ elsif ( !$sensors{'cpu-temp'} && $row[$i_key] =~ /^CPU([01])?([\s_]Temp)?$/i) {
+ $b_cpu_0 = 1 if defined $1 && $1 == 0;
+ $sensors{'cpu-temp'} = int($row[$i_value]);
+ $working_unit = $row[$i_unit];
+ $working_unit =~ s/degrees\s// if $b_ipmitool;
+ $sensors{'temp-unit'} = set_temp_unit($sensors{'temp-unit'},$working_unit) if $working_unit;
+ }
+ elsif ($row[$i_key] =~ /^CPU([1-4])([\s_]Temp)?$/i) {
+ $temp_working = $1;
+ $temp_working++ if $b_cpu_0;
+ $sensors{"cpu${temp_working}-temp"} = int($row[$i_value]);
+ $working_unit = $row[$i_unit];
+ $working_unit =~ s/degrees\s// if $b_ipmitool;
+ $sensors{'temp-unit'} = set_temp_unit($sensors{'temp-unit'},$working_unit) if $working_unit;
+ }
+ # for temp1/2 only use temp1/2 if they are null or greater than the last ones
+ elsif ($row[$i_key] =~ /^(MB[_]?TEMP1|Temp[\s_]1)$/i) {
+ $temp_working = int($row[$i_value]);
+ $working_unit = $row[$i_unit];
+ $working_unit =~ s/degrees\s// if $b_ipmitool;
+ if ( !$sensors{'temp1'} || ( defined $temp_working && $temp_working > 0 ) ) {
+ $sensors{'temp1'} = $temp_working;
+ }
+ $sensors{'temp-unit'} = set_temp_unit($sensors{'temp-unit'},$working_unit) if $working_unit;
+ }
+ elsif ($row[$i_key] =~ /^(MB[_]?TEMP2|Temp[\s_]2)$/i) {
+ $temp_working = int($row[$i_value]);
+ $working_unit = $row[$i_unit];
+ $working_unit =~ s/degrees\s// if $b_ipmitool;
+ if ( !$sensors{'temp2'} || ( defined $temp_working && $temp_working > 0 ) ) {
+ $sensors{'temp2'} = $temp_working;
+ }
+ $sensors{'temp-unit'} = set_temp_unit($sensors{'temp-unit'},$working_unit) if $working_unit;
+ }
+ # temp3 is only used as an absolute override for systems with all 3 present
+ elsif ($row[$i_key] =~ /^(MB[_]?TEMP3|Temp[\s_]3)$/i) {
+ $temp_working = int($row[$i_value]);
+ $working_unit = $row[$i_unit];
+ $working_unit =~ s/degrees\s// if $b_ipmitool;
+ if ( !$sensors{'temp3'} || ( defined $temp_working && $temp_working > 0 ) ) {
+ $sensors{'temp3'} = $temp_working;
+ }
+ $sensors{'temp-unit'} = set_temp_unit($sensors{'temp-unit'},$working_unit) if $working_unit;
+ }
+ elsif (!$sensors{'sodimm-temp'} && $row[$i_key] =~ /^(DIMM-[0-9][A-Z]?)$/i){
+ $sensors{'sodimm-temp'} = int($row[$i_value]);
+ $working_unit = $row[$i_unit];
+ $working_unit =~ s/degrees\s// if $b_ipmitool;
+ $sensors{'temp-unit'} = set_temp_unit($sensors{'temp-unit'},$working_unit) if $working_unit;
+ }
+ # note: can be cpu fan:, cpu fan speed:, etc.
+ elsif ($row[$i_key] =~ /^(CPU|Processor)[\s_]Fan/i) {
+ $sensors{'fan-main'} = () if !$sensors{'fan-main'};
+ $sensors{'fan-main'}[1] = int($row[$i_value]);
+ }
+ # note that the counters are dynamically set for fan numbers here
+ # otherwise you could overwrite eg aux fan2 with case fan2 in theory
+ # note: cpu/mobo/ps are 1/2/3
+ elsif ($row[$i_key] =~ /^(SYS[\s_])?FAN[\s_]?([0-9A-F]+)/i) {
+ $sys_fan_nu = hex($2);
+ next if $row[$i_value] !~ /^[0-9\.]+$/;
+ $fan_working = int($row[$i_value]);
+ $sensors{'fan-default'} = () if !$sensors{'fan-default'};
+ if ( $sys_fan_nu =~ /^([0-9]+)$/ ) {
+ # add to array if array index does not exist OR if number is > existing number
+ if ( defined $sensors{'fan-default'}[$sys_fan_nu] ) {
+ if ( $fan_working >= $sensors{'fan-default'}[$sys_fan_nu] ) {
+ $sensors{'fan-default'}[$sys_fan_nu] = $fan_working;
+ }
+ }
+ else {
+ $sensors{'fan-default'}[$sys_fan_nu] = $fan_working;
+ }
+ }
+ }
+ elsif ($row[$i_key] =~ /^(FAN PSU|PSU FAN)$/i) {
+ $sensors{'fan-psu'} = int($row[$i_value]);
+ }
+ elsif ($row[$i_key] =~ /^(FAN PSU1|PSU1 FAN)$/i) {
+ $sensors{'fan-psu-1'} = int($row[$i_value]);
+ }
+ elsif ($row[$i_key] =~ /^(FAN PSU2|PSU2 FAN)$/i) {
+ $sensors{'fan-psu-2'} = int($row[$i_value]);
+ }
+ if ($extra > 0){
+ if ($row[$i_key] =~ /^(MAIN\s|P[_]?)?12V$/i) {
+ $sensors{'volts-12'} = $row[$i_value];
+ }
+ elsif ($row[$i_key] =~ /^(MAIN\s5V|P5V|5VCC|5V PG)$/i) {
+ $sensors{'volts-5'} = $row[$i_value];
+ }
+ elsif ($row[$i_key] =~ /^(MAIN\s3.3V|P3V3|3.3VCC|3.3V PG)$/i) {
+ $sensors{'volts-3.3'} = $row[$i_value];
+ }
+ elsif ($row[$i_key] =~ /^((P_)?VBAT|CMOS Battery|BATT 3.0V)$/i) {
+ $sensors{'volts-vbat'} = $row[$i_value];
+ }
+ # NOTE: VDimmP1ABC VDimmP1DEF
+ elsif (!$sensors{'volts-dimm-p1'} && $row[$i_key] =~ /^(P1_VMEM|VDimmP1|MEM RSR A PG)/i) {
+ $sensors{'volts-dimm-p1'} = $row[$i_value];
+ }
+ elsif (! $sensors{'volts-dimm-p2'} && $row[$i_key] =~ /^(P2_VMEM|VDimmP2|MEM RSR B PG)/i) {
+ $sensors{'volts-dimm-p2'} = $row[$i_value];
+ }
+ elsif (!$sensors{'volts-soc-p1'} && $row[$i_key] =~ /^(P1_SOC_RUN$)/i) {
+ $sensors{'volts-soc-p1'} = $row[$i_value];
+ }
+ elsif (! $sensors{'volts-soc-p2'} && $row[$i_key] =~ /^(P2_SOC_RUN$)/i) {
+ $sensors{'volts-soc-p2'} = $row[$i_value];
+ }
+ }
+ }
+ # print Data::Dumper::Dumper \%sensors;
+ %sensors = data_processor(%sensors) if %sensors;
+ main::log_data('dump','ipmi: %sensors',\%sensors) if $b_log;
+ eval $end if $b_log;
+ # print Data::Dumper::Dumper \%sensors;
+ return %sensors;
+}
+sub lm_sensors_data {
+ eval $start if $b_log;
+ my (%sensors);
+ my ($b_valid,$sys_fan_nu) = (0,0);
+ my ($adapter,$fan_working,$temp_working,$working_unit) = ('','','','');
+ @sensors_data = main::grabber(main::check_program('sensors') . " 2>/dev/null");
+ #my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/sensors/amdgpu-w-fan-speed-stretch-k10.txt";
+ #my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/sensors/peci-tin-geggo.txt";
+ #my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/sensors/sensors-w-other-biker.txt";
+ #my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/sensors/sensors-asus-chassis-1.txt";
+ #my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/sensors/sensors-devnull-1.txt";
+ #@sensors_data = main::reader($file);
+ #print @sensors_data;
+ @sensors_data = map {$_ =~ s/\s*:\s*\+?/:/;$_} @sensors_data;
+ foreach (@sensors_data){
+ # we get this from gpu_data()
+ if (/^(amdgpu|intel|nouveau|radeon|.*hwmon)-pci/){
+ $b_valid = 0;
+ $adapter = '';
+ next;
+ }
+ if (/^(?:(?!amdgpu|intel|nouveau|radeon|.*hwmon).)*-(isa|pci|virtual)-/){
+ $b_valid = 1;
+ $adapter = $1;
+ next;
+ }
+ next if !$b_valid;
+ my @working = split /:/, $_;
+ next if !$working[0] || /^Adapter/;
+ #print "$working[0]:$working[1]\n";
+ # There are some guesses here, but with more sensors samples it will get closer.
+ # note: using arrays starting at 1 for all fan arrays to make it easier overall
+ # we have to be sure we are working with the actual real string before assigning
+ # data to real variables and arrays. Extracting C/F degree unit as well to use
+ # when constructing temp items for array.
+ # note that because of charset issues, no "°" degree sign used, but it is required
+ # in testing regex to avoid error. It might be because I got that data from a forum post,
+ # note directly via debugger.
+ if ($_ =~ /^(AMBIENT|M\/B|MB|SIO|SYS).*:([0-9\.]+)[\s°]*(C|F)/i) {
+ $sensors{'mobo-temp'} = $2;
+ $working_unit = $3;
+ $sensors{'temp-unit'} = set_temp_unit($sensors{'temp-unit'},$working_unit) if $working_unit;
+ }
+ # issue 58 msi/asus show wrong for CPUTIN so overwrite it if PECI 0 is present
+ # http://www.spinics.net/lists/lm-sensors/msg37308.html
+ # NOTE: had: ^CPU.*\+([0-9]+): but that misses: CPUTIN and anything not with + in starter
+ # However, "CPUTIN is not a reliable measurement because it measures difference to Tjmax,
+ # which is the maximum CPU temperature reported as critical temperature by coretemp"
+ # NOTE: I've seen an inexplicable case where: CPU:52.0°C fails to match with [\s°] but
+ # does match with: [\s°]*. I can't account for this, but that's why the * is there
+ # Tdie is a new k10temp-pci syntax for cpu die temp
+ elsif ($_ =~ /^(CPU.*|Tdie.*):([0-9\.]+)[\s°]*(C|F)/i) {
+ $temp_working = $2;
+ $working_unit = $3;
+ if ( !$sensors{'cpu-temp'} ||
+ ( defined $temp_working && $temp_working > 0 && $temp_working > $sensors{'cpu-temp'} ) ) {
+ $sensors{'cpu-temp'} = $temp_working;
+ }
+ $sensors{'temp-unit'} = set_temp_unit($sensors{'temp-unit'},$working_unit) if $working_unit;
+ }
+ elsif ($_ =~ /^PECI\sAgent\s0.*:([0-9\.]+)[\s°]*(C|F)/i) {
+ $sensors{'cpu-peci-temp'} = $1;
+ $working_unit = $2;
+ $sensors{'temp-unit'} = set_temp_unit($sensors{'temp-unit'},$working_unit) if $working_unit;
+ }
+ elsif ($_ =~ /^(P\/S|Power).*:([0-9\.]+)[\s°]*(C|F)/i) {
+ $sensors{'psu-temp'} = $2;
+ $working_unit = $3;
+ $sensors{'temp-unit'} = set_temp_unit($sensors{'temp-unit'},$working_unit) if $working_unit;
+ }
+ elsif ($_ =~ /^SODIMM.*:([0-9\.]+)[\s°]*(C|F)/i) {
+ $sensors{'sodimm-temp'} = $1;
+ $working_unit = $2;
+ $sensors{'temp-unit'} = set_temp_unit($sensors{'temp-unit'},$working_unit) if $working_unit;
+ }
+ # for temp1/2 only use temp1/2 if they are null or greater than the last ones
+ elsif ($_ =~ /^temp1:([0-9\.]+)[\s°]*(C|F)/i) {
+ $temp_working = $1;
+ $working_unit = $2;
+ if ( !$sensors{'temp1'} ||
+ ( defined $temp_working && $temp_working > 0 && $temp_working > $sensors{'temp1'} ) ) {
+ $sensors{'temp1'} = $temp_working;
+ }
+ $sensors{'temp-unit'} = set_temp_unit($sensors{'temp-unit'},$working_unit) if $working_unit;
+ }
+ elsif ($_ =~ /^temp2:([0-9\.]+)[\s°]*(C|F)/i) {
+ $temp_working = $1;
+ $working_unit = $2;
+ if ( !$sensors{'temp2'} ||
+ ( defined $temp_working && $temp_working > 0 && $temp_working > $sensors{'temp2'} ) ) {
+ $sensors{'temp2'} = $temp_working;
+ }
+ $sensors{'temp-unit'} = set_temp_unit($sensors{'temp-unit'},$working_unit) if $working_unit;
+ }
+ # temp3 is only used as an absolute override for systems with all 3 present
+ elsif ($_ =~ /^temp3:([0-9\.]+)[\s°]*(C|F)/i) {
+ $temp_working = $1;
+ $working_unit = $2;
+ if ( !$sensors{'temp3'} ||
+ ( defined $temp_working && $temp_working > 0 && $temp_working > $sensors{'temp3'} ) ) {
+ $sensors{'temp3'} = $temp_working;
+ }
+ $sensors{'temp-unit'} = set_temp_unit($sensors{'temp-unit'},$working_unit) if $working_unit;
+ }
+ # final fallback if all else fails, funtoo user showed sensors putting
+ # temp on wrapped second line, not handled
+ elsif ($_ =~ /^(core0|core 0|Physical id 0)(.*):([0-9\.]+)[\s°]*(C|F)/i) {
+ $temp_working = $3;
+ $working_unit = $4;
+ if ( !$sensors{'core-0-temp'} ||
+ ( defined $temp_working && $temp_working > 0 && $temp_working > $sensors{'core-0-temp'} ) ) {
+ $sensors{'core-0-temp'} = $temp_working;
+ }
+ $sensors{'temp-unit'} = set_temp_unit($sensors{'temp-unit'},$working_unit) if $working_unit;
+ }
+ # note: can be cpu fan:, cpu fan speed:, etc.
+ elsif (!$sensors{'fan-main'}[1] && $_ =~ /^(CPU|Processor).*:([0-9]+)[\s]RPM/i) {
+ $sensors{'fan-main'} = () if !$sensors{'fan-main'};
+ $sensors{'fan-main'}[1] = $2;
+ }
+ elsif (!$sensors{'fan-main'}[2] && $_ =~ /^(M\/B|MB|SYS).*:([0-9]+)[\s]RPM/i) {
+ $sensors{'fan-main'} = () if !$sensors{'fan-main'};
+ $sensors{'fan-main'}[2] = $2;
+ }
+ elsif (!$sensors{'fan-main'}[3] && $_ =~ /(Power|P\/S|POWER).*:([0-9]+)[\s]RPM/i) {
+ $sensors{'fan-main'} = () if !$sensors{'fan-main'};
+ $sensors{'fan-main'}[3] = $2;
+ }
+ elsif (!$sensors{'fan-main'}[4] && $_ =~ /(SODIMM).*:([0-9]+)[\s]RPM/i) {
+ $sensors{'fan-main'} = () if !$sensors{'fan-main'};
+ $sensors{'fan-main'}[4] = $2;
+ }
+ # note that the counters are dynamically set for fan numbers here
+ # otherwise you could overwrite eg aux fan2 with case fan2 in theory
+ # note: cpu/mobo/ps/sodimm are 1/2/3/4
+ elsif ($_ =~ /^(AUX|CASE|CHASSIS).*:([0-9]+)[\s]RPM/i) {
+ $temp_working = $2;
+ $sensors{'fan-main'} = () if !$sensors{'fan-main'};
+ for ( my $i = 5; $i < 30; $i++ ){
+ next if defined $sensors{'fan-main'}[$i];
+ if ( !defined $sensors{'fan-main'}[$i] ){
+ $sensors{'fan-main'}[$i] = $temp_working;
+ last;
+ }
+ }
+ }
+ # in rare cases syntax is like: fan1: xxx RPM
+ elsif ($_ =~ /^FAN(1)?:([0-9]+)[\s]RPM/i) {
+ $sensors{'fan-default'} = () if !$sensors{'fan-default'};
+ $sensors{'fan-default'}[1] = $2;
+ }
+ elsif ($_ =~ /^FAN([2-9]|1[0-9]).*:([0-9]+)[\s]RPM/i) {
+ $fan_working = $2;
+ $sys_fan_nu = $1;
+ $sensors{'fan-default'} = () if !$sensors{'fan-default'};
+ if ( $sys_fan_nu =~ /^([0-9]+)$/ ) {
+ # add to array if array index does not exist OR if number is > existing number
+ if ( defined $sensors{'fan-default'}[$sys_fan_nu] ) {
+ if ( $fan_working >= $sensors{'fan-default'}[$sys_fan_nu] ) {
+ $sensors{'fan-default'}[$sys_fan_nu] = $fan_working;
+ }
+ }
+ else {
+ $sensors{'fan-default'}[$sys_fan_nu] = $fan_working;
+ }
+ }
+ }
+ if ($extra > 0){
+ if ($_ =~ /^[+]?(12 Volt|12V).*:([0-9\.]+)\sV/i) {
+ $sensors{'volts-12'} = $2;
+ }
+ # note: 5VSB is a field name
+ elsif ($_ =~ /^[+]?(5 Volt|5V):([0-9\.]+)\sV/i) {
+ $sensors{'volts-5'} = $2;
+ }
+ elsif ($_ =~ /^[+]?(3\.3 Volt|3\.3V).*:([0-9\.]+)\sV/i) {
+ $sensors{'volts-3.3'} = $2;
+ }
+ elsif ($_ =~ /^(Vbat).*:([0-9\.]+)\sV/i) {
+ $sensors{'volts-vbat'} = $2;
+ }
+ }
+ }
+ # print Data::Dumper::Dumper \%sensors;
+ %sensors = data_processor(%sensors) if %sensors;
+ main::log_data('dump','lm-sensors: %sensors',\%sensors) if $b_log;
+ # print Data::Dumper::Dumper \%sensors;
+ eval $end if $b_log;
+ return %sensors;
+}
+
+# oddly, openbsd sysctl actually has hw.sensors data!
+sub sysctl_data {
+ eval $start if $b_log;
+ my (@data,%sensors);
+ foreach (@sysctl_sensors){
+ if (/^hw.sensors\.([0-9a-z]+)\.(temp|fan|volt)([0-9])/){
+ my $sensor = $1;
+ my $type = $2;
+ my $number = $3;
+ my @working = split /:/, $_;
+ }
+ last if /^(hw.cpuspeed|hw.vendor|hw.physmem)/;
+ }
+
+ %sensors = data_processor(%sensors) if %sensors;
+ main::log_data('dump','%sensors',\%sensors) if $b_log;
+ # print Data::Dumper::Dumper \%sensors;
+ eval $end if $b_log;
+ return %sensors;
+}
+sub set_temp_unit {
+ my ($sensors,$working) = @_;
+ my $return_unit = '';
+
+ if ( !$sensors && $working ){
+ $return_unit = $working;
+ }
+ elsif ($sensors){
+ $return_unit = $sensors;
+ }
+ return $return_unit;
+}
+
+sub data_processor {
+ eval $start if $b_log;
+ my (%sensors) = @_;
+ my ($cpu_temp,$cpu2_temp,$cpu3_temp,$cpu4_temp,$index_count_fan_default,
+ $index_count_fan_main,$mobo_temp,$psu_temp) = (0,0,0,0,0,0,0,0);
+ my ($fan_type,$i,$j) = (0,0,0);
+ my $temp_diff = 20; # for C, handled for F after that is determined
+ my (@fan_main,@fan_default);
+ # first we need to handle the case where we have to determine which temp/fan to use for cpu and mobo:
+ # note, for rare cases of weird cool cpus, user can override in their prefs and force the assignment
+ # this is wrong for systems with > 2 tempX readings, but the logic is too complex with 3 variables
+ # so have to accept that it will be wrong in some cases, particularly for motherboard temp readings.
+ if ( $sensors{'temp1'} && $sensors{'temp2'} ){
+ if ( $sensors_cpu_nu ) {
+ $fan_type = $sensors_cpu_nu;
+ }
+ else {
+ # first some fringe cases with cooler cpu than mobo: assume which is cpu temp based on fan speed
+ # but only if other fan speed is 0.
+ if ( $sensors{'temp1'} >= $sensors{'temp2'} &&
+ defined $fan_default[1] && defined $fan_default[2] && $fan_default[1] == 0 && $fan_default[2] > 0 ) {
+ $fan_type = 2;
+ }
+ elsif ( $sensors{'temp2'} >= $sensors{'temp1'} &&
+ defined $fan_default[1] && defined $fan_default[2] && $fan_default[2] == 0 && $fan_default[1] > 0 ) {
+ $fan_type = 1;
+ }
+ # then handle the standard case if these fringe cases are false
+ elsif ( $sensors{'temp1'} >= $sensors{'temp2'} ) {
+ $fan_type = 1;
+ }
+ else {
+ $fan_type = 2;
+ }
+ }
+ }
+ # need a case for no temps at all reported, like with old intels
+ elsif ( !$sensors{'temp2'} && !$sensors{'cpu-temp'} ){
+ if ( !$sensors{'temp1'} && !$sensors{'mobo-temp'} ){
+ $fan_type = 1;
+ }
+ elsif ( $sensors{'temp1'} && !$sensors{'mobo-temp'} ){
+ $fan_type = 1;
+ }
+ elsif ( $sensors{'temp1'} && $sensors{'mobo-temp'} ){
+ $fan_type = 1;
+ }
+ }
+ # convert the diff number for F, it needs to be bigger that is
+ if ( $sensors{'temp-unit'} && $sensors{'temp-unit'} eq "F" ) {
+ $temp_diff = $temp_diff * 1.8
+ }
+ if ( $sensors{'cpu-temp'} ) {
+ # specific hack to handle broken CPUTIN temps with PECI
+ if ( $sensors{'cpu-peci-temp'} && ( $sensors{'cpu-temp'} - $sensors{'cpu-peci-temp'} ) > $temp_diff ){
+ $cpu_temp = $sensors{'cpu-peci-temp'};
+ }
+ # then get the real cpu temp, best guess is hottest is real, though only within narrowed diff range
+ else {
+ $cpu_temp = $sensors{'cpu-temp'};
+ }
+ }
+ else {
+ if ($fan_type ){
+ # there are some weird scenarios
+ if ( $fan_type == 1 ){
+ if ( $sensors{'temp1'} && $sensors{'temp2'} && $sensors{'temp2'} > $sensors{'temp1'} ) {
+ $cpu_temp = $sensors{'temp2'};
+ }
+ else {
+ $cpu_temp = $sensors{'temp1'};
+ }
+ }
+ else {
+ if ( $sensors{'temp1'} && $sensors{'temp2'} && $sensors{'temp1'} > $sensors{'temp2'} ) {
+ $cpu_temp = $sensors{'temp1'};
+ }
+ else {
+ $cpu_temp = $sensors{'temp2'};
+ }
+ }
+ }
+ else {
+ $cpu_temp = $sensors{'temp1'}; # can be null, that is ok
+ }
+ if ( $cpu_temp ) {
+ # using $sensors{'temp3'} is just not reliable enough, more errors caused than fixed imo
+ #if ( $sensors{'temp3'} && $sensors{'temp3'} > $cpu_temp ) {
+ # $cpu_temp = $sensors{'temp3'};
+ #}
+ # there are some absurdly wrong $sensors{'temp1'}: acpitz-virtual-0 $sensors{'temp1'}: +13.8°C
+ if ( $sensors{'core-0-temp'} && ($sensors{'core-0-temp'} - $cpu_temp) > $temp_diff ) {
+ $cpu_temp = $sensors{'core-0-temp'};
+ }
+ }
+ }
+ # if all else fails, use core0/peci temp if present and cpu is null
+ if ( !$cpu_temp ) {
+ if ( $sensors{'core-0-temp'} ) {
+ $cpu_temp = $sensors{'core-0-temp'};
+ }
+ # note that peci temp is known to be colder than the actual system
+ # sometimes so it is the last fallback we want to use even though in theory
+ # it is more accurate, but fact suggests theory wrong.
+ elsif ( $sensors{'cpu-peci-temp'} ) {
+ $cpu_temp = $sensors{'cpu-peci-temp'};
+ }
+ }
+ # then the real mobo temp
+ if ( $sensors{'mobo-temp'} ){
+ $mobo_temp = $sensors{'mobo-temp'};
+ }
+ elsif ( $fan_type ){
+ if ( $fan_type == 1 ) {
+ if ( $sensors{'temp1'} && $sensors{'temp2'} && $sensors{'temp2'} > $sensors{'temp1'} ) {
+ $mobo_temp = $sensors{'temp1'};
+ }
+ else {
+ $mobo_temp = $sensors{'temp2'};
+ }
+ }
+ else {
+ if ( $sensors{'temp1'} && $sensors{'temp2'} && $sensors{'temp1'} > $sensors{'temp2'} ) {
+ $mobo_temp = $sensors{'temp2'};
+ }
+ else {
+ $mobo_temp = $sensors{'temp1'};
+ }
+ }
+ ## NOTE: not safe to assume $sensors{'temp3'} is the mobo temp, sad to say
+ #if ( $sensors{'temp1'} && $sensors{'temp2'} && $sensors{'temp3'} && $sensors{'temp3'} < $mobo_temp ) {
+ # $mobo_temp = $sensors{'temp3'};
+ #}
+ }
+ else {
+ $mobo_temp = $sensors{'temp2'};
+ }
+ @fan_main = @{$sensors{'fan-main'}} if $sensors{'fan-main'};
+ $index_count_fan_main = (@fan_main) ? scalar @fan_main : 0;
+ @fan_default = @{$sensors{'fan-default'}} if $sensors{'fan-default'};
+ $index_count_fan_default = (@fan_default) ? scalar @fan_default : 0;
+ # then set the cpu fan speed
+ if ( ! $fan_main[1] ) {
+ # note, you cannot test for $fan_default[1] or [2] != ""
+ # because that creates an array item in gawk just by the test itself
+ if ( $fan_type == 1 && defined $fan_default[1] ) {
+ $fan_main[1] = $fan_default[1];
+ $fan_default[1] = undef;
+ }
+ elsif ( $fan_type == 2 && defined $fan_default[2] ) {
+ $fan_main[1] = $fan_default[2];
+ $fan_default[2] = undef;
+ }
+ }
+ # clear out any duplicates. Primary fan real trumps fan working always if same speed
+ for ($i = 1; $i <= $index_count_fan_main; $i++) {
+ if ( defined $fan_main[$i] && $fan_main[$i] ) {
+ for ($j = 1; $j <= $index_count_fan_default; $j++) {
+ if ( defined $fan_default[$j] && $fan_main[$i] == $fan_default[$j] ) {
+ $fan_default[$j] = undef;
+ }
+ }
+ }
+ }
+ # now see if you can find the fast little mobo fan, > 5000 rpm and put it as mobo
+ # note that gawk is returning true for some test cases when $fan_default[j] < 5000
+ # which has to be a gawk bug, unless there is something really weird with arrays
+ # note: 500 > $fan_default[j] < 1000 is the exact trigger, and if you manually
+ # assign that value below, the > 5000 test works again, and a print of the value
+ # shows the proper value, so the corruption might be internal in awk.
+ # Note: gensub is the culprit I think, assigning type string for range 501-1000 but
+ # type integer for all others, this triggers true for >
+ for ($j = 1; $j <= $index_count_fan_default; $j++) {
+ if ( defined $fan_default[$j] && $fan_default[$j] > 5000 && !$fan_main[2] ) {
+ $fan_main[2] = $fan_default[$j];
+ $fan_default[$j] = '';
+ # then add one if required for output
+ if ( $index_count_fan_main < 2 ) {
+ $index_count_fan_main = 2;
+ }
+ }
+ }
+ # if they are ALL null, print error message. psFan is not used in output currently
+ if ( !$cpu_temp && !$mobo_temp && !$fan_main[1] && !$fan_main[2] && !$fan_main[1] && !@fan_default ) {
+ %sensors = ();
+ }
+ else {
+ my ($ambient_temp,$psu_fan,$psu1_fan,$psu2_fan,$psu_temp,$sodimm_temp,
+ $v_12,$v_5,$v_3_3,$v_dimm_p1,$v_dimm_p2,$v_soc_p1,$v_soc_p2,$v_vbat);
+ $psu_temp = $sensors{'psu-temp'} if $sensors{'psu-temp'};
+ # sodimm fan is fan_main[4]
+ $sodimm_temp = $sensors{'sodimm-temp'} if $sensors{'sodimm-temp'};
+ $cpu2_temp = $sensors{'cpu2-temp'} if $sensors{'cpu2-temp'};
+ $cpu3_temp = $sensors{'cpu3-temp'} if $sensors{'cpu3-temp'};
+ $cpu4_temp = $sensors{'cpu4-temp'} if $sensors{'cpu4-temp'};
+ $ambient_temp = $sensors{'ambient-temp'} if $sensors{'ambient-temp'};
+ $psu_fan = $sensors{'fan-psu'} if $sensors{'fan-psu'};
+ $psu1_fan = $sensors{'fan-psu-1'} if $sensors{'fan-psu-1'};
+ $psu2_fan = $sensors{'fan-psu-2'} if $sensors{'fan-psu-2'};
+ # so far only for ipmi, sensors data is junk for volts
+ if ($extra > 0 &&
+ ($sensors{'volts-12'} || $sensors{'volts-5'} || $sensors{'volts-3.3'} || $sensors{'volts-vbat'}) ){
+ $v_12 = $sensors{'volts-12'} if $sensors{'volts-12'};
+ $v_5 = $sensors{'volts-5'} if $sensors{'volts-5'};
+ $v_3_3 = $sensors{'volts-3.3'} if $sensors{'volts-3.3'};
+ $v_vbat = $sensors{'volts-vbat'} if $sensors{'volts-vbat'};
+ $v_dimm_p1 = $sensors{'volts-dimm-p1'} if $sensors{'volts-dimm-p1'};
+ $v_dimm_p2 = $sensors{'volts-dimm-p2'} if $sensors{'volts-dimm-p2'};
+ $v_soc_p1 = $sensors{'volts-soc-p1'} if $sensors{'volts-soc-p1'};
+ $v_soc_p2 = $sensors{'volts-soc-p2'} if $sensors{'volts-soc-p2'};
+ }
+ %sensors = (
+ 'ambient-temp' => $ambient_temp,
+ 'cpu-temp' => $cpu_temp,
+ 'cpu2-temp' => $cpu2_temp,
+ 'cpu3-temp' => $cpu3_temp,
+ 'cpu4-temp' => $cpu4_temp,
+ 'mobo-temp' => $mobo_temp,
+ 'psu-temp' => $psu_temp,
+ 'temp-unit' => $sensors{'temp-unit'},
+ 'fan-main' => \@fan_main,
+ 'fan-default' => \@fan_default,
+ 'fan-psu' => $psu_fan,
+ 'fan-psu1' => $psu1_fan,
+ 'fan-psu2' => $psu2_fan,
+ );
+ if ($psu_temp){
+ $sensors{'psu-temp'} = $psu_temp;
+ }
+ if ($sodimm_temp){
+ $sensors{'sodimm-temp'} = $sodimm_temp;
+ }
+ if ($extra > 0 && ($v_12 || $v_5 || $v_3_3 || $v_vbat) ){
+ $sensors{'volts-12'} = $v_12;
+ $sensors{'volts-5'} = $v_5;
+ $sensors{'volts-3.3'} = $v_3_3;
+ $sensors{'volts-vbat'} = $v_vbat;
+ $sensors{'volts-dimm-p1'} = $v_dimm_p1;
+ $sensors{'volts-dimm-p2'} = $v_dimm_p2;
+ $sensors{'volts-soc-p1'} = $v_soc_p1;
+ $sensors{'volts-soc-p2'} = $v_soc_p2;
+ }
+ }
+ eval $end if $b_log;
+ return %sensors;
+}
+sub gpu_data {
+ eval $start if $b_log;
+ return @gpudata if $b_gpudata;
+ my ($cmd,@data,@data2,$path,@screens,$temp);
+ my ($j) = (0);
+ if ($path = main::check_program('nvidia-settings')){
+ # first get the number of screens. This only work if you are in X
+ if ($b_display) {
+ @data = main::grabber("$path -q screens 2>/dev/null");
+ foreach (@data){
+ if ( /(:[0-9]\.[0-9])/ ) {
+ push @screens, $1;
+ }
+ }
+ }
+ # do a guess, this will work for most users, it's better than nothing for out of X
+ else {
+ $screens[0] = ':0.0';
+ }
+ # now we'll get the gpu temp for each screen discovered. The print out function
+ # will handle removing screen data for single gpu systems. -t shows only data we want
+ # GPUCurrentClockFreqs: 520,600
+ # GPUCurrentFanSpeed: 50 0-100, not rpm, percent I think
+ # VideoRam: 1048576
+ # CUDACores: 16
+ # PCIECurrentLinkWidth: 16
+ # PCIECurrentLinkSpeed: 5000
+ # RefreshRate: 60.02 Hz [oer screen]
+ # ViewPortOut=1280x1024+0+0}, DPY-1: nvidia-auto-select @1280x1024 +1280+0 {ViewPortIn=1280x1024,
+ # ViewPortOut=1280x1024+0+0}
+ # ThermalSensorReading: 50
+ # PCIID: 4318,2661 - the pci stuff doesn't appear to work
+ # PCIBus: 2
+ # PCIDevice: 0
+ # Irq: 30
+ foreach my $screen (@screens){
+ my $screen2 = $screen;
+ $screen2 =~ s/\.[0-9]$//;
+ $cmd = '-q GPUCoreTemp -q VideoRam -q GPUCurrentClockFreqs -q PCIECurrentLinkWidth ';
+ $cmd .= '-q Irq -q PCIBus -q PCIDevice -q GPUCurrentFanSpeed';
+ $cmd = "$path -c $screen2 $cmd 2>/dev/null";
+ @data = main::grabber($cmd);
+ main::log_data('cmd',$cmd) if $b_log;
+ @data = (@data,@data2);
+ $j = scalar @gpudata;
+ $gpudata[$j] = ({});
+ foreach my $item (@data){
+ if ($item =~ /^\s*Attribute\s\'([^']+)\'\s.*:\s*([\S]+)\.$/){
+ my $attribute = $1;
+ my $value = $2;
+ $gpudata[$j]{'type'} = 'nvidia';
+ $gpudata[$j]{'speed-unit'} = '%';
+ $gpudata[$j]{'screen'} = $screen;
+ if (!$gpudata[$j]{'temp'} && $attribute eq 'GPUCoreTemp'){
+ $gpudata[$j]{'temp'} = $value;
+ }
+ elsif (!$gpudata[$j]{'ram'} && $attribute eq 'VideoRam'){
+ $gpudata[$j]{'ram'} = $value;
+ }
+ elsif (!$gpudata[$j]{'clock'} && $attribute eq 'GPUCurrentClockFreqs'){
+ $gpudata[$j]{'clock'} = $value;
+ }
+ elsif (!$gpudata[$j]{'bus'} && $attribute eq 'PCIBus'){
+ $gpudata[$j]{'bus'} = $value;
+ }
+ elsif (!$gpudata[$j]{'bus-id'} && $attribute eq 'PCIDevice'){
+ $gpudata[$j]{'bus-id'} = $value;
+ }
+ elsif (!$gpudata[$j]{'fan-speed'} && $attribute eq 'GPUCurrentFanSpeed'){
+ $gpudata[$j]{'fan-speed'} = $value;
+ }
+ }
+ }
+ }
+ }
+ if ($path = main::check_program('aticonfig')){
+ # aticonfig --adapter=0 --od-gettemperature
+ @data = main::grabber("$path --adapter=all --od-gettemperature 2>/dev/null");
+ foreach (@data){
+ if (/Sensor [^0-9]*([0-9\.]+) /){
+ $j = scalar @gpudata;
+ $gpudata[$j] = ({});
+ my $value = $1;
+ $gpudata[$j]{'type'} = 'amd';
+ $gpudata[$j]{'temp'} = $value;
+ }
+ }
+ }
+ if (@sensors_data){
+ my ($b_found,$holder) = (0,'');
+ foreach (@sensors_data){
+ next if (/^Adapter:/ || /^\s*$/);
+ if (/^(amdgpu|intel|nouveau|radeon)-pci-(.*)/){
+ $b_found = 1;
+ $holder = $1;
+ $j = scalar @gpudata;
+ }
+ if (/^(?:(?!amdgpu|.*hwmon|intel|nouveau|radeon).)*-(pci|virtual|isa)-(.*)/){
+ $b_found = 0;
+ $holder = '';
+ }
+ if ($b_found){
+ if (/^temp.*:([0-9]+).*(C|F)/){
+ $gpudata[$j]{'temp'} = $1;
+ $gpudata[$j]{'type'} = $holder;
+ $gpudata[$j]{'unit'} = $2;
+ }
+ if (/^fan.*:([0-9]+).*(RPM)?/){
+ $gpudata[$j]{'fan-speed'} = $1;
+ # NOTE: we test for nvidia %, everything else stays with nothing
+ $gpudata[$j]{'speed-unit'} = '';
+ }
+ main::log_data('dump','sensors output: video: @gpudata',\@gpudata);
+ }
+ }
+ }
+ # we'll probably use this data elsewhere so make it a one time call
+ $b_gpudata = 1;
+ # print Data::Dumper::Dumper \@gpudata;
+ eval $end if $b_log;
+ return @gpudata;
+}
+}
+
+## SlotData
+{
+package SlotData;
+
+sub get {
+ eval $start if $b_log;
+ my (@data,@rows,$key1,$val1);
+ my $num = 0;
+ my $ref = $alerts{'dmidecode'};
+ if ( $$ref{'action'} eq 'use' && (!$b_arm || $b_slot_tool )){
+ @rows = slot_data();
+ }
+ elsif ($b_arm && !$b_slot_tool){
+ $key1 = 'ARM';
+ $val1 = main::row_defaults('arm-pci','');
+ @rows = ({main::key($num++,$key1) => $val1,});
+ }
+ elsif ( $$ref{'action'} ne 'use'){
+ $key1 = $$ref{'action'};
+ $val1 = $$ref{$key1};
+ $key1 = ucfirst($key1);
+ @rows = ({main::key($num++,$key1) => $val1,});
+ }
+ eval $end if $b_log;
+ return @rows;
+}
+sub slot_data {
+ eval $start if $b_log;
+ my (@data,@rows);
+ my $num = 0;
+ foreach (@dmi){
+ $num = 1;
+ my @ref = @$_;
+ if ($ref[0] == 9){
+ my ($designation,$id,$length,$type,$usage) = ('','','','','');
+ # skip first two row, we don't need that data
+ splice @ref, 0, 2 if @ref;
+ my $j = scalar @rows;
+ foreach my $item (@ref){
+ if ($item !~ /^~/){ # skip the indented rows
+ my @value = split /:\s+/, $item;
+ if ($value[0] eq 'Type'){
+ $type = $value[1];
+ }
+ if ($value[0] eq 'Designation'){
+ $designation = $value[1];
+ }
+ if ($value[0] eq 'Current Usage'){
+ $usage = $value[1];
+
+ }
+ if ($value[0] eq 'ID'){
+ $id = $value[1];
+ }
+ if ($extra > 1 && $value[0] eq 'Length'){
+ $length = $value[1];
+ }
+ }
+ }
+ if ($type){
+ $id = 'N/A' if ($id eq '' );
+ if ($type eq 'Other' && $designation){
+ $type = $designation;
+ }
+ elsif ($type && $designation) {
+ $type = "$type $designation";
+ }
+ @data = (
+ {
+ main::key($num++,'Slot') => $id,
+ main::key($num++,'type') => $type,
+ main::key($num++,'status') => $usage,
+ },
+ );
+ @rows = (@rows,@data);
+ if ($extra > 1 ){
+ $rows[$j]{main::key($num++,'length')} = $length;
+ }
+ }
+ }
+ }
+ if (!@rows){
+ my $key = 'Message';
+ @data = ({
+ main::key($num++,$key) => main::row_defaults('pci-slot-data',''),
+ },);
+ @rows = (@rows,@data);
+ }
+ eval $end if $b_log;
+ return @rows;
+}
+}
+
+## UnmountedData
+{
+package UnmountedData;
+
+sub get {
+ eval $start if $b_log;
+ my (@data,@rows,$key1,$val1);
+ my $num = 0;
+ if ($bsd_type){
+ $key1 = 'Message';
+ $val1 = main::row_defaults('unmounted-data-bsd');
+ }
+ else {
+ if (my $file = main::system_files('partitions')){
+ @data = unmounted_data($file);
+ if (!@data){
+ $key1 = 'Message';
+ $val1 = main::row_defaults('unmounted-data');
+ }
+ else {
+ @rows = create_output(@data);
+ }
+ }
+ else {
+ $key1 = 'Message';
+ $val1 = main::row_defaults('unmounted-file');
+ }
+ }
+ if (!@rows && $key1){
+ @rows = ({main::key($num++,$key1) => $val1,});
+ }
+ eval $end if $b_log;
+ return @rows;
+}
+sub create_output {
+ eval $start if $b_log;
+ my (@unmounted) = @_;
+ my (@data,@rows,$fs);
+ my $num = 0;
+ @unmounted = sort { $a->{'dev-base'} cmp $b->{'dev-base'} } @unmounted;
+ foreach my $ref (@unmounted){
+ my %row = %$ref;
+ $num = 1;
+ my @data2 = main::get_size($row{'size'}) if (defined $row{'size'});
+ my $size = (@data2) ? $data2[0] . ' ' . $data2[1]: 'N/A';
+ if ($row{'fs'}){
+ $fs = lc($row{'fs'});
+ }
+ else {
+ if (main::check_program('file')){
+ $fs = ($b_root) ? 'N/A' : main::row_defaults('root-required');
+ }
+ else {
+ $fs = 'requires file';
+ }
+ }
+ @data = ({
+ main::key($num++,'ID') => , "/dev/$row{'dev-base'}",
+ main::key($num++,'size') => , $size,
+ main::key($num++,'fs') => , $fs,
+ main::key($num++,'label') => , $row{'label'},
+ main::key($num++,'uuid') => , $row{'uuid'},
+ });
+ @rows = (@rows,@data);
+ }
+ eval $end if $b_log;
+ return @rows;
+}
+sub unmounted_data {
+ eval $start if $b_log;
+ my ($file) = @_;
+ my ($fs,$label,$size,$uuid,@data,%part,@unmounted);
+ my @mounted = ('scd[0-9]+','sr[0-9]+','cdrom[0-9]*','cdrw[0-9]*',
+ 'dvd[0-9]*','dvdrw[0-9]*','fd[0-9]','ram[0-9]*');
+ my @mounts = main::reader($file,'strip');
+ my $num = 0;
+ PartitionData::set_lsblk() if !$bsd_type && !$b_lsblk;
+ # set labels, uuid, gpart
+ PartitionData::partition_data() if !$b_partitions;
+ PartitionData::set_label_uuid() if !$b_label_uuid;
+ RaidData::raid_data() if !$b_raid;
+ @mounted = get_mounted(@mounted);
+ foreach (@mounts){
+ my @working = split /\s+/, $_;
+ ($fs,$label,$uuid,$size) = ('','','','');
+ # note that size 1 means it is a logical extended partition container
+ # lvm might have dm-1 type syntax
+ # need to exclude loop type file systems, squashfs for example
+ # NOTE: nvme needs special treatment because the main device is: nvme0n1
+ # note: $working[2] != 1 is wrong, it's not related
+ if ( $working[-1] !~ /^(nvme[0-9]+n|mmcblk|mtdblk|mtdblock)[0-9]+$/ &&
+ $working[-1] =~ /[a-z][0-9]+$|dm-[0-9]+$/ && $working[-1] !~ /loop/ &&
+ !(grep {$working[-1] =~ /$_/} @mounted)){
+ %part = PartitionData::check_lsblk($working[-1],0) if (@lsblk && $working[-1]);
+ if (%part){
+ $fs = $part{'fs'};
+ $label = $part{'label'};
+ $uuid = $part{'uuid'};
+ $size = $part{'size'} if $part{'size'} && !$working[2];
+ }
+ $size ||= $working[2];
+ $fs = unmounted_filesystem($working[-1]) if !$fs;
+ $label = PartitionData::get_label("/dev/$working[-1]") if !$label;
+ $uuid = PartitionData::get_uuid("/dev/$working[-1]") if !$uuid;
+ @data = ({
+ 'dev-base' => $working[-1],
+ 'fs' => $fs,
+ 'label' => $label,
+ 'size' => $size,
+ 'uuid' => $uuid,
+ });
+ @unmounted = (@unmounted,@data);
+ }
+ }
+ # print Data::Dumper::Dumper @unmounted;
+ main::log_data('dump','@unmounted',\@unmounted) if $b_log;
+ eval $end if $b_log;
+ return @unmounted;
+}
+sub get_mounted {
+ eval $start if $b_log;
+ my (@mounted) = @_;
+ foreach my $ref (@partitions){
+ my %row = %$ref;
+ push @mounted, $row{'dev-base'} if $row{'dev-base'};
+ }
+ foreach my $ref (@raid){
+ my %row = %$ref;
+ my $ref2 = $row{'arrays'};
+ # we want to not show md0 etc in unmounted report
+ push @mounted, $row{'id'} if $row{'id'};
+ my @arrays = (ref $ref2 eq 'ARRAY' ) ? @$ref2 : ();
+ @arrays = grep {defined $_} @arrays;
+ foreach my $array (@arrays){
+ my %row2 = %$array;
+ my $ref3 = $row2{'components'};
+ my @components = (ref $ref3 eq 'ARRAY') ? @$ref3 : ();
+ foreach my $component (@components){
+ my @temp = split /~/, $component;
+ push @mounted, $temp[0];
+ }
+ }
+ }
+ eval $end if $b_log;
+ return @mounted;
+}
+sub unmounted_filesystem {
+ eval $start if $b_log;
+ my ($item) = @_;
+ my ($data,%part);
+ my ($file,$fs,$path) = ('','','');
+ if ($path = main::check_program('file')) {
+ $file = $path;
+ }
+ # order matters in this test!
+ my @filesystems = ('ext2','ext3','ext4','ext5','ext','ntfs',
+ 'fat32','fat16','FAT\s\(.*\)','vfat','fatx','tfat','swap','btrfs',
+ 'ffs','hammer','hfs\+','hfs\splus','hfs\sextended\sversion\s[1-9]','hfsj',
+ 'hfs','jfs','nss','reiserfs','reiser4','ufs2','ufs','xfs','zfs');
+ if ($file){
+ # this will fail if regular user and no sudo present, but that's fine, it will just return null
+ # note the hack that simply slices out the first line if > 1 items found in string
+ # also, if grub/lilo is on partition boot sector, no file system data is available
+ $data = (main::grabber("$sudo$file -s /dev/$item 2>/dev/null"))[0];
+ if ($data){
+ foreach (@filesystems){
+ if ($data =~ /($_)[\s,]/i){
+ $fs = $1;
+ $fs = main::trimmer($fs);
+ last;
+ }
+ }
+ }
+ }
+ main::log_data('data',"fs: $fs") if $b_log;
+ eval $end if $b_log;
+ return $fs;
+}
+}
+
+## UsbData
+{
+package UsbData;
+
+sub get {
+ eval $start if $b_log;
+ my (@data,@rows,$key1,$val1);
+ my $num = 0;
+ my $ref = $alerts{'lsusb'};
+ my $ref2 = $alerts{'usbdevs'};
+ if ( $$ref{'action'} ne 'use' && $$ref2{'action'} ne 'use'){
+ if ($os eq 'linux' ){
+ $key1 = $$ref{'action'};
+ $val1 = $$ref{$key1};
+ }
+ else {
+ $key1 = $$ref2{'action'};
+ $val1 = $$ref2{$key1};
+ }
+ $key1 = ucfirst($key1);
+ @rows = ({main::key($num++,$key1) => $val1,});
+ }
+ else {
+ @rows = usb_data();
+ if (!@rows){
+ my $key = 'Message';
+ @data = ({
+ main::key($num++,$key) => main::row_defaults('usb-data',''),
+ },);
+ @rows = (@rows,@data);
+ }
+ }
+ eval $end if $b_log;
+ return @rows;
+}
+sub usb_data {
+ eval $start if $b_log;
+ return if ! @usb;
+ my (@data,@row,@rows,$bus_id,$chip_id,$speed,$protocol,$class,$vendor,$product);
+ my $num = 0;
+ my $j = 0;
+ # note: the data has been presorted in set_lsusb_data by:
+ # bus id then device id, so we don't need to worry about the order
+ foreach my $ref (@usb){
+ my @id = @$ref;
+ $j = scalar @rows;
+ $num = 1;
+ $bus_id = "$id[0]:$id[1]";
+ $chip_id = $id[2];
+ my $b_hub = 0;
+ # it's a hub
+ if ($id[1] == 1){
+ foreach my $line (@id){
+ #print "$line\n";
+ @row = split /:/, $line;
+ next if ! defined $row[0];
+ if ($row[0] eq 'bcdUSB' && defined $row[1]){
+ $speed = ($row[1] =~ /^[0-9,\.]+$/) ? sprintf("%1.1f",$row[1]) : $row[1];
+ }
+ elsif ($row[0] eq '~bInterfaceProtocol' && $row[2] ){
+ $protocol = $row[2];
+ }
+ }
+ $protocol ||= 'N/A';
+ $speed ||= 'N/A';
+ #print "pt0:$protocol\n";
+ @data = ({
+ main::key($num++,'Hub') => $bus_id,
+ main::key($num++,'usb') => $speed,
+ main::key($num++,'type') => $protocol,
+ },);
+ @rows = (@rows,@data);
+ if ($extra > 1){
+ $rows[$j]{main::key($num++,'chip ID')} = $chip_id;
+ }
+ }
+ # it's a device
+ else {
+ ($class,$product,$protocol,$vendor,$speed) = ('','','','','');
+ foreach my $line (@id){
+ @row = split /:/, $line;
+ next if ! defined $row[0];
+ if ($row[0] eq 'bcdUSB' && defined $row[1]){
+ $speed = sprintf("%.1f",$row[1]);
+ }
+ elsif ($row[0] eq 'bDeviceClass' && defined $row[1] && $row[1] == 9){
+ $b_hub = 1;
+ }
+ elsif ($row[0] eq 'idVendor' && $row[2]){
+ $vendor = main::cleaner($row[2]);
+ }
+ elsif ($row[0] eq 'idProduct' && $row[2]){
+ $product = main::cleaner($row[2]);
+ }
+ # we want hubs to cascade to last item
+ elsif ($row[0] eq '~bInterfaceClass' && $row[2] && defined $row[1] && $row[1] != 9){
+ $class = main::cleaner($row[2]);
+ }
+ elsif ($row[0] eq '~bInterfaceProtocol' && defined $row[2]){
+ $protocol = $row[2];
+ $protocol =~ s/none//i if $protocol;
+ last if $class;
+ }
+ }
+ if ( $b_hub ){
+ if ($vendor && $product){
+ $protocol = "$vendor $product";
+ }
+ elsif (!$product && $protocol && $vendor){
+ $protocol = "$vendor $protocol";
+ }
+ $speed ||= 'N/A';
+ $protocol ||= 'N/A';
+ #print "pt2:$protocol\n";
+ @data = ({
+ main::key($num++,'Hub') => $bus_id,
+ main::key($num++,'usb') => $speed,
+ main::key($num++,'type') => $protocol,
+ },);
+ @rows = (@rows,@data);
+ }
+ else {
+ if ($vendor && $product){
+ if ($product !~ /$vendor/){
+ $product = "$vendor $product";
+ }
+ }
+ elsif (!$product && !$vendor && $protocol){
+ $product = $protocol;
+ }
+ elsif (!$product){
+ $product = $vendor;
+ }
+ # bInterfaceProtocol:0 but $row[2] undefined
+ #print "pt3:$class:$product\n";
+ # for we want Mass Storage Device instead of Bulk-Only
+ # we want to filter out certain protocol values that are less
+ # informative than the class type.
+ if ($protocol && $class && $class ne $protocol && protocol_filter($protocol) ){
+ $class = $protocol;
+ }
+ $class ||= 'N/A';
+ #print "pt3:$class:$product\n";
+ $product ||= 'N/A';
+ $speed ||= 'N/A';
+ $rows[$j]{main::key($num++,'Device')} = $product;
+ $rows[$j]{main::key($num++,'bus ID')} = $bus_id;
+ if ($extra > 0){
+ $rows[$j]{main::key($num++,'usb')} = $speed;
+ }
+ $rows[$j]{main::key($num++,'type')} = $class;
+ }
+ if ($extra > 1){
+ $rows[$j]{main::key($num++,'chip ID')} = $chip_id;
+ }
+ }
+ }
+ #print Data::Dumper::Dumper \@rows;
+ eval $end if $b_log;
+ return @rows;
+}
+sub protocol_filter {
+ eval $start if $b_log;
+ my ($string) = @_;
+ $string =~ s/Bulk-Only|streaming|Bidirectional|None//i if $string;
+ eval $end if $b_log;
+ return $string;
+}
+}
+
+## add metric / imperial (us) switch
+## WeatherData
+{
+package WeatherData;
+
+sub get {
+ eval $start if $b_log;
+ my (@rows,$key1,$val1);
+ my $num = 0;
+ @rows = create_output();
+ eval $end if $b_log;
+ return @rows;
+}
+sub create_output {
+ eval $start if $b_log;
+ my $num = 0;
+ my (@data,@location,@rows,%weather,);
+ my ($conditions) = ('NA');
+ if ($show{'weather-location'}){
+ my $location_string;
+ $location_string = $show{'weather-location'};
+ $location_string =~ s/\+/ /g;
+ if ( $location_string =~ /,/){
+ my @temp = split /,/, $location_string;
+ my $sep = '';
+ my $string = '';
+ foreach (@temp){
+ $_ = ucfirst($_);
+ $string .= $sep . $_;
+ $sep = ', ';
+ }
+ $location_string = $string;
+ }
+ $location_string = main::apply_filter($location_string);
+ @location = ($show{'weather-location'},$location_string,'');
+ }
+ else {
+ @location = get_location();
+ if (!$location[0]) {
+ return @rows = ({
+ main::key($num++,'Message') => main::row_defaults('weather-null','current location'),
+ });
+ }
+ }
+ %weather = get_weather(@location);
+ if (!$weather{'weather'}) {
+ return @rows = ({
+ main::key($num++,'Message') => main::row_defaults('weather-null','weather data'),
+ });
+ }
+ $conditions = "$weather{'weather'}";
+ my $temp = unit_output($weather{'temp'},$weather{'temp-c'},'C',$weather{'temp-f'},'F');
+ @data = ({
+ main::key($num++,'Temperature') => $temp,
+ main::key($num++,'Conditions') => $conditions,
+ },);
+ @rows = (@rows,@data);
+ if ($extra > 0){
+ my $pressure = unit_output($weather{'pressure'},$weather{'pressure-mb'},'mb',$weather{'pressure-in'},'in');
+ my $wind = wind_output($weather{'wind'},$weather{'wind-direction'},$weather{'wind-mph'},$weather{'wind-ms'},
+ $weather{'wind-gust-mph'},$weather{'wind-gust-ms'});
+ $rows[0]{main::key($num++,'Wind')} = $wind;
+ $rows[0]{main::key($num++,'Humidity')} = $weather{'humidity'};
+ $rows[0]{main::key($num++,'Pressure')} = $pressure;
+ }
+ if ($extra > 1){
+ if ($weather{'heat-index'}){
+ my $heat = unit_output($weather{'heat-index'},$weather{'heat-index-c'},'C',$weather{'heat-index-f'},'F');
+ $rows[0]{main::key($num++,'Heat Index')} = $heat;
+ }
+ if ($weather{'windchill'}){
+ my $chill = unit_output($weather{'windchill'},$weather{'windchill-c'},'C',$weather{'windchill-f'},'F');
+ $rows[0]{main::key($num++,'Wind Chill')} = $chill ;
+ }
+ if ($weather{'dewpoint'}){
+ my $dew = unit_output($weather{'dewpoint'},$weather{'dewpoint-c'},'C',$weather{'dewpoint-f'},'F');
+ $rows[0]{main::key($num++,'Dew Point')} = $dew;
+ }
+ }
+ if ($extra > 2){
+ if (!$show{'filter'}){
+ $rows[0]{main::key($num++,'Location')} = $location[1];
+ $rows[0]{main::key($num++,'altitude')} = elevation_output($weather{'elevation-m'},$weather{'elevation-ft'});
+ }
+ }
+ $rows[0]{main::key($num++,'Current Time')} = $weather{'date-time'};
+ if ($extra > 2){
+ $rows[0]{main::key($num++,'Observation Time')} = $weather{'observation-time-local'};
+ }
+ eval $end if $b_log;
+ return @rows;
+}
+sub elevation_output {
+ eval $start if $b_log;
+ my ($meters,$feet) = @_;
+ my ($result,$i_unit,$m_unit) = ('','ft','m');
+ $feet = sprintf("%.0f", 3.28 * $meters) if defined $meters && !$feet;
+ $meters = sprintf("%.1f", $feet / 3.28 ) if defined $feet && !$meters;
+ $meters = sprintf("%.0f", $meters) if $meters;
+ if ( defined $meters && $weather_unit eq 'mi' ){
+ $result = "$meters $m_unit ($feet $i_unit)";
+ }
+ elsif (defined $meters && $weather_unit eq 'im' ){
+ $result = "$feet $i_unit ($meters $m_unit)";
+ }
+ elsif (defined $meters && $weather_unit eq 'm' ){
+ $result = "$meters $m_unit";
+ }
+ elsif (defined $feet && $weather_unit eq 'i' ){
+ $result = "$feet $i_unit";
+ }
+ else {
+ $result = 'N/A';
+ }
+ eval $end if $b_log;
+ return $result;
+}
+sub unit_output {
+ eval $start if $b_log;
+ my ($primary,$metric,$m_unit,$imperial,$i_unit) = @_;
+ my $result = '';
+ if ($metric && $imperial && $weather_unit eq 'mi' ){
+ $result = "$metric $m_unit ($imperial $i_unit)";
+ }
+ elsif ($metric && $imperial && $weather_unit eq 'im' ){
+ $result = "$imperial $i_unit ($metric $m_unit)";
+ }
+ elsif ($metric && $weather_unit eq 'm' ){
+ $result = "$metric $m_unit";
+ }
+ elsif ($imperial && $weather_unit eq 'i' ){
+ $result = "$imperial $i_unit";
+ }
+ elsif ($primary){
+ $result = $primary;
+ }
+ else {
+ $result = 'N/A';
+ }
+ eval $end if $b_log;
+ return $result;
+}
+sub wind_output {
+ eval $start if $b_log;
+ my ($primary,$direction,$mph,$ms,$gust_mph,$gust_ms) = @_;
+ my ($result,$gust_kmh,$kmh,$i_unit,$m_unit,$km_unit) = ('','','','mph','m/s','km/h');
+ # get rid of possible gust values if they are the same as wind values
+ $gust_mph = undef if $gust_mph && $mph && $mph eq $gust_mph;
+ $gust_ms = undef if $gust_ms && $ms && $ms eq $gust_ms;
+ # calculate and round, order matters so that rounding only happens after math done
+ $ms = 0.44704 * $mph if $mph && !$ms;
+ $mph = $ms * 2.23694 if $ms && !$mph;
+ $kmh = sprintf("%.0f", 18 * $ms / 5) if $ms;
+ $ms = sprintf("%.1f", $ms ) if $ms; # very low mph speeds yield 0, which is wrong
+ $mph = sprintf("%.0f", $mph) if $mph;
+ $gust_ms = 0.44704 * $gust_mph if $gust_mph && !$gust_ms;
+ $gust_kmh = 18 * $gust_ms / 5 if $gust_ms;
+ $gust_mph = $gust_ms * 2.23694 if $gust_ms && !$gust_mph;
+ $gust_mph = sprintf("%.0f", $gust_mph) if $gust_mph;
+ $gust_kmh = sprintf("%.0f", $gust_kmh) if $gust_kmh;
+ $gust_ms = sprintf("%.0f", $gust_ms ) if $gust_ms;
+ if (!$mph && $primary){
+ $result = $primary;
+ }
+ elsif ($mph && $direction ){
+ if ( $weather_unit eq 'mi' ){
+ $result = "from $direction at $ms $m_unit ($kmh $km_unit, $mph $i_unit)";
+ }
+ elsif ( $weather_unit eq 'im' ){
+ $result = "from $direction at $mph $i_unit ($ms $m_unit, $kmh $km_unit)";
+ }
+ elsif ( $weather_unit eq 'm' ){
+ $result = "from $direction at $ms $m_unit ($kmh $km_unit)";
+ }
+ elsif ( $weather_unit eq 'i' ){
+ $result = "from $direction at $mph $i_unit";
+ }
+ if ($gust_mph){
+ if ( $weather_unit eq 'mi' ){
+ $result .= ". Gusting to $ms $m_unit ($kmh $km_unit, $mph $i_unit)";
+ }
+ elsif ( $weather_unit eq 'im' ){
+ $result .= ". Gusting to $mph $i_unit ($ms $m_unit, $kmh $km_unit)";
+ }
+ elsif ( $weather_unit eq 'm' ){
+ $result .= ". Gusting to $ms $m_unit ($kmh $km_unit)";
+ }
+ elsif ( $weather_unit eq 'i' ){
+ $result .= ". Gusting to $mph $i_unit";
+ }
+ }
+ }
+ elsif ($primary){
+ $result = $primary;
+ }
+ else {
+ $result = 'N/A';
+ }
+ eval $end if $b_log;
+ return $result;
+}
+sub get_weather {
+ eval $start if $b_log;
+ my (@location) = @_;
+ my $now = POSIX::strftime "%Y%m%d%H%M", localtime;
+ my ($date_time,$freshness,$tz,@weather_data,%weather);
+ my $loc_name = lc($location[0]);
+ $loc_name =~ s/-\/|\s|,/-/g;
+ $loc_name =~ s/--/-/g;
+ my $file_cached = "$user_data_dir/weather-$loc_name.txt";
+ if (-f $file_cached){
+ @weather_data = main::reader($file_cached);
+ $freshness = (split /\^\^/, $weather_data[0])[1];
+ #print "$now:$freshness\n";
+ }
+ if (!$freshness || $freshness < ($now - 90) ) {
+ @weather_data = (); # reset so we don't write the previous data to file!!
+ my $url = "http://api.wunderground.com/auto/wui/geo/WXCurrentObXML/index.xml?query=$location[0]";
+ my $temp;
+# {
+# #my $file2 = "$ENV{'HOME'}/bin/scripts/inxi/data/weather/weather-1.xml";
+# # my $file2 = "$ENV{'HOME'}/bin/scripts/inxi/data/weather/feed-oslo-1.xml";
+# local $/;
+# my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/weather/weather-1.xml";
+# open my $fh, '<', $file or die "can't open $file: $!";
+# $temp = <$fh>;
+# }
+ $temp = main::download_file('stdout',$url);
+ $temp =~ s/\r|\n\n/\n/g;
+ my @weather_temp = split /\n/, $temp;
+ foreach (@weather_temp){
+ chomp $_;
+ $_ =~ s/<\/[^>]+>//;
+ $_ =~ s/.*icon.*|\r//g;
+ $_ =~ s/\s\s/ /g;
+ $_ =~ s/^\s+|\s+$//g;
+ $_ =~ s/>/^^/;
+ $_ =~ s/^<|NA$//g;
+ $_ =~ s/^(current|credit|terms|image|title|link|.*_url).*//;
+ push @weather_data, $_ if $_ !~ /^\s*$/;
+ }
+ unshift (@weather_data,("timestamp^^$now"));
+ main::writer($file_cached,\@weather_data);
+ #print "$file_cached: download/cleaned\n";
+ }
+ #print join "\n", @weather_data, "\n";
+ # NOTE: because temps can be 0, we can't do if value tests
+ foreach (@weather_data){
+ my @working = split /\s*\^\^\s*/,$_;
+ next if ! defined $working[1] || $working[1] eq '';
+ if ( $working[0] eq 'dewpoint_string' ){
+ $weather{'dewpoint'} = $working[1];
+ $working[1] =~ /^([0-9\.]+)\sF\s\(([0-9\.]+)\sC\)/;
+ $weather{'dewpoint-c'} = $2;;
+ $weather{'dewpoint-f'} = $1;;
+ }
+ elsif ( $working[0] eq 'dewpoint_c' ){
+ $weather{'dewpoint-c'} = $working[1];
+ }
+ elsif ( $working[0] eq 'dewpoint_f' ){
+ $weather{'dewpoint-f'} = $working[1];
+ }
+ # there are two elevations, we want the first one
+ elsif (!$weather{'elevation-m'} && $working[0] eq 'elevation'){
+ # note: bug in source data uses ft for meters, not 100% of time, but usually
+ $weather{'elevation-m'} = $working[1];
+ $weather{'elevation-m'} =~ s/\s*(ft|m).*$//;
+ }
+ elsif ( $working[0] eq 'heat_index_string' ){
+ $weather{'heat-index'} = $working[1];
+ $working[1] =~ /^([0-9\.]+)\sF\s\(([0-9\.]+)\sC\)/;
+ $weather{'heat-index-c'} = $2;;
+ $weather{'heat-index-f'} = $1;
+ }
+ elsif ( $working[0] eq 'heat_index_c' ){
+ $weather{'heat-index-c'} = $working[1];
+ }
+ elsif ( $working[0] eq 'heat_index_f' ){
+ $weather{'heat-index-f'} = $working[1];
+ }
+ elsif ( $working[0] eq 'relative_humidity' ){
+ $weather{'humidity'} = $working[1];
+ }
+ elsif ( $working[0] eq 'local_time' ){
+ $weather{'local-time'} = $working[1];
+ }
+ elsif ( $working[0] eq 'local_epoch' ){
+ $weather{'local-epoch'} = $working[1];
+ }
+ elsif ( $working[0] eq 'observation_time_rfc822' ){
+ $weather{'observation-time-gmt'} = $working[1];
+ }
+ elsif ( $working[0] eq 'observation_epoch' ){
+ $weather{'observation-epoch'} = $working[1];
+ }
+ elsif ( $working[0] eq 'observation_time' ){
+ $weather{'observation-time-local'} = $working[1];
+ $weather{'observation-time-local'} =~ s/Last Updated on //;
+ }
+ elsif ( $working[0] eq 'pressure_string' ){
+ $weather{'pressure'} = $working[1];
+ }
+ elsif ( $working[0] eq 'pressure_mb' ){
+ $weather{'pressure-mb'} = $working[1];
+ }
+ elsif ( $working[0] eq 'pressure_in' ){
+ $weather{'pressure-in'} = $working[1];
+ }
+ elsif ( $working[0] eq 'temperature_string' ){
+ $weather{'temp'} = $working[1];
+ $working[1] =~ /^([0-9\.]+)\sF\s\(([0-9\.]+)\sC\)/;
+ $weather{'temp-c'} = $2;;
+ $weather{'temp-f'} = $1;
+# $weather{'temp'} =~ s/\sF/\xB0 F/; # B0
+# $weather{'temp'} =~ s/\sF/\x{2109}/;
+# $weather{'temp'} =~ s/\sC/\x{2103}/;
+ }
+ elsif ( $working[0] eq 'temp_f' ){
+ $weather{'temp-f'} = $working[1];
+ }
+ elsif ( $working[0] eq 'temp_c' ){
+ $weather{'temp-c'} = $working[1];
+ }
+ elsif ( $working[0] eq 'visibility' ){
+ $weather{'visibility'} = $working[1];
+ }
+ elsif ( $working[0] eq 'visibility_km' ){
+ $weather{'visibility-km'} = $working[1];
+ }
+ elsif ( $working[0] eq 'visibility_mi' ){
+ $weather{'visibility-mi'} = $working[1];
+ }
+ elsif ( $working[0] eq 'weather' ){
+ $weather{'weather'} = $working[1];
+ }
+ elsif ( $working[0] eq 'wind_degrees' ){
+ $weather{'wind-degrees'} = $working[1];
+ }
+ elsif ( $working[0] eq 'wind_dir' ){
+ $weather{'wind-direction'} = $working[1];
+ }
+ elsif ( $working[0] eq 'wind_mph' ){
+ $weather{'wind-mph'} = $working[1];
+ }
+ elsif ( $working[0] eq 'wind_gust_mph' ){
+ $weather{'wind-gust-mph'} = $working[1];
+ }
+ elsif ( $working[0] eq 'wind_gust_ms' ){
+ $weather{'wind-gust-ms'} = $working[1];
+ }
+ elsif ( $working[0] eq 'wind_ms' ){
+ $weather{'wind-ms'} = $working[1];
+ }
+ elsif ( $working[0] eq 'wind_string' ){
+ $weather{'wind'} = $working[1];
+ }
+ elsif ( $working[0] eq 'windchill_string' ){
+ $weather{'windchill'} = $working[1];
+ $working[1] =~ /^([0-9\.]+)\sF\s\(([0-9\.]+)\sC\)/;
+ $weather{'windchill-c'} = $2;
+ $weather{'windchill-f'} = $1;
+ }
+ elsif ( $working[0] eq 'windchill_c' ){
+ $weather{'windchill-c'} = $working[1];
+ }
+ elsif ( $working[0] eq 'windchill_f' ){
+ $weather{'windchill_f'} = $working[1];
+ }
+ }
+ if ($show{'weather-location'}){
+ $weather{'observation-time-local'} =~ /^(.*)\s([\S]+)$/;
+ $tz = $2;
+ # very clever trick, just make the system think it's in the
+ # remote timezone for this local block only
+ local $ENV{'TZ'} = $tz;
+ $date_time = POSIX::strftime "%c", localtime;
+ $weather{'date-time'} = $date_time;
+ }
+ else {
+ $date_time = POSIX::strftime "%c", localtime;
+ $tz = ( $location[2] ) ? " ($location[2])" : '';
+ $weather{'date-time'} = $date_time . $tz;
+ }
+ # we get the wrong time using epoch for remote -W location
+ if ( !$show{'weather-location'} && $weather{'observation-epoch'}){
+ $weather{'observation-time-local'} = POSIX::strftime "%c", localtime($weather{'observation-epoch'});
+ }
+ return %weather;
+ eval $end if $b_log;
+}
+sub get_location {
+ eval $start if $b_log;
+ my ($city,$country,$freshness,%loc,$loc_arg,$loc_string,@loc_data,$state);
+ my $now = POSIX::strftime "%Y%m%d%H%M", localtime;
+ my $file_cached = "$user_data_dir/location-main.txt";
+ if (-f $file_cached){
+ @loc_data = main::reader($file_cached);
+ $freshness = (split /\^\^/, $loc_data[0])[1];
+ }
+ if (!$freshness || $freshness < $now - 90) {
+ my $temp;
+ my $url = "http://geoip.ubuntu.com/lookup";
+# {
+# local $/;
+# my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/weather/location-1.xml";
+# open my $fh, '<', $file or die "can't open $file: $!";
+# $temp = <$fh>;
+# }
+ $temp = main::download_file('stdout',$url);
+ @loc_data = split /\n/, $temp;
+ @loc_data = map {
+ s/<\?.*<Response>//;
+ s/<\/[^>]+>/\n/g;
+ s/>/^^/g;
+ s/<//g;
+ $_;
+ } @loc_data;
+ @loc_data = split /\n/, $loc_data[0];
+ unshift (@loc_data,("timestamp^^$now"));
+ main::writer($file_cached,\@loc_data);
+ #print "$file_cached: download/cleaned\n";
+ }
+ foreach (@loc_data){
+ my @working = split /\s*\^\^\s*/,$_;
+ #print "$working[0]:$working[1]\n";
+ if ($working[0] eq 'CountryCode3' ) {
+ $loc{'country3'} = $working[1];
+ }
+ elsif ($working[0] eq 'CountryCode' ) {
+ $loc{'country'} = $working[1];
+ }
+ elsif ($working[0] eq 'CountryName' ) {
+ $loc{'country2'} = $working[1];
+ }
+ elsif ($working[0] eq 'RegionCode' ) {
+ $loc{'region-id'} = $working[1];
+ }
+ elsif ($working[0] eq 'RegionName' ) {
+ $loc{'region'} = $working[1];
+ }
+ elsif ($working[0] eq 'City' ) {
+ $loc{'city'} = $working[1];
+ }
+ elsif ($working[0] eq 'ZipPostalCode' ) {
+ $loc{'zip'} = $working[1];
+ }
+ elsif ($working[0] eq 'Latitude' ) {
+ $loc{'lat'} = $working[1];
+ }
+ elsif ($working[0] eq 'Longitude' ) {
+ $loc{'long'} = $working[1];
+ }
+ elsif ($working[0] eq 'TimeZone' ) {
+ $loc{'tz'} = $working[1];
+ }
+ }
+ #print Data::Dumper::Dumper \%loc;
+ # assign location, cascade from most accurate
+ # latitude,longitude first
+ if ($loc{'lat'} && $loc{'long'}){
+ $loc_arg = "$loc{'lat'},$loc{'long'}";
+ }
+ # city,state next
+ elsif ($loc{'city'} && $loc{'region-id'}){
+ $loc_arg = "$loc{'city'},$loc{'region-id'}";
+ }
+ # postal code last, that can be a very large region
+ elsif ($loc{'zip'}){
+ $loc_arg = $loc{'zip'};
+ }
+ $country = ($loc{'country3'}) ? $loc{'country3'} : $loc{'country'};
+ $city = ($loc{'city'}) ? $loc{'city'} : 'City N/A';
+ $state = ($loc{'region-id'}) ? $loc{'region-id'} : 'Region N/A';
+ $loc_string = main::apply_filter("$city, $state, $country");
+ my @location = ($loc_arg,$loc_string,$loc{'tz'});
+ #print ($loc_arg,"\n", join "\n", @loc_data, "\n",scalar @loc_data, "\n");
+ eval $end if $b_log;
+ return @location;
+}
+}
+
+#### -------------------------------------------------------------------
+#### UTILITIES FOR DATA LINES
+#### -------------------------------------------------------------------
+
+sub get_compiler_version {
+ eval $start if $b_log;
+ my (@compiler);
+ if (my $file = system_files('version') ) {
+ @compiler = get_compiler_version_linux($file);
+ }
+ else {
+ @compiler = get_compiler_version_bsd();
+ }
+ eval $end if $b_log;
+ return @compiler;
+}
+
+sub get_compiler_version_bsd {
+ eval $start if $b_log;
+ my (@compiler,@working);
+ if ($alerts{'sysctl'}{'action'} eq 'use'){
+ # for dragonfly, we will use free mem, not used because free is 0
+ my @working;
+ foreach (@sysctl){
+ # freebsd seems to use bytes here
+ # Not every line will have a : separator though the processor should make
+ # most have it. This appears to be 10.x late feature add, I don't see it
+ # on earlier BSDs
+ if (/^kern.compiler_version/){
+ @working = split /:\s*/, $_;
+ $working[1] =~ /.*(gcc|clang)\sversion\s([\S]+)\s.*/;
+ @compiler = ($1,$2);
+ last;
+ }
+ }
+ }
+ else {
+ @compiler = ('N/A','');
+ }
+ log_data('dump','@compiler',\@compiler) if $b_log;
+ eval $end if $b_log;
+ return @compiler;
+}
+
+sub get_compiler_version_linux {
+ eval $start if $b_log;
+ my ($file) = @_;
+ my (@compiler,$type);
+ my @data = reader($file);
+ my $result = $data[0] if @data;
+ if ($result){
+ $result =~ /(gcc|clang).*version\s([\S]+)/;
+ # $result = $result =~ /\*(gcc|clang)\*eval\*/;
+ if ($1){
+ $type = $2;
+ $type ||= 'N/A'; # we don't really know what linux clang looks like!
+ @compiler = ($1,$type);
+ }
+ }
+ log_data('dump','@compiler',\@compiler) if $b_log;
+
+ eval $end if $b_log;
+ return @compiler;
+}
+
+## Get DesktopEnvironment
+## returns array:
+# 0 - desktop name
+# 1 - version
+# 2 - toolkit
+# 3 - toolkit version
+# 4 - info extra desktop data
+# 5 - wm
+# 6 - wm version
+{
+package DesktopEnvironment;
+my ($b_xprop,$desktop_session,$kde_session_version,$xdg_desktop,@desktop,@data,@xprop);
+sub get {
+ # NOTE $XDG_CURRENT_DESKTOP envvar is not reliable, but it shows certain desktops better.
+ # most desktops are not using it as of 2014-01-13 (KDE, UNITY, LXDE. Not Gnome)
+ $desktop_session = ( $ENV{'DESKTOP_SESSION'} ) ? lc($ENV{'DESKTOP_SESSION'}) : '';
+ $xdg_desktop = ( $ENV{'XDG_CURRENT_DESKTOP'} ) ? lc($ENV{'XDG_CURRENT_DESKTOP'}) : '';
+ $kde_session_version = ($ENV{'KDE_SESSION_VERSION'}) ? $ENV{'KDE_SESSION_VERSION'} : '';
+ get_kde_data();
+ if (!@desktop){
+ get_env_de_data();
+ }
+ if (!@desktop){
+ get_env_xprop_de_data();
+ }
+ if (!@desktop && $b_xprop ){
+ get_xprop_de_data();
+ }
+ if (!@desktop){
+ get_ps_de_data();
+ }
+ if ($extra > 2 && @desktop){
+ set_info_data();
+ }
+ if ($b_display && !$b_force_display && $extra > 1){
+ get_wm();
+ }
+ main::log_data('dump','@desktop', \@desktop) if $b_log;
+ # ($b_xprop,$kde_session_version,$xdg_desktop,@data,@xprop) = undef;
+ return @desktop;
+}
+sub get_kde_data {
+ eval $start if $b_log;
+ my ($program,@version_data,@version_data2);
+ my $kde_full_session = ($ENV{'KDE_FULL_SESSION'}) ? $ENV{'KDE_FULL_SESSION'} : '';
+ return 1 if ($xdg_desktop ne 'kde' && !$kde_session_version && $kde_full_session ne 'true' );
+ # works on 4, assume 5 will id the same, why not, no need to update in future
+ # KDE_SESSION_VERSION is the integer version of the desktop
+ # NOTE: as of plasma 5, the tool: about-distro MAY be available, that will show
+ # actual desktop data, so once that's in debian/ubuntu, if it gets in, add that test
+ if ($xdg_desktop eq 'kde' || $kde_session_version ){
+ if ($kde_session_version && $kde_session_version <= 4){
+ @data = main::program_values("kded$kde_session_version");
+ if (@data){
+ $desktop[0] = $data[3];
+ $desktop[1] = main::program_version("kded$kde_session_version",$data[0],$data[1],$data[2],$data[5],$data[6]);
+ # kded exists, so we can now get the qt data string as well
+ if ($desktop[1] && ($program = main::check_program("kded$kde_session_version")) ){
+ @version_data = main::grabber("$program --version 2>/dev/null");
+ }
+ }
+ $desktop[0] = 'KDE' if !$desktop[0];
+ }
+ else {
+ # NOTE: this command string is almost certain to change, and break, with next
+ # major plasma desktop, ie, 6.
+ # qdbus org.kde.plasmashell /MainApplication org.qtproject.Qt.QCoreApplication.applicationVersion
+ # Qt: 5.4.2
+ # KDE Frameworks: 5.11.0
+ # kf5-config: 1.0
+ # for QT, and Frameworks if we use it
+ if (!@version_data && ($program = main::check_program("kf$kde_session_version-config") )){
+ @version_data = main::grabber("$program --version 2>/dev/null");
+ }
+ if (!@version_data && ($program = main::check_program("kded$kde_session_version"))){
+ @version_data = main::grabber("$program --version 2>/dev/null");
+ }
+ if ($program = main::check_program("plasmashell")){
+ @version_data2 = main::grabber("$program --version 2>/dev/null");
+ $desktop[1] = main::awk(\@version_data2,'^plasmashell',-1,'\s+');
+ }
+ $desktop[0] = 'KDE Plasma';
+ }
+ if (!$desktop[1]){
+ $desktop[1] = ($kde_session_version) ? $kde_session_version: main::row_defaults('unknown-desktop-version');
+ }
+ # print Data::Dumper::Dumper \@version_data;
+ if ($extra > 1){
+ if (@version_data){
+ $desktop[3] = main::awk(\@version_data,'^Qt:', 2,'\s+');
+ }
+ # qmake can have variants, qt4-qmake, qt5-qmake, also qt5-default but not tested
+ if (!$desktop[3] && ($program = main::check_program("qmake"))){
+ # note: this program has issues, it may appear to be in /usr/bin, but it
+ # often fails to execute, so the below will have null output, but use as a
+ # fall back test anyway.
+ @version_data = main::grabber("$program --version 2>/dev/null");
+ $desktop[3] = main::awk(\@version_data,'^Using Qt version',4) if @version_data;
+ }
+ $desktop[2] = 'Qt';
+ }
+ }
+ # KDE_FULL_SESSION property is only available since KDE 3.5.5.
+ elsif ($kde_full_session eq 'true'){
+ @version_data = main::grabber("kded --version 2>/dev/null");
+ $desktop[0] = 'KDE';
+ $desktop[1] = main::awk(\@version_data,'^KDE:',2,'\s+') if @version_data;
+ if (!$desktop[1]){
+ $desktop[1] = '3.5';
+ }
+ if ($extra > 1 && @version_data){
+ $desktop[2] = 'Qt';
+ $desktop[3] = main::awk(\@version_data,'^Qt:',2,'\s+') if @version_data;
+ }
+ }
+ eval $end if $b_log;
+}
+sub get_env_de_data {
+ eval $start if $b_log;
+ my ($program,@version_data);
+ main::set_ps_gui() if ! $b_ps_gui;
+ if ($desktop_session eq 'trinity' || $xdg_desktop eq 'trinity' || (grep {/^tde/} @ps_gui) ){
+ $desktop[0] = 'Trinity';
+ if ($program = main::check_program('kdesktop')){
+ @version_data = main::grabber("$program --version 2>/dev/null");
+ $desktop[1] = main::awk(\@version_data,'^TDE:',2,'\s+') if @version_data;
+ }
+ if ($extra > 1 && @version_data){
+ $desktop[2] = 'Qt';
+ $desktop[3] = main::awk(\@version_data,'^Qt:',2,'\s+') if @version_data;
+ }
+ }
+ elsif ($xdg_desktop eq 'unity'){
+ @data = main::program_values('unity');
+ $desktop[0] = $data[3];
+ $desktop[0] ||= 'Unity';
+ $desktop[1] = main::program_version('cinnamon',$data[0],$data[1],$data[2],$data[5],$data[6]);
+ #set_gtk_data() if $extra > 1;
+ }
+ elsif ( $xdg_desktop =~ /budgie/ ){
+ @data = main::program_values('budgie');
+ $desktop[0] = $data[3];
+ $desktop[1] = main::program_version('budgie-desktop',$data[0],$data[1],$data[2],$data[5],$data[6]);
+ }
+ # debian package: lxde-core.
+ # NOTE: some distros fail to set XDG data for root
+ elsif ( $xdg_desktop =~ /^(lxde|razor|lxqt)$/ || (grep {/^(razor-session|lxsession|lxqt-session)$/} @ps_gui)){
+ # note: openbox-lxde --version may be present, but returns openbox data
+ if ($xdg_desktop eq 'lxde' || (grep {/^lxsession$/} @ps_gui )){
+ @data = main::program_values('lxde');
+ $desktop[0] = $data[3];
+ $desktop[1] = main::program_version('lxpanel',$data[0],$data[1],$data[2],$data[5],$data[6]);
+ }
+ # NOTE: lxqt-about opens a gui dialog
+ elsif ($xdg_desktop eq 'razor' || $xdg_desktop eq 'lxqt' || (grep {/^(razor-desktop|lxqt-session)$/} @ps_gui)) {
+ if (grep {/^lxqt-session$/} @ps_gui){
+ @data = main::program_values('lxqt');
+ $desktop[0] = $data[3];
+ # BAD: lxqt-about opens dialogue, sigh
+ $desktop[1] = main::program_version('lxqt-panel',$data[0],$data[1],$data[2],$data[5],$data[6]);
+ }
+ elsif (grep {/^razor-session$/} @ps_gui){
+ $desktop[0] = 'Razor-Qt';
+ }
+ else {
+ $desktop[0] = 'LX-Qt-Variant';
+ }
+ set_qt_data() if $extra > 1;
+ }
+ }
+ # note, X-Cinnamon value strikes me as highly likely to change, so just
+ # search for the last part
+ elsif ( $xdg_desktop =~ /cinnamon/ ){
+ @data = main::program_values('cinnamon');
+ $desktop[0] = $data[3];
+ $desktop[1] = main::program_version('cinnamon',$data[0],$data[1],$data[2],$data[5],$data[6]);
+ #set_gtk_data() if $extra > 1;
+ }
+ elsif ($xdg_desktop eq 'pantheon' || $desktop_session eq 'pantheon'){
+ @data = main::program_values('pantheon');
+ $desktop[0] = $data[3];
+ #$desktop[1] = main::program_version('pantheon',$data[0],$data[1],$data[2],$data[5],$data[6]);
+ #set_gtk_data() if $extra > 1;
+ }
+ eval $end if $b_log;
+}
+sub get_env_xprop_de_data {
+ eval $start if $b_log;
+ my ($program,$value,@version_data);
+ # NOTE: Always add to set_prop the search term if you add an item!!
+ set_xprop();
+ # note that cinnamon split from gnome, and and can now be id'ed via xprop,
+ # but it will still trigger the next gnome true case, so this needs to go
+ # before gnome test eventually this needs to be better organized so all the
+ # xprop tests are in the same section, but this is good enough for now.
+ # NOTE: was checking for 'muffinr' but that's not part of cinnom
+ if ( (main::check_program('muffin') || main::check_program('cinnamon-session') ) &&
+ ($b_xprop && main::awk(\@xprop,'_muffin') )){
+ @data = main::program_values('cinnamon');
+ $desktop[0] = $data[3];
+ $desktop[1] = main::program_version('cinnamon',$data[0],$data[1],$data[2],$data[5],$data[6]);
+ #set_gtk_data() if $extra > 1;
+ $desktop[0] ||= 'Cinnamon';
+ }
+ elsif ($xdg_desktop eq 'mate' || ( $b_xprop && main::awk(\@xprop,'_marco') )){
+ # NOTE: mate-about reported wrong version, 1.18.0 when actual was 1.18.2
+ if ($program = main::check_program('mate-session') ) {
+ $value = 'mate-session';
+ }
+ if ($value){
+ @data = main::program_values($value);
+ $desktop[0] = $data[3];
+ $desktop[1] = main::program_version($program,$data[0],$data[1],$data[2],$data[5],$data[6]);
+ }
+ #set_gtk_data() if $extra > 1;
+ $desktop[0] ||= 'MATE';
+ }
+ # note, GNOME_DESKTOP_SESSION_ID is deprecated so we'll see how that works out
+ # https://bugzilla.gnome.org/show_bug.cgi?id=542880.
+ # NOTE: manjaro is leaving XDG data null, which forces the manual check for gnome, sigh...
+ elsif ($xdg_desktop eq 'gnome' || $ENV{'GNOME_DESKTOP_SESSION_ID'} ||
+ (main::check_program('gnome-shell') && $b_xprop && main::awk(\@xprop,'^_gnome') ) ){
+ if ($program = main::check_program('gnome-about') ) {
+ @data = main::program_values('gnome-about');
+ $desktop[1] = main::program_version('gnome-about',$data[0],$data[1],$data[2],$data[5],$data[6]);
+ }
+ elsif ($program = main::check_program('gnome-shell') ) {
+ @data = main::program_values('gnome-shell');
+ $desktop[1] = main::program_version('gnome-shell',$data[0],$data[1],$data[2],$data[5],$data[6]);
+ }
+ # set_gtk_data() if $extra > 1;
+ $desktop[0] = ( $data[3] ) ? $data[3] : 'Gnome';
+ }
+ eval $end if $b_log;
+}
+sub get_xprop_de_data {
+ eval $start if $b_log;
+ my ($program,@version_data,$version);
+ #print join "\n", @xprop, "\n";
+ # String: "This is xfdesktop version 4.2.12"
+ # alternate: xfce4-about --version > xfce4-about 4.10.0 (Xfce 4.10)
+ # note: some distros/wm (e.g. bunsen) set xdg to xfce to solve some other
+ # issues so don't test for that. $xdg_desktop eq 'xfce'
+ # the sequence here matters, some desktops like icewm, razor, let you set different
+ # wm, so we want to get the main controlling desktop first, then fall back to the wm
+ # detections. get_wm() will handle alternate wm detections.
+ if ((main::check_program('xfdesktop')) && main::awk(\@xprop,'^(xfdesktop|xfce)' )){
+ # this is a very expensive test that doesn't usually result in a find
+ # talk to xfce to see what id they will be using for xfce 5
+# if (main::awk(\@xprop, 'xfce4')){
+# $version = '4';
+# }
+ if (main::awk(\@xprop, 'xfce5')){
+ $version = '5';
+ }
+ else {
+ $version = '4';
+ }
+ @data = main::program_values('xfdesktop');
+ $desktop[0] = $data[3];
+ # xfdesktop --version out of x fails to get display, so no data
+ @version_data = main::grabber('xfdesktop --version 2>/dev/null');
+ # out of x, this error goes to stderr, so it's an empty result
+ $desktop[1] = main::awk(\@version_data,$data[0],$data[1],'\s+');
+ #$desktop[1] = main::program_version('xfdesktop',$data[0],$data[1],$data[2],$data[5],$data[6]);
+ if ( !$desktop[1] ){
+ @data = main::program_values("xfce${version}-panel");
+ # print Data::Dumper::Dumper \@data;
+ # this returns an error message to stdout in x, which breaks the version
+ # xfce4-panel --version out of x fails to get display, so no data
+ $desktop[1] = main::program_version("xfce${version}-panel",$data[0],$data[1],$data[2],$data[5],$data[6]);
+ # out of x this kicks out an error: xfce4-panel: Cannot open display
+ $desktop[1] = '' if $desktop[1] !~ /[0-9]\./;
+ }
+ $desktop[0] ||= 'Xfce';
+ $desktop[1] ||= ''; # xfce isn't going to be 4 forever
+ if ($extra > 1){
+ @data = main::program_values('xfdesktop-toolkit');
+ #$desktop[3] = main::program_version('xfdesktop',$data[0],$data[1],$data[2],$data[5],$data[6]);
+ $desktop[3] = main::awk(\@version_data,$data[0],$data[1],'\s+');
+ $desktop[2] = $data[3];
+ }
+ }
+ elsif (main::check_program('enlightenment') && main::awk(\@xprop,'enlightenment' )){
+ $desktop[0] = 'Enlightenment';
+ # no -v or --version but version is in xprop -root
+ # ENLIGHTENMENT_VERSION(STRING) = "Enlightenment 0.16.999.49898"
+ $desktop[1] = main::awk(\@xprop,'enlightenment_version',2,'\s+=\s+' );
+ $desktop[1] = (split /"/, $desktop[1])[1] if $desktop[1];
+ $desktop[1] = (split /\s+/, $desktop[1])[1] if $desktop[1];
+ }
+ # must come right after xfce
+ elsif (main::check_program('icewm') && main::awk(\@xprop,'icewm' )){
+ @data = main::program_values('icewm');
+ $desktop[0] = $data[3];
+ $desktop[1] = main::program_version('icewm',$data[0],$data[1],$data[2],$data[5],$data[6]);
+ }
+ # debian package: i3-wm
+ elsif (main::check_program('i3') && main::awk(\@xprop,'^i3_' )){
+ @data = main::program_values('i3');
+ $desktop[0] = $data[3];
+ $desktop[1] = main::program_version('i3',$data[0],$data[1],$data[2],$data[5],$data[6]);
+ }
+ elsif (main::check_program('mwm') && main::awk(\@xprop,'^_motif' )){
+ @data = main::program_values('mwm');
+ $desktop[0] = $data[3];
+ # $desktop[1] = main::program_version('mwm',$data[0],$data[1],$data[2],$data[5],$data[6]);
+ }
+ # debian package name: wmaker
+ elsif (main::check_program('WindowMaker') && main::awk(\@xprop,'^_?windowmaker' )){
+ @data = main::program_values('wmaker');
+ $desktop[0] = $data[3];
+ $desktop[1] = main::program_version('wmaker',$data[0],$data[1],$data[2],$data[5],$data[6]);
+ }
+ elsif (main::check_program('wm2') && main::awk(\@xprop,'^_wm2' )){
+ @data = main::program_values('wm2');
+ $desktop[0] = $data[3];
+ $desktop[1] = main::program_version('wm2',$data[0],$data[1],$data[2],$data[5],$data[6]);
+ }
+ elsif (main::check_program('herbstluftwm') && main::awk(\@xprop,'herbstluftwm' )){
+ @data = main::program_values('herbstluftwm');
+ $desktop[0] = $data[3];
+ $desktop[1] = main::program_version('herbstluftwm',$data[0],$data[1],$data[2],$data[5],$data[6]);
+ }
+ elsif ( (main::check_program('blackbox') || main::check_program('fluxbox')) && main::awk(\@xprop,'blackbox_pid' )){
+ if (@ps_gui && (grep {/^fluxbox$/} @ps_gui )){
+ @data = main::program_values('fluxbox');
+ $desktop[0] = $data[3];
+ $desktop[1] = main::program_version('fluxbox',$data[0],$data[1],$data[2],$data[5],$data[6]);
+ }
+ else {
+ @data = main::program_values('blackbox');
+ $desktop[0] = $data[3];
+ $desktop[1] = main::program_version('blackbox',$data[0],$data[1],$data[2],$data[5],$data[6]);
+ }
+ }
+ elsif (main::check_program('openbox') && main::awk(\@xprop,'openbox_pid' )){
+ @data = main::program_values('openbox');
+ $desktop[0] = $data[3];
+ $desktop[1] = main::program_version('openbox',$data[0],$data[1],$data[2],$data[5],$data[6]);
+ }
+ elsif (main::check_program('amiwm') && main::awk(\@xprop,'amiwm' )){
+ @data = main::program_values('amiwm');
+ $desktop[0] = $data[3];
+ #$desktop[1] = main::program_version('openbox',$data[0],$data[1],$data[2],$data[5],$data[6]);
+ }
+ # need to check starts line because it's so short
+ eval $end if $b_log;
+}
+sub get_ps_de_data {
+ eval $start if $b_log;
+ my ($program,@version_data);
+ main::set_ps_gui() if !$b_ps_gui;
+ if (@ps_gui){
+ # 1 check program; 2 search; 3 values; 4 version; 5 -optional: print value
+ my @desktops =(
+ ['fluxbox','fluxbox','fluxbox','fluxbox'],
+ ['fvwm-crystal','fvwm-crystal','fvwm-crystal','fvwm'],
+ ['fvwm2','fvwm2','fvwm2','fvwm2'],
+ ['fvwm','fvwm','fvwm','fvwm'],
+ ['pekwm','pekwm','pekwm','pekwm'],
+ ['awesome','awesome','awesome','awesome'],
+ ['blackbox','blackbox','blackbox','blackbox'],
+ ['openbox','openbox','openbox','openbox'],
+ # not in debian apt
+ ['scrotwm','scrotwm','scrotwm','scrotwm'],
+ ['spectrwm','spectrwm','spectrwm','spectrwm'],
+ ['twm','twm','twm','twm'],
+ # note: built from source, but I assume it will show: /usr/bin/dwm
+ ['dwm','dwm','dwm','dwm'],
+ # not in debian apt, current is wmii, version 3
+ ['wmii2','wmii2','wmii2','wmii2'],
+ ['wmii','wmii','wmii','wmii'],
+ ['9wm','9wm','9wm','9wm'],
+ ['amiwm','amiwm','amiwm','amiwm'],
+ ['flwm','flwm','flwm','flwm'],
+ ['jwm','jwm','jwm','jwm'],
+ ['mwm','mwm','mwm','mwm'],
+ ['notion','notion','notion','notion'],
+ ['ratpoison','ratpoison','ratpoison','ratpoison'],
+ ['sawfish','sawfish','sawfish','sawfish'],
+ ['matchbox-window-manager','matchbox-window-manager',
+ 'matchbox-window-manager','matchbox-window-manager'],
+ ['afterstep','afterstep','afterstep','afterstep'],
+ ['WindowMaker','WindowMaker','wmaker','wmaker'],
+ ['windowlab','windowlab','windowlab','windowlab'],
+ ['xmonad','xmonad','xmonad','xmonad'],
+ );
+ foreach my $ref (@desktops){
+ my @item = @$ref;
+ # no need to use check program with short list of ps_gui
+ # if ( main::check_program($item[0]) && (grep {/^$item[1]$/} @ps_gui)){
+ if (grep {/^$item[1]$/} @ps_gui){
+ @data = main::program_values($item[2]);
+ $desktop[0] = $data[3];
+ if ($data[1] && $data[2]){
+ $desktop[1] = main::program_version($item[3],$data[0],$data[1],$data[2],$data[5],$data[6]);
+ }
+ last;
+ }
+ }
+ }
+ eval $end if $b_log;
+}
+
+sub set_qt_data {
+ eval $start if $b_log;
+ my ($program,@data,@version_data);
+ my $kde_version = $kde_session_version;
+ $program = '';
+ if (!$kde_version){
+ if ($program = main::check_program("kded6") ){$kde_version = 6;}
+ elsif ($program = main::check_program("kded5") ){$kde_version = 5;}
+ elsif ($program = main::check_program("kded4") ){$kde_version = 4;}
+ elsif ($program = main::check_program("kded") ){$kde_version = '';}
+ }
+ # alternate: qt4-default, qt4-qmake or qt5-default, qt5-qmake
+ if (!$desktop[3] && ($program = main::check_program("qmake"))){
+ @version_data = main::grabber("$program --version 2>/dev/null");
+ $desktop[2] = 'Qt';
+ $desktop[3] = main::awk(\@version_data,'^Using Qt version',4) if @version_data;
+ }
+ if (!$desktop[3] && ($program = main::check_program("qtdiag") )){
+ @data = main::program_values('qtdiag');
+ $desktop[3] = main::program_version($program,$data[0],$data[1],$data[2],$data[5],$data[6]);
+ $desktop[2] = $data[3];
+ }
+ if (!$desktop[3] && ($program = main::check_program("kf$kde_version-config") )){
+ @version_data = main::grabber("$program --version 2>/dev/null");
+ $desktop[2] = 'Qt';
+ $desktop[3] = main::awk(\@version_data,'^Qt:',2) if @version_data;
+ }
+ # note: qt 5 does not show qt version in kded5, sigh
+ if (!$desktop[3] && ($program = main::check_program("kded$kde_version"))){
+ @version_data = main::grabber("$program --version 2>/dev/null");
+ $desktop[2] = 'Qt';
+ $desktop[3] = main::awk(\@version_data,'^Qt:',2) if @version_data;
+ }
+ eval $end if $b_log;
+}
+
+sub get_wm {
+ eval $start if $b_log;
+ if (!$b_wmctrl) {
+ get_wm_main();
+ }
+ if ( (!$desktop[5] || $b_wmctrl) && (my $program = main::check_program('wmctrl'))){
+ get_wm_wmctrl($program);
+ }
+ eval $end if $b_log;
+}
+sub get_wm_main {
+ eval $start if $b_log;
+ my ($wms,$working);
+ # xprop is set only if not kde/gnome/cinnamon/mate/budgie/lx..
+ if ($b_xprop){
+ #KWIN_RUNNING
+ $wms = 'blackbox|compiz|kwin_wayland|kwin_x11|kwin|marco|muffin|';
+ $wms .= 'openbox|herbstluftwm|twin|wm2|windowmaker|i3';
+ foreach (@xprop){
+ if (/\b($wms)\b/){
+ $working = $1;
+ $working = 'wmaker' if $working eq 'windowmaker';
+ last;
+ }
+ }
+ }
+ if (!$desktop[5]){
+ main::set_ps_gui() if ! $b_ps_gui;
+ # order matters, see above logic
+ $wms = '9wm|afterstep|amiwm|awesome|budgie-wm|compiz|fluxbox|blackbox|dwm|';
+ $wms .= 'flwm|fvwm-crystal|fvwm2|fvwm|gala|gnome-shell|i3|jwm|';
+ $wms .= 'twin|kwin_wayland|kwin_x11|kwin|matchbox-window-manager|marco|';
+ $wms .= 'muffin|mutter|metacity|mwm|notion|openbox|ratpoison|sawfish|scrotwm|spectrwm|';
+ $wms .= 'twm|windowlab|WindowMaker|wm2|wmii2|wmii|xfwm4|xfwm5|xmonad';
+ foreach (@ps_gui){
+ if (/^($wms)$/){
+ $working = $1;
+ last;
+ }
+ }
+ }
+ get_wm_version('manual',$working) if $working;
+ $desktop[5] = $working if !$desktop[5] && $working;
+ eval $end if $b_log;
+}
+sub get_wm_wmctrl {
+ eval $start if $b_log;
+ my ($program) = @_;
+ my $cmd = "$program -m 2>/dev/null";
+ my @data = main::grabber($cmd,'','strip');
+ main::log_data('dump','@data',\@data) if $b_log;
+ $desktop[5] = main::awk(\@data,'^Name',2,'\s*:\s*');
+ $desktop[5] = '' if $desktop[5] && $desktop[5] eq 'N/A';
+ if ($desktop[5]){
+ # variants: gnome shell;
+ # IceWM 1.3.8 (Linux 3.2.0-4-amd64/i686) ; Metacity (Marco) ; Xfwm4
+ $desktop[5] =~ s/\d+\.\d\S+|[\[\(].*\d+\.\d.*[\)\]]//g;
+ $desktop[5] = main::trimmer($desktop[5]);
+ # change Metacity (Marco) to marco
+ if ($desktop[5] =~ /marco/i) {$desktop[5] = 'marco'}
+ elsif (lc($desktop[5]) eq 'gnome shell') {$desktop[5] = 'gnome-shell'}
+ elsif ($desktop_session eq 'trinity' && lc($desktop[5]) eq 'kwin') {$desktop[5] = 'Twin'}
+ get_wm_version('wmctrl',$desktop[5]);
+ }
+ eval $end if $b_log;
+}
+sub get_wm_version {
+ eval $start if $b_log;
+ my ($type,$wm) = @_;
+ # we don't want the gnome-shell version, and the others have no --version
+ # we also don't want to run --version again on stuff we already have tested
+ return if ! $wm || $wm =~ /^(budgie-wm|gnome-shell)$/ || ($desktop[0] && lc($desktop[0]) eq lc($wm) );
+ my $temp = (split /\s+/, $wm)[0];
+ if ($temp){
+ $temp = (split /\s+/, $temp)[0];
+ $temp = lc($temp);
+ $temp = 'wmaker' if $temp eq 'windowmaker';
+ my @data = main::program_values($temp);
+ return if !@data;
+ # print Data::Dumper::Dumper \@data;
+ $desktop[5] = $data[3] if $type eq 'manual';
+ # note: if values returns 0 for 1 and 2, it doesn't support versioning
+ if ($extra > 2 && $data[1] && $data[2]){
+ my $version = main::program_version($temp,$data[0],$data[1],$data[2],$data[5],$data[6]);
+ $desktop[6] = $version if $version;
+ }
+ }
+ eval $end if $b_log;