← Back
Editing: stats-lib-funcs.pl
# # Authentic Theme (https://github.com/authentic-theme/authentic-theme) # Copyright Ilia Rostovtsev <ilia@virtualmin.com> # Licensed under MIT (https://github.com/authentic-theme/authentic-theme/blob/master/LICENSE) # use strict; use feature 'state'; use Fcntl qw(:flock); our $json; eval "use JSON::XS"; if (!$@) { $json = JSON::XS->new->latin1; } else { eval "use JSON::PP"; $json = JSON::PP->new->latin1; } # Import global variables our ($config_directory, $current_theme); # Load theme language and settings our %stats_text = load_language($current_theme); %stats_text = map { $_ => $stats_text{$_} } qw(body_load body_used_cached_total body_used index_noadmin_eaccess index_mods_missing); my %settings = settings("$config_directory/$current_theme/settings.js", 'settings_'); # Required libs my $foreign_check_proc = foreign_check("proc"); if ($foreign_check_proc) { foreign_require("proc"); } # System status ACLs my $acl_system_status = { cpu => acl_system_status('cpu'), mem => acl_system_status('mem'), load => acl_system_status('load'), proc => acl_system_status('proc'), disk => acl_system_status('disk'), net => acl_system_status('net'), virt => acl_system_status('virt'), temp => acl_system_status('temp'), }; # Return localized stats text with placeholders expanded sub stats_text { my $rv = $stats_text{ $_[0] }; $rv =~ s/\$(\d+)/$1 < @_ ? $_[$1] : '$'.$1/ge; return $rv; } # Check if feature is enabled sub get_stats_option { if ($_[1]) { return $settings{"settings_sysinfo_real_time_$_[0]"}; } if (!scalar %settings) { return 1; } return ($settings{"settings_sysinfo_real_time_$_[0]"} eq 'false') ? 0 : 1; } # JSON conversion sub jsonify { my $json_ = shift; my $json_obj; eval { $json_obj = $json->decode($json_) }; return (ref($json_obj) eq 'HASH' && keys %{$json_obj}) ? $json_obj : {}; } # Build an empty stats payload with default graph points sub get_stats_empty { my $time = time(); my $stats = { graphs => { cpu => [{x => $time, y => 0}], mem => [{x => $time, y => 0}], proc => [{x => $time, y => 0}], temp => [{x => $time, y => []}] } }; $stats->{'graphs'}->{'virt'} = [{x => $time, y => 0}] if (has_stats_virt()); $stats->{'graphs'}->{'disk'} = [{x => $time, y => [0, 0]}] if (has_stats('proc', 'disk')); $stats->{'graphs'}->{'net'} = [{x => $time, y => [0, 0]}] if (has_stats('proc', 'network')); return $stats; } # Collect a current snapshot of system stats and graph points sub get_stats_now { my %data; my $graphs = {}; my $gadd = sub { my $time = time(); my ($k, $d) = @_; $graphs->{$k} = [] if (ref($graphs->{$k}) ne 'ARRAY'); push(@{$graphs->{$k}}, {x => $time, y => $d}); # Release memory undef($d); }; # Collect stats if ($foreign_check_proc) { # CPU stats if ($acl_system_status->{'cpu'}) { my @cpuinfo = defined(&proc::get_cpu_info) ? proc::get_cpu_info() : (); my @cpuusage = defined(&proc::get_cpu_io_usage) ? proc::get_cpu_io_usage() : (); if (@cpuinfo && @cpuusage) { # CPU load my $cpu = theme_clamp_percent($cpuusage[0] + $cpuusage[1] + $cpuusage[3]); $data{'cpu'} = [$cpu, stats_text('body_load', ($cpuinfo[0], $cpuinfo[1], $cpuinfo[2]))]; $gadd->('cpu', $cpu); # Disk I/O my $in = $cpuusage[5]; my $out = $cpuusage[6]; if (has_stats('proc', 'disk') && (($in && $out) || $in eq '0' || $out eq '0')) { $data{'io'} = [$in, $out]; $gadd->('disk', [$in, $out]); } # Release memory undef(@cpuinfo); undef(@cpuusage); } } # Memory stats if ($acl_system_status->{'mem'}) { my @memory = defined(&proc::get_memory_info) ? proc::get_memory_info() : (); if (@memory) { $data{'mem'} = []; $data{'virt'} = []; if (@memory && $memory[0] && $memory[0] > 0) { my $mem = (100 - int(($memory[1] / $memory[0]) * 100)); $data{'mem'} = [$mem, stats_text(($memory[4] ? 'body_used_cached_total' : 'body_used'), nice_size($memory[0] * 1024), nice_size(($memory[0] - $memory[1]) * 1024), ($memory[4] ? nice_size($memory[4] * 1024) : undef) )]; $gadd->('mem', $mem); } if (@memory && $memory[2] && $memory[2] > 0) { my $virt = (100 - int(($memory[3] / $memory[2]) * 100)); $data{'virt'} = [$virt, stats_text('body_used', nice_size(($memory[2]) * 1024), nice_size(($memory[2] - $memory[3]) * 1024) )]; $gadd->('virt', $virt); } # Release memory undef(@memory); } } # Number of running processes if ($acl_system_status->{'load'}) { my $proc = proc::count_processes(); $data{'proc'} = $proc; $gadd->('proc', $proc); } } # Network I/O if (has_stats('proc', 'network') && $acl_system_status->{'load'}) { my $nrs = stats_network(); my ($in, $out) = @{$nrs}; if ($in && $out || $in eq '0' || $out eq '0') { $data{'net'} = [$in, $out]; $gadd->('net', [$in, $out]); } # Release memory undef($nrs); undef($in); undef($out); } # Temperature and fans if ($acl_system_status->{'temp'}) { my ($cpu, $fans) = defined(&proc::get_current_cpu_data) ? proc::get_current_cpu_data() : (undef, undef); if ($cpu || $fans) { $data{'sensors'} = [{cpu => $cpu, fans => $fans}]; } } # Reverse output for LTR users if (get_text_ltr()) { my @watched = ('mem', 'virt', 'disk'); foreach my $key (@watched) { if ($data{$key} && $data{$key}[1]) { $data{$key}[1] = reverse_string($data{$key}[1], "/"); } } } # Assign data $data{'graphs'} = $graphs; # Release memory undef($graphs); # Return data return \%data; } # Deep clone given data structures sub deep_clone { my ($value) = @_; my $reftype = ref($value); return $value if (!$reftype); if ($reftype eq 'ARRAY') { return [map { deep_clone($_) } @{$value}]; } if ($reftype eq 'HASH') { my %copy = map { $_ => deep_clone($value->{$_}) } keys %{$value}; return \%copy; } return $value; } # Read persisted history chunks and return merged graph data sub get_stats_history { my ($noempty) = @_; my $file = get_stats_history_file(); my $graphs = {}; if (-r $file) { my $fh; if (!open($fh, '<', $file)) { error_stderr("Failed to open file '$file' for reading: $!"); } elsif (!flock($fh, LOCK_SH)) { error_stderr("Failed to acquire shared lock on file '$file': $!"); close($fh); } else { while (my $line = <$fh>) { $line =~ s/^\s+|\s+$//g; next if (!length($line)); my $chunk = jsonify($line); next if (!keys %{$chunk}); $graphs = merge_stats($graphs, $chunk); } flock($fh, LOCK_UN); close($fh); } } # No data yet if (!keys %{$graphs}) { unlink($file); return $noempty ? undef : get_stats_empty(); } # Check if data is right foreach my $k (keys %{$graphs}) { if (ref($graphs->{$k}) ne 'ARRAY') { $graphs->{$k} = []; } } # Check if still avilable based on current ACLs my %map = (cpu => ['cpu', 'disk'], mem => ['mem', 'virt'], load => ['proc', 'net', 'temp']); foreach my $key (keys %map) { my $feature = $acl_system_status->{$key}; unless ($feature) { foreach my $skey (@{$map{$key}}) { delete $graphs->{$skey}; } } } # Trim dataset trim_stats_history($graphs); # No data is available anymore if (!keys %{$graphs}) { unlink($file); return $noempty ? undef : get_stats_empty(); } # Return data return { graphs => $graphs }; } # Keep only graph points within configured retention window sub trim_stats_history { my ($graphs) = @_; my $time = time(); my $get_default_graph = sub { my ($key, $time) = @_; my $default = get_stats_empty(); return $default->{'graphs'}{$key}; }; my $n = get_stats_option('stored_duration', 1) || 1200; if ($n < 300 || $n > 86400) { $n = 1200; } foreach my $k (keys %{$graphs}) { my $graph = $graphs->{$k}; if (ref($graph) ne 'ARRAY') { $graphs->{$k} = $get_default_graph->($k, $time); next; } my $write_idx = 0; foreach my $entry (@{$graph}) { if (defined($entry) && ($time - $entry->{'x'}) <= $n) { $graph->[$write_idx++] = $entry; } } $#{$graph} = $write_idx - 1; $graphs->{$k} = $write_idx ? $graph : $get_default_graph->($k, $time); } } # Merge graph arrays from second hash into first hash in-place sub merge_stats { my ($graphs1, $graphs2) = @_; foreach my $key (keys %{$graphs2}) { if (exists($graphs1->{$key})) { push(@{$graphs1->{$key}}, @{$graphs2->{$key}}); } else { $graphs1->{$key} = $graphs2->{$key}; } } # Release memory undef($graphs2); return $graphs1; } # Append one JSON graph chunk line to the history file sub append_stats_history_chunk { my ($file, $graphs_chunk) = @_; my $chunk_json = $json->encode($graphs_chunk); my $fh; if (!open($fh, '+>>', $file)) { error_stderr("Failed to open file '$file' for appending: $!"); return 0; } if (!flock($fh, LOCK_EX)) { error_stderr("Failed to acquire exclusive lock on file '$file': $!"); close($fh); return 0; } my $size = -s $fh; if ($size) { seek($fh, -1, 2); my $last_char = ''; read($fh, $last_char, 1); print $fh "\n" if ($last_char ne "\n"); } if (!print $fh $chunk_json . "\n") { error_stderr("Failed to append data to file '$file': $!"); flock($fh, LOCK_UN); close($fh); return 0; } flock($fh, LOCK_UN); close($fh); return 1; } # Compact chunked history into one merged snapshot line sub compact_stats_history_file { my ($file) = @_; my $history = get_stats_history(1); if ($history && $history->{'graphs'} && keys %{$history->{'graphs'}}) { theme_write_file_contents( $file, $json->encode($history->{'graphs'}) . "\n"); } else { unlink($file); } } # Persist one history chunk and trigger periodic file compaction sub save_stats_history { # Append chunk and periodically compact full history dataset my ($graphs_chunk) = @_; my $file = get_stats_history_file(); append_stats_history_chunk($file, $graphs_chunk); state $save_counter = 0; $save_counter++; if ($save_counter % 30 == 0 || (-s $file || 0) > 5 * 1024 * 1024) { compact_stats_history_file($file); } # Release memory undef($graphs_chunk); } # Persist non-graph "current stats" snapshot for quick reads sub save_stats_now { # Store stats now data my ($stats_now) = @_; delete($stats_now->{'graphs'}); theme_write_file_contents( get_stats_now_file(), $json->encode($stats_now)); } # Cache dynamic feature availability checks per module/type pair sub has_stats { my ($mod, $type) = @_; state %cache; my $cached_func = "$mod:$type"; return $cache{$cached_func} if (exists($cache{$cached_func})); my $func_name = "${mod}::has_${type}_stats"; my $func_ref = \&{$func_name} if defined(&{$func_name}); $cache{$cached_func} = $func_ref ? $func_ref->() : 0; return $cache{$cached_func}; } # Detect whether virtual memory metrics are available sub has_stats_virt { state $has_virt_memory; return $has_virt_memory if defined($has_virt_memory); if (defined(&proc::get_memory_info)) { my @m = &proc::get_memory_info(); if (@m && $m[2]) { $has_virt_memory = 1; return 1; } } $has_virt_memory = 0; return 0; } # Prefer /proc stats and fall back to netstat stats collection sub stats_network { return stats_network_proc() || stats_network_netstat(); } # Read network I/O from /proc/net/dev and compute per-second rates sub stats_network_proc { # Return if not available state $no_stats_network_proc = 0; return [] if ($no_stats_network_proc); # Get network data from all interfaces my ($await) = @_; my $file = "/proc/net/dev"; if (!-r $file) { $no_stats_network_proc = 1; return []; } # Read and parse network data my (@titles, %result); open(my $dev, $file); while (my $line = <$dev>) { chomp($line); if ($line =~ /^.{6}\|([^\\]+)\|([^\\]+)$/) { my ($rec, $trans) = ($1, $2); @titles = ((map {"r$_"} split(/\s+/, $rec)), (map {"t$_"} split(/\s+/, $trans))); } elsif ($line =~ /^\s*([^:]+):\s*(.*)$/) { my ($id, @data) = ($1, split(/\s+/, $2)); $result{$id} = { map {$titles[$_] => $data[$_];} (0 .. $#titles) }; } } close($dev); # Return current network I/O if (!$await) { my ($rbytes, $tbytes, $rbytes2, $tbytes2) = (0, 0, 0, 0); my @rs; my $results = \%result; # Parse current data foreach (keys %$results) { $rbytes += $results->{$_}->{'rbytes'}; $tbytes += $results->{$_}->{'tbytes'}; } # Wait for quater of a second and fetch data over again my $wait_interval = 0.25; select(undef, undef, undef, $wait_interval); $results = stats_network_proc(1); # Parse data after delay foreach (keys %$results) { $rbytes2 += $results->{$_}->{'rbytes'}; $tbytes2 += $results->{$_}->{'tbytes'}; } # Return current network I/O (per second) $rbytes = int(($rbytes2 - $rbytes) / $wait_interval); $tbytes = int(($tbytes2 - $tbytes) / $wait_interval); # Return data @rs = ($rbytes, $tbytes); return \@rs; } return \%result; } # Fallback network I/O collector using netstat snapshots sub stats_network_netstat { state $no_stats_network_netstat = 0; # Return if not available return [] if ($no_stats_network_netstat); # Check if netstat is available if (!has_command('netstat')) { $no_stats_network_netstat = 1; return []; } # Quarter of a second interval my $interval = 0.25; # Capture network stats my $get_net_stats = sub { my %stats; open(my $netstat, '-|', 'netstat -ibn'); while (<$netstat>) { next if $. == 1; # Skip header my @fields = split; my $iface = $fields[0]; next if $iface =~ /\*$/; my $ibytes = $fields[-5]; my $obytes = $fields[-2]; $stats{$iface} = [$ibytes, $obytes]; } close($netstat); return \%stats; }; # Capture initial network statistics my $before_stats = $get_net_stats->(); select(undef, undef, undef, $interval); # Capture network statistics after the interval my $after_stats = $get_net_stats->(); # Calculate the total received and transmitted bytes my ($total_rx_before, $total_tx_before, $total_rx_after, $total_tx_after) = (0, 0, 0, 0); foreach my $iface (keys %$before_stats) { $total_rx_before += $before_stats->{$iface}->[0]; $total_tx_before += $before_stats->{$iface}->[1]; $total_rx_after += $after_stats->{$iface}->[0]; $total_tx_after += $after_stats->{$iface}->[1]; } my $rbytes = ($total_rx_after - $total_rx_before) / $interval; my $tbytes = ($total_tx_after - $total_tx_before) / $interval; $rbytes = $rbytes < 0 ? 0 : $rbytes; $tbytes = $tbytes < 0 ? 0 : $tbytes; my @rs = ($rbytes, $tbytes); return \@rs; } 1;
Save File
Cancel