Diff -- /var/www/vhosts/3dshawn.com/admin.3dshawn.com/MODS/MetaAdmin/Stats.pm

O Operator
Diff

/var/www/vhosts/3dshawn.com/admin.3dshawn.com/MODS/MetaAdmin/Stats.pm

added on local at 2026-07-10 10:11:47

Added
+367
lines
Removed
-0
lines
Context
0
unchanged
Blobs
from
to 7e20eaaa93e5
Restore this content →
Unified diff
Naive LCS-based line diff. Additions in emerald, deletions in rose. Both sides decompressed live from BLOB_STORE.
1package MODS::MetaAdmin::Stats;
2#======================================================================
3# Meta-Admin -- server stats reader. Plain shell + /proc reads, no
4# CPAN deps. Returns plain hashrefs that server.cgi feeds into
5# hand-rolled SVG graphs.
6#======================================================================
7use strict;
8use warnings;
9
10sub new { return bless({}, shift); }
11
12sub _shell {
13 my $cmd = shift;
14 my $out = `$cmd 2>/dev/null`;
15 $out = '' unless defined $out;
16 chomp $out;
17 return $out;
18}
19
20# _shell_du: run `du -sb <path>` via sudo if a narrow sudoers entry
21# is installed (see /etc/sudoers.d/meta_admin_stats). Falls back to
22# unprivileged du if sudo -n fails -- caller still gets a number,
23# just under-reported for paths owned by other Plesk users.
24sub _shell_du {
25 my $path = shift;
26 return 0 unless defined $path && length $path;
27 return 0 if $path =~ /[`;\$\|]/;
28 my $out = `sudo -n /usr/bin/du -sb '$path' 2>/dev/null | awk '{print \$1}'`;
29 chomp $out;
30 if (!$out || $out !~ /^\d+$/) {
31 # Sudo unavailable -- best-effort as the CGI user.
32 $out = `du -sb '$path' 2>/dev/null | awk '{print \$1}'`;
33 chomp $out;
34 }
35 return ($out && $out =~ /^\d+$/) ? ($out + 0) : 0;
36}
37
38#---------------------------------------------------------------------
39# Disk on the root partition. Returns { total_b, used_b, avail_b }.
40#---------------------------------------------------------------------
41sub disk_root {
42 my $self = shift;
43 return $self->disk_for('/');
44}
45
46#---------------------------------------------------------------------
47# Disk stats for any mount path. Returns { total_b, used_b, avail_b }.
48# Used for the "Sites partition" module -- portfolio sites live on
49# /var so the meaningful headline number is /var, not /.
50#---------------------------------------------------------------------
51sub disk_for {
52 my ($self, $path) = @_;
53 $path //= '/';
54 return { total_b => 0, used_b => 0, avail_b => 0 }
55 if $path =~ /[`;\$\|]/; # shell-injection belt-and-suspenders
56 my $line = _shell("df -B1 '$path' | tail -1");
57 my @p = split /\s+/, $line;
58 return { total_b => 0, used_b => 0, avail_b => 0 } unless @p >= 4;
59 return {
60 total_b => $p[1] + 0,
61 used_b => $p[2] + 0,
62 avail_b => $p[3] + 0,
63 };
64}
65
66#---------------------------------------------------------------------
67# Where is /var space going? du -sb on a handful of well-known
68# top-level subdirs so the caller can render a stacked-bar or
69# categorized-list "what's eating /var" breakdown. Returns arrayref
70# of { label, path, used_b, color } biggest-first, with an implicit
71# "Other" bucket = /var - sum(named).
72#---------------------------------------------------------------------
73sub var_breakdown {
74 my $self = shift;
75 # Non-overlapping top-level probes -- each path is a direct child of
76 # /var so there's no double-counting into the "Other" bucket.
77 my @probes = (
78 { label => 'Databases + Plesk state', path => '/var/lib', color => '#7c3aed' },
79 { label => 'Web hosting', path => '/var/www', color => '#b53048' },
80 { label => 'Mail spool', path => '/var/qmail', color => '#06b6d4' },
81 { label => 'Plesk cache', path => '/var/cache', color => '#059669' },
82 { label => 'Logs', path => '/var/log', color => '#92400e' },
83 { label => 'Imunify360 security', path => '/var/imunify360', color => '#f97316' },
84 { label => 'Spool + tmp', path => '/var/spool', color => '#a855f7' },
85 );
86 my @out;
87 my $named_sum = 0;
88 foreach my $p (@probes) {
89 my $b = _shell_du($p->{path});
90 next unless $b > 0;
91 push @out, { %$p, used_b => $b };
92 $named_sum += $b;
93 }
94 @out = sort { $b->{used_b} <=> $a->{used_b} } @out;
95
96 # "Other" bucket = /var total-used minus everything we named.
97 my $var = $self->disk_for('/var');
98 my $other = ($var->{used_b} || 0) - $named_sum;
99 push @out, {
100 label => 'Other',
101 path => '/var (uncategorized)',
102 used_b => ($other > 0 ? $other : 0),
103 color => '#4a1a20',
104 } if $other > 0;
105
106 return \@out;
107}
108
109#---------------------------------------------------------------------
110# All mounted filesystems (skip RAM-backed pseudo-FS like tmpfs/devtmpfs).
111# Returns arrayref of { mount, fstype, device, total_b, used_b, avail_b,
112# used_pct }, ordered biggest-first. Empty on failure.
113#---------------------------------------------------------------------
114sub partitions {
115 my $self = shift;
116 # -P = POSIX (one row per FS, no wrapping), -T = include Type column,
117 # -B1 = bytes. Columns: source fstype 1-blocks used avail capacity mount.
118 my $out = _shell('df -PTB1 2>/dev/null');
119 my @rows;
120 foreach my $line (split /\n/, $out) {
121 next if $line =~ /^Filesystem\s+Type/; # header
122 my @p = split /\s+/, $line;
123 next unless @p >= 7;
124 my ($src, $fs, $total, $used, $avail, undef, $mnt) = @p;
125 # Real filesystems only -- skip RAM / cgroup / overlay pseudo-mounts.
126 next if $fs =~ /^(tmpfs|devtmpfs|cgroup|cgroup2|proc|sysfs|debugfs|tracefs|securityfs|pstore|autofs|overlay|squashfs|efivarfs|fuse\.\w+|nsfs|mqueue|hugetlbfs|configfs|bpf|ramfs|none)$/;
127 next if $src eq 'none';
128 $total += 0; $used += 0; $avail += 0;
129 next unless $total > 0;
130 my $pct = int(($used / $total) * 100 + 0.5);
131 push @rows, {
132 device => $src,
133 fstype => $fs,
134 mount => $mnt,
135 total_b => $total,
136 used_b => $used,
137 avail_b => $avail,
138 used_pct => $pct,
139 };
140 }
141 @rows = sort { $b->{total_b} <=> $a->{total_b} } @rows;
142 return \@rows;
143}
144
145#---------------------------------------------------------------------
146# Physical disk layout. lsblk in JSON when available (util-linux 2.27+),
147# else fall back to plain text. Returns arrayref of top-level disks:
148# { name, size_b, model, is_raid_member }. Empty on failure.
149#---------------------------------------------------------------------
150sub physical_disks {
151 my $self = shift;
152 my $out = _shell('lsblk -b -d -n -o NAME,SIZE,TYPE,MODEL 2>/dev/null');
153 my @disks;
154 foreach my $line (split /\n/, $out) {
155 # Split with limit=4 so MODEL can contain spaces
156 my ($name, $size, $type, $model) = split /\s+/, $line, 4;
157 next unless $name && $type && $type eq 'disk';
158 $model //= ''; $model =~ s/\s+$//;
159 push @disks, {
160 name => $name,
161 size_b => ($size || 0) + 0,
162 model => $model || '',
163 };
164 }
165 return \@disks;
166}
167
168#---------------------------------------------------------------------
169# site_footprints -- combined per-site disk + RAM view for the Websites
170# Folders / Sites RAM modules on /server.cgi. Returns arrayref of
171# { slug, display_name, brand_color, vhost_path, owner_user,
172# disk_b, ram_b } sorted by disk usage desc.
173#
174# RAM per site is the sum of RSS (bytes) of every currently-live
175# process owned by that vhost's Linux user (from stat -c %U). CGI
176# sites hold no RAM between requests -- if you see 0 for one, the
177# CGI just isn't executing right now.
178#---------------------------------------------------------------------
179sub site_footprints {
180 my ($self, $sites) = @_;
181 $sites ||= [];
182
183 # One ps sweep, aggregate RSS (kB) by owner user.
184 my %ram_by_user;
185 foreach my $line (split /\n/, _shell('ps -eo user:32,rss --no-headers 2>/dev/null')) {
186 $line =~ s/^\s+//;
187 my ($user, $rss_kb) = split /\s+/, $line, 2;
188 next unless $user && defined $rss_kb && $rss_kb =~ /^\d+$/;
189 $ram_by_user{$user} += $rss_kb + 0;
190 }
191
192 my @out;
193 foreach my $srow (@$sites) {
194 my $path = $srow->{vhost_path} or next;
195 next unless $path =~ m{^/};
196 next if $path =~ /[`;\$\|]/; # belt-and-suspenders shell-injection guard
197
198 # stat first -- if it fails the vhost user disallows traversal
199 # from this Perl process, so du will also fail. Mark disk/ram
200 # as undef (renderer shows "n/a" + a footnote).
201 my $stat_out = _shell("stat -c '%U' '$path' 2>&1");
202 my $owner = ($stat_out =~ /^([A-Za-z_][A-Za-z0-9_-]{0,31})$/) ? $1 : '';
203 my $unreachable = !$owner;
204
205 my ($du_b, $ram_b);
206 if ($unreachable) {
207 $du_b = undef;
208 $ram_b = undef;
209 } else {
210 my $du_out = _shell("du -sb '$path' 2>/dev/null | awk '{print \$1}'");
211 $du_b = ($du_out =~ /^\d+$/) ? ($du_out + 0) : 0;
212 $ram_b = exists $ram_by_user{$owner}
213 ? ($ram_by_user{$owner} * 1024) : 0;
214 }
215
216 push @out, {
217 slug => $srow->{slug},
218 display_name => $srow->{display_name},
219 brand_color => $srow->{brand_color} || '#807aa8',
220 vhost_path => $path,
221 owner_user => $owner,
222 disk_b => $du_b,
223 ram_b => $ram_b,
224 unreachable => $unreachable,
225 };
226 }
227 @out = sort {
228 ($b->{disk_b} // -1) <=> ($a->{disk_b} // -1)
229 } @out;
230 return \@out;
231}
232
233#---------------------------------------------------------------------
234# Per-vhost disk: du -sb on each path. Slow-ish on large vhosts but
235# bounded (the dirs we're crawling are tens of MB to single-digit GB).
236#---------------------------------------------------------------------
237sub disk_per_vhost {
238 my ($self, $paths) = @_;
239 $paths ||= [];
240 my @out;
241 foreach my $row (@$paths) {
242 my $path = $row->{vhost_path} or next;
243 next unless $path =~ m{^/};
244 next if $path =~ /[`;\$\|]/; # belt-and-suspenders on shell injection
245 my $b = _shell("du -sb '$path' 2>/dev/null | awk '{print \$1}'");
246 $b = ($b =~ /^\d+$/) ? ($b + 0) : 0;
247 push @out, {
248 slug => $row->{slug},
249 display_name => $row->{display_name},
250 brand_color => $row->{brand_color} || '#807aa8',
251 vhost_path => $path,
252 used_b => $b,
253 };
254 }
255 @out = sort { $b->{used_b} <=> $a->{used_b} } @out;
256 return \@out;
257}
258
259#---------------------------------------------------------------------
260# Memory. /proc/meminfo in KB.
261#---------------------------------------------------------------------
262sub memory {
263 my $self = shift;
264 my %m;
265 if (open my $fh, '<', '/proc/meminfo') {
266 while (<$fh>) {
267 chomp;
268 if (/^(\S+):\s+(\d+)/) {
269 $m{$1} = $2 * 1024; # to bytes
270 }
271 }
272 close $fh;
273 }
274 my $total = $m{MemTotal} || 0;
275 my $avail = $m{MemAvailable} || $m{MemFree} || 0;
276 my $used = $total - $avail;
277 my $cached = $m{Cached} || 0;
278 my $buf = $m{Buffers} || 0;
279 my $swap_t = $m{SwapTotal} || 0;
280 my $swap_f = $m{SwapFree} || 0;
281 my $swap_u = $swap_t - $swap_f;
282 return {
283 total_b => $total, used_b => $used, avail_b => $avail,
284 cached_b => $cached, buffers_b => $buf,
285 swap_total_b => $swap_t, swap_used_b => $swap_u,
286 };
287}
288
289#---------------------------------------------------------------------
290# Load + uptime + cpu count.
291#---------------------------------------------------------------------
292sub cpu {
293 my $self = shift;
294 my %r = ( cores => 0, load1 => 0, load5 => 0, load15 => 0, uptime_s => 0 );
295 if (open my $fh, '<', '/proc/loadavg') {
296 my $line = <$fh>; close $fh;
297 chomp $line;
298 my @p = split /\s+/, $line;
299 $r{load1} = ($p[0] || 0) + 0;
300 $r{load5} = ($p[1] || 0) + 0;
301 $r{load15} = ($p[2] || 0) + 0;
302 }
303 if (open my $fh, '<', '/proc/cpuinfo') {
304 while (<$fh>) { $r{cores}++ if /^processor\s*:/; }
305 close $fh;
306 }
307 if (open my $fh, '<', '/proc/uptime') {
308 my $line = <$fh>; close $fh;
309 my ($up) = split /\s+/, $line;
310 $r{uptime_s} = ($up || 0) + 0;
311 }
312 return \%r;
313}
314
315#---------------------------------------------------------------------
316# Hostname + kernel + distro fingerprint.
317#---------------------------------------------------------------------
318sub host {
319 my $self = shift;
320 return {
321 host => _shell('hostname'),
322 kernel => _shell('uname -r'),
323 os => _shell('grep PRETTY_NAME /etc/os-release | head -1 | sed -e \'s/^[^=]*=//\' -e \'s/"//g\''),
324 };
325}
326
327#---------------------------------------------------------------------
328# Top 5 processes by CPU usage. Returns arrayref of { pid, user, cpu,
329# mem, cmd }.
330#---------------------------------------------------------------------
331sub top_processes {
332 my $self = shift;
333 my $out = _shell("ps -eo pid,user,pcpu,pmem,comm --sort=-pcpu | head -6 | tail -5");
334 my @rows;
335 foreach my $line (split /\n/, $out) {
336 $line =~ s/^\s+//;
337 my ($pid, $user, $cpu, $mem, $cmd) = split /\s+/, $line, 5;
338 next unless defined $pid && $pid =~ /^\d+$/;
339 push @rows, {
340 pid => $pid, user => $user, cpu => ($cpu+0), mem => ($mem+0), cmd => $cmd,
341 };
342 }
343 return \@rows;
344}
345
346sub human_size {
347 my $b = shift; $b = 0 unless defined $b && $b =~ /^-?\d+(\.\d+)?$/;
348 my $sign = $b < 0 ? '-' : '';
349 my $a = abs($b);
350 if ($a >= 1024**4) { return sprintf('%s%.1f TB', $sign, $a / 1024**4); }
351 if ($a >= 1024**3) { return sprintf('%s%.1f GB', $sign, $a / 1024**3); }
352 if ($a >= 1024**2) { return sprintf('%s%.1f MB', $sign, $a / 1024**2); }
353 if ($a >= 1024) { return sprintf('%s%.1f KB', $sign, $a / 1024); }
354 return sprintf('%s%d B', $sign, $a);
355}
356
357sub human_uptime {
358 my $s = shift; $s = 0 unless $s;
359 my $d = int($s / 86400);
360 my $h = int(($s % 86400) / 3600);
361 my $m = int(($s % 3600) / 60);
362 return sprintf('%dd %dh %dm', $d, $h, $m) if $d;
363 return sprintf('%dh %dm', $h, $m) if $h;
364 return sprintf('%dm', $m);
365}
366
3671;