#!/usr/bin/env perl
# Copyright (c) 2026 Petr Balvín <opensource@petrbalvin.org> (https://petrbalvin.org)
# SPDX-License-Identifier: MIT

# System diagnostics: CPU, memory, disk, network, GPU, services, security,
# performance, recent issues, and a health score with a letter grade.
#
# The data comes from /proc, /sys and system tools, and every source has a graceful
# fallback, so a missing tool is reported as unavailable rather than as a fault.
#
# Perl builtins only: no module has to be installed.  What that costs here:
#
#   * the command runner, which forks and keeps stdout and stderr apart in the
#     scratch directory;
#   * the section collectors, which run as forked children because the sections
#     are independent and each is dominated by waiting, each writing its result
#     as a Perl literal that the parent reads back;
#   * a JSON encoder for --json, with two details Perl's data model forces: the
#     values rounded to a decimal are held as numeric strings so 0.0 does not
#     come out as 0, and the boolean fields are listed by path because Perl has
#     no boolean type.  Object keys are written in sorted order, so the document
#     is stable from run to run.
#   * file system sizes, which Perl's builtins do not expose, so `stat -f` is
#     the transport, printing exactly the four numbers the arithmetic uses.
#
# One visible consequence of forking the section collectors is that they appear in
# the report's own top-process lists: the
# readings are real, the workers just happen to be the busiest thing at that moment.
#
# GPU detection reports AMD through rocm-smi, and any card at all through lspci when
# no driver tooling is present.  No vendor tooling beyond AMD's is queried: the
# NVIDIA driver stack is banned by AGENTS.md, so nothing here reaches for it, and a
# card from that vendor is described by lspci like any other hardware.
#
# External binaries used: who, ip, ss, iostat, ps, stat, systemctl, getenforce,
# firewall-cmd, journalctl, last, lspci, rocm-smi, curl and uname.
#
# Linux only.  Progress goes to stderr, the report to stdout.
#
# Usage:
#     system-diag.pl                        # full report
#     system-diag.pl --section cpu,memory   # only selected sections
#     system-diag.pl --external-ip          # also detect external IPs (3rd-party)
#     system-diag.pl --json                 # machine-readable output
#     system-diag.pl --version

use strict;
use warnings;

my $VERSION = '2.0.0';

# Colour follows NO_COLOR (https://no-color.org): it, or a stdout that is not a
# terminal, disables every escape.
my ($BOLD, $RED, $GREEN, $YELLOW, $CYAN, $MAGENTA, $DIM, $RESET) = (
    "\033[1m", "\033[31m", "\033[32m", "\033[33m",
    "\033[36m", "\033[35m", "\033[2m", "\033[0m",
);
if (defined $ENV{NO_COLOR} || !-t STDOUT) {
    ($BOLD, $RED, $GREEN, $YELLOW, $CYAN, $MAGENTA, $DIM, $RESET) = ('') x 8;
}

# Letter grade to colour, applied when rendering only.
my %GRADE_COLOURS = (A => $GREEN, B => $GREEN, C => $YELLOW, D => $YELLOW, F => $RED);

my $WIDTH = 60;

my @ALL_SECTIONS = qw(
    overview cpu memory disk network gpu services security performance issues
);

# The GPU card properties in the order their sources list them: lspci reports model,
# vendor and driver, and rocm-smi reports the card id and then its own properties.
my @CARD_KEY_ORDER = ('model', 'vendor', 'driver', 'id', 'Card series', 'Card model');

# Paths whose value is written as true or false, not as 1 or 0.
my @JSON_BOOLEANS = (
    'disk.container',
    'gpu.fallback',
    'gpu.unavailable',
    'security.firewalld.available',
    'security.firewalld.active',
);
my %JSON_BOOLEAN = map { $_ => 1 } @JSON_BOOLEANS;

# Paths whose value is written as a string even when it looks like a number:
# every property of a GPU card is parsed text, and a per-core CPU index is written
# as a string.  Without this they would go out unquoted and a reader would take them
# for numbers.
my @JSON_STRING_PATHS = (
    qr/^gpu\.cards\./,
    qr/^cpu\.per_core\.cpu$/,
);

my $TMP_DIR;           # private scratch directory, created only when needed
my $PARENT_PID = $$;   # a forked child must never clean up for the parent
my $RUN_SEQ = 0;       # per-call suffix for the runner's files

# ---------------------------------------------------------------------------
# Progress, on stderr so stdout stays clean
# ---------------------------------------------------------------------------

sub _status {
    my ($msg) = @_;
    print STDERR "  $msg...";
    return;
}

sub _status_done {
    my ($msg) = @_;
    $msg = 'done' unless defined $msg;
    print STDERR " $msg\n";
    return;
}

# ---------------------------------------------------------------------------
# Commands, files and small helpers
# ---------------------------------------------------------------------------

sub find_exe {
    my ($name) = @_;
    return undef unless defined $name && length $name;
    if (index($name, '/') >= 0) {
        return (-f $name && -x _) ? $name : undef;
    }
    for my $dir (split /:/, ($ENV{PATH} // '')) {
        next unless length $dir;
        my $path = "$dir/$name";
        return $path if -f $path && -x _;
    }
    return undef;
}

sub scratch_dir {
    return $TMP_DIR if defined $TMP_DIR;
    my $base = $ENV{TMPDIR} // '/tmp';
    for my $attempt (0 .. 9) {
        my $dir = "$base/system-diag.$$" . ($attempt ? ".$attempt" : '');
        if (mkdir($dir, 0700)) {
            $TMP_DIR = $dir;
            return $dir;
        }
    }
    die "cannot create a scratch directory under $base\n";
}

sub remove_scratch {
    return unless defined $TMP_DIR;
    # The collectors fork, and a forked child inherits the END block: only the
    # process that created the directory may remove it.
    return unless $$ == $PARENT_PID;
    if (opendir(my $dh, $TMP_DIR)) {
        for my $entry (readdir($dh)) {
            next if $entry eq '.' || $entry eq '..';
            unlink("$TMP_DIR/$entry");
        }
        closedir($dh);
    }
    rmdir($TMP_DIR);
    undef $TMP_DIR;
    return;
}

sub slurp {
    my ($path) = @_;
    open(my $fh, '<', $path) or return '';
    my $text = do { local $/ = undef; <$fh> };
    close($fh);
    return defined $text ? $text : '';
}

# Run a command and return { rc, out, err }.  The locale is forced to C for
# English output, and a timeout or a missing binary yields empty output rather
# than an exception, which is the contract every caller below expects.
sub run {
    my ($cmd, $timeout) = @_;
    $timeout = 15 unless defined $timeout;

    my $exe = find_exe($cmd->[0]);
    return { rc => 127, out => '', err => '' } unless defined $exe;

    my $dir = scratch_dir();
    $RUN_SEQ++;
    my $out_file = "$dir/out.$$.$RUN_SEQ";
    my $err_file = "$dir/err.$$.$RUN_SEQ";

    my $pid = fork();
    die "cannot fork: $!\n" unless defined $pid;
    if ($pid == 0) {
        if (open(STDOUT, '>', $out_file) && open(STDERR, '>', $err_file)) {
            $ENV{LANG} = 'C';
            $ENV{LC_ALL} = 'C';
            exec { $exe } @$cmd;
        }
        exit 126;
    }

    my $timed_out = 0;
    eval {
        local $SIG{ALRM} = sub { die "alarm\n" };
        alarm($timeout);
        waitpid($pid, 0);
        alarm(0);
        1;
    } or do { $timed_out = 1; alarm(0) };

    my $rc;
    if ($timed_out) {
        kill('TERM', $pid);
        select(undef, undef, undef, 0.1);
        kill('KILL', $pid);
        waitpid($pid, 0);
        $rc = 124;
    }
    else {
        $rc = $? >> 8;
    }

    my $out = slurp($out_file);
    my $err = slurp($err_file);
    unlink($out_file, $err_file);
    return { rc => $rc, out => $timed_out ? '' : $out, err => $timed_out ? '' : $err };
}

sub read_file {
    my ($path) = @_;
    open(my $fh, '<', $path) or return '';
    my $text = do { local $/ = undef; <$fh> };
    close($fh);
    return '' unless defined $text;
    $text =~ s/^\s+//;
    $text =~ s/\s+$//;
    return $text;
}

sub read_lines {
    my ($path) = @_;
    open(my $fh, '<', $path) or return [];
    my @lines;
    while (my $line = <$fh>) {
        $line =~ s/^\s+//;
        $line =~ s/\s+$//;
        push @lines, $line;
    }
    close($fh);
    return \@lines;
}

sub uname {
    my ($flag) = @_;
    my $p = run(['uname', $flag], 5);
    my $value = $p->{out};
    $value =~ s/^\s+//;
    $value =~ s/\s+$//;
    return $value;
}

# A textual usage bar: filled and empty cells with the percentage at the end.
sub _bar {
    my ($value, $maximum, $width) = @_;
    $maximum = 100.0 unless defined $maximum;
    $width = 20 unless defined $width;
    my $ratio = $maximum > 0 ? $value / $maximum : 0.0;
    $ratio = 0.0 if $ratio < 0.0;
    $ratio = 1.0 if $ratio > 1.0;
    my $filled = int($ratio * $width);
    my $colour = $ratio < 0.80 ? $GREEN : $ratio < 0.90 ? $YELLOW : $RED;
    my $bar = $colour . ("█" x $filled) . $DIM . ("░" x ($width - $filled)) . $RESET;
    return $bar . '  ' . sprintf('%.0f%%', $ratio * 100);
}

# Seconds since the epoch in the local calendar, so a UTC offset can be derived.
sub _days_from_civil {
    my ($year, $month, $day) = @_;
    $year -= $month <= 2 ? 1 : 0;
    my $era = int(($year >= 0 ? $year : $year - 399) / 400);
    my $yoe = $year - $era * 400;
    my $doy = int((153 * ($month + ($month > 2 ? -3 : 9)) + 2) / 5) + $day - 1;
    my $doe = $yoe * 365 + int($yoe / 4) - int($yoe / 100) + $doy;
    return $era * 146097 + $doe - 719468;
}

# A +hhmm offset in the form strftime's %z prints.  Perl's localtime reports
# no offset, so the same instant is read as both local and UTC calendar time and
# the difference is the offset.
sub utc_offset {
    my ($t) = @_;
    my @lt = localtime($t);
    my @gt = gmtime($t);
    my $offset = (_days_from_civil($lt[5] + 1900, $lt[4] + 1, $lt[3]) * 1440 + $lt[2] * 60 + $lt[1])
               - (_days_from_civil($gt[5] + 1900, $gt[4] + 1, $gt[3]) * 1440 + $gt[2] * 60 + $gt[1]);
    my $sign = $offset < 0 ? '-' : '+';
    $offset = -$offset if $offset < 0;
    return sprintf('%s%02d%02d', $sign, int($offset / 60), $offset % 60);
}

sub timestamp_fields {
    my ($t) = @_;
    my @lt = localtime($t);
    return sprintf('%04d-%02d-%02dT%02d:%02d:%02d%s',
        $lt[5] + 1900, $lt[4] + 1, $lt[3], $lt[2], $lt[1], $lt[0], utc_offset($t));
}

# ---------------------------------------------------------------------------
# JSON, written by hand
# ---------------------------------------------------------------------------

sub json_encode {
    my ($value) = @_;
    my $out = '';
    json_render($value, '', 0, \$out);
    return $out . "\n";
}

sub json_quote {
    my ($text) = @_;
    my $bytes = $text;
    # Non-ASCII escapes as \uXXXX, so the byte string is decoded to characters
    # before escaping.
    utf8::decode($bytes);
    my $out = '"';
    for my $char (split //, $bytes) {
        my $code = ord($char);
        if ($char eq '"')  { $out .= '\\"' }
        elsif ($char eq '\\') { $out .= '\\\\' }
        elsif ($char eq "\b") { $out .= '\\b' }
        elsif ($char eq "\f") { $out .= '\\f' }
        elsif ($char eq "\n") { $out .= '\\n' }
        elsif ($char eq "\r") { $out .= '\\r' }
        elsif ($char eq "\t") { $out .= '\\t' }
        elsif ($code < 0x20)  { $out .= sprintf('\\u%04x', $code) }
        elsif ($code > 0x7e)  {
            if ($code > 0xffff) {
                my $rest = $code - 0x10000;
                $out .= sprintf('\\u%04x\\u%04x', 0xd800 + ($rest >> 10), 0xdc00 + ($rest & 0x3ff));
            }
            else {
                $out .= sprintf('\\u%04x', $code);
            }
        }
        else { $out .= $char }
    }
    return $out . '"';
}

sub json_render {
    my ($value, $path, $indent, $out) = @_;
    if (!defined $value) {
        $$out .= 'null';
        return;
    }
    if (ref $value eq 'HASH') {
        my @keys = sort keys %$value;
        if (!@keys) {
            $$out .= '{}';
            return;
        }
        $$out .= "{\n";
        for my $index (0 .. $#keys) {
            my $key = $keys[$index];
            my $child_path = length $path ? "$path.$key" : $key;
            $$out .= (' ' x (2 * ($indent + 1))) . json_quote($key) . ': ';
            json_render($value->{$key}, $child_path, $indent + 1, $out);
            $$out .= ',' if $index < $#keys;
            $$out .= "\n";
        }
        $$out .= (' ' x (2 * $indent)) . '}';
        return;
    }
    if (ref $value eq 'ARRAY') {
        if (!@$value) {
            $$out .= '[]';
            return;
        }
        $$out .= "[\n";
        for my $index (0 .. $#$value) {
            $$out .= ' ' x (2 * ($indent + 1));
            json_render($value->[$index], $path, $indent + 1, $out);
            $$out .= ',' if $index < $#$value;
            $$out .= "\n";
        }
        $$out .= (' ' x (2 * $indent)) . ']';
        return;
    }
    if ($JSON_BOOLEAN{$path}) {
        $$out .= $value ? 'true' : 'false';
        return;
    }
    if (grep { $path =~ $_ } @JSON_STRING_PATHS) {
        $$out .= json_quote("$value");
        return;
    }
    if ($value =~ /^-?(?:0|[1-9][0-9]*)(?:\.[0-9]+)?(?:[eE][-+]?[0-9]+)?$/) {
        $$out .= $value;
        return;
    }
    $$out .= json_quote($value);
    return;
}

# ---------------------------------------------------------------------------
# Section: system overview
# ---------------------------------------------------------------------------

sub parse_os_release {
    my %info;
    for my $line (@{ read_lines('/etc/os-release') }) {
        next unless index($line, '=') >= 0;
        my ($key, $value) = split /=/, $line, 2;
        $key =~ s/^\s+//;
        $key =~ s/\s+$//;
        $value = '' unless defined $value;
        $value =~ s/^\s+//;
        $value =~ s/\s+$//;
        $value =~ s/^"//;
        $value =~ s/"$//;
        $info{$key} = $value;
    }
    return \%info;
}

sub uptime_human {
    my ($seconds) = @_;
    $seconds = int($seconds);
    my $days = int($seconds / 86400);
    my $rem = $seconds % 86400;
    my $hours = int($rem / 3600);
    my $minutes = int(($rem % 3600) / 60);

    my @parts;
    push @parts, $days . ' day' . ($days != 1 ? 's' : '') if $days;
    push @parts, $hours . ' hour' . ($hours != 1 ? 's' : '') if $hours;
    push @parts, $minutes . ' minute' . ($minutes != 1 ? 's' : '') if $minutes || !@parts;
    return join(', ', @parts);
}

sub boot_time {
    for my $line (@{ read_lines('/proc/stat') }) {
        next unless index($line, 'btime ') == 0;
        my @fields = split ' ', $line;
        next unless @fields >= 2 && $fields[1] =~ /^\d+$/;
        my @lt = localtime($fields[1] + 0);
        return sprintf('%04d-%02d-%02d %02d:%02d:%02d',
            $lt[5] + 1900, $lt[4] + 1, $lt[3], $lt[2], $lt[1], $lt[0]);
    }
    return 'unknown';
}

sub load_average {
    my $content = read_file('/proc/loadavg');
    my @parts = split ' ', $content;
    return (0.0, 0.0, 0.0) unless @parts >= 3;
    for my $value (@parts[0 .. 2]) {
        return (0.0, 0.0, 0.0) unless $value =~ /^\d+(?:\.\d+)?$/;
    }
    return ($parts[0] + 0, $parts[1] + 0, $parts[2] + 0);
}

sub cpu_count {
    # os.cpu_count() is the online processor count, which /sys reports as a list of
    # ranges.
    my $online = read_file('/sys/devices/system/cpu/online');
    if (length $online) {
        my $count = 0;
        for my $part (split /,/, $online) {
            if ($part =~ /^(\d+)-(\d+)$/) { $count += $2 - $1 + 1 }
            elsif ($part =~ /^\d+$/)       { $count += 1 }
        }
        return $count if $count > 0;
    }
    my $processors = 0;
    for my $line (@{ read_lines('/proc/cpuinfo') }) {
        $processors++ if index($line, 'processor') == 0;
    }
    return $processors > 0 ? $processors : 1;
}

sub logged_users {
    my $p = run(['who'], 15);
    my %users;
    for my $line (split /\n/, $p->{out}) {
        next unless length $line;
        my @fields = split ' ', $line;
        $users{ $fields[0] } = 1 if @fields;
    }
    return scalar keys %users;
}

sub collect_overview {
    my $os_info = parse_os_release();
    my $os_name = $os_info->{PRETTY_NAME} // $os_info->{NAME} // 'unknown';
    my ($load1, $load5, $load15) = load_average();

    my $uptime_seconds = 0.0;
    my $uptime_raw = read_file('/proc/uptime');
    if (length $uptime_raw) {
        my @parts = split ' ', $uptime_raw;
        $uptime_seconds = $parts[0] + 0 if @parts && $parts[0] =~ /^\d+(?:\.\d+)?$/;
    }

    my $hostname = read_file('/proc/sys/kernel/hostname');
    return {
        hostname       => length $hostname ? $hostname : uname('-n'),
        os             => $os_name,
        kernel         => read_file('/proc/sys/kernel/osrelease'),
        uptime_seconds => $uptime_seconds,
        uptime_human   => uptime_human($uptime_seconds),
        load_1min      => $load1,
        load_5min      => $load5,
        load_15min     => $load15,
        cpu_cores      => cpu_count(),
        users_logged   => logged_users(),
        boot_time      => boot_time(),
    };
}

# ---------------------------------------------------------------------------
# Section: CPU
# ---------------------------------------------------------------------------

sub cpu_model {
    for my $line (@{ read_lines('/proc/cpuinfo') }) {
        next unless index($line, 'model name') == 0;
        my (undef, $value) = split /:/, $line, 2;
        $value = '' unless defined $value;
        $value =~ s/^\s+//;
        $value =~ s/\s+$//;
        return $value;
    }
    return 'unknown';
}

sub cpu_cores_threads {
    my $cpuinfo = read_file('/proc/cpuinfo');
    my %cores;
    my $threads = 0;
    my $physical_id = '0';
    for my $line (split /\n/, $cpuinfo) {
        if (index($line, 'physical id') == 0) {
            my (undef, $value) = split /:/, $line, 2;
            $value = '' unless defined $value;
            $value =~ s/^\s+//;
            $value =~ s/\s+$//;
            $physical_id = $value;
        }
        elsif (index($line, 'core id') == 0) {
            my (undef, $value) = split /:/, $line, 2;
            $value = '' unless defined $value;
            $value =~ s/^\s+//;
            $value =~ s/\s+$//;
            $cores{"$physical_id:$value"} = 1;
        }
        elsif (index($line, 'processor') == 0) {
            $threads++;
        }
    }
    my $phys = keys %cores ? scalar(keys %cores) : cpu_count();
    return ($phys, $threads ? $threads : cpu_count());
}

sub cpu_frequency {
    for my $line (@{ read_lines('/proc/cpuinfo') }) {
        next unless index(lc($line), 'cpu mhz') >= 0;
        my (undef, $value) = split /:/, $line, 2;
        $value = '' unless defined $value;
        $value =~ s/^\s+//;
        $value =~ s/\s+$//;
        return "$value MHz";
    }
    my $freq = read_file('/sys/devices/system/cpu/cpu0/cpufreq/scaling_cur_freq');
    if (length $freq && $freq =~ /^\d+$/) {
        return sprintf('%.0f MHz', $freq / 1000);
    }
    return 'unknown';
}

sub cpu_temperature {
    my $base = '/sys/class/hwmon';
    return 'unknown' unless -d $base;
    my @entries;
    if (opendir(my $dh, $base)) {
        @entries = sort grep { $_ ne '.' && $_ ne '..' } readdir($dh);
        closedir($dh);
    }
    for my $entry (@entries) {
        my $name = lc(read_file("$base/$entry/name"));
        next unless $name eq 'coretemp' || $name eq 'k10temp'
                 || $name eq 'cpu_thermal' || $name eq 'acpitz';
        for my $index (1 .. 4) {
            my $temp_raw = read_file("$base/$entry/temp${index}_input");
            next unless length $temp_raw;
            return sprintf('%.1f', $temp_raw / 1000.0) . "°C" if $temp_raw =~ /^-?\d+$/;
        }
    }
    return 'unknown';
}

sub parse_cpu_fields {
    my ($line) = @_;
    my @fields = split ' ', $line;
    return () if @fields < 9;
    my @values = @fields[1 .. 8];
    for my $value (@values) {
        return () unless defined $value && $value =~ /^\d+$/;
    }
    return @values;
}

sub read_cpu_times {
    my @aggregate;
    my @per_core;
    for my $line (@{ read_lines('/proc/stat') }) {
        if (index($line, 'cpu ') == 0) {
            @aggregate = parse_cpu_fields($line);
        }
        elsif (substr($line, 0, 3) eq 'cpu' && substr($line, 3, 1) =~ /^\d$/) {
            my @fields = parse_cpu_fields($line);
            push @per_core, \@fields if @fields;
        }
    }
    return (\@aggregate, \@per_core);
}

sub usage_percent {
    my ($times1, $times2) = @_;
    return '0.0' unless @$times1 >= 5 && @$times2 >= 5;
    # iowait counts as idle: a process waiting on disk is not using the CPU.
    my $idle_delta = ($times2->[3] + $times2->[4]) - ($times1->[3] + $times1->[4]);
    my $total_delta = 0;
    $total_delta += $times2->[$_] - $times1->[$_] for 0 .. $#$times2;
    return '0.0' if $total_delta <= 0;
    return sprintf('%.1f', (1 - $idle_delta / $total_delta) * 100);
}

sub cpu_usage {
    my ($sample_interval) = @_;
    $sample_interval = 0.2 unless defined $sample_interval;
    my ($agg1, $cores1) = read_cpu_times();
    select(undef, undef, undef, $sample_interval);
    my ($agg2, $cores2) = read_cpu_times();

    my @per_core;
    my $count = @$cores1 < @$cores2 ? scalar(@$cores1) : scalar(@$cores2);
    for my $index (0 .. $count - 1) {
        push @per_core, {
            cpu       => "$index",
            usage_pct => usage_percent($cores1->[$index], $cores2->[$index]),
        };
    }
    return (usage_percent($agg1, $agg2), \@per_core);
}

sub collect_cpu {
    my ($phys_cores, $threads) = cpu_cores_threads();
    my ($usage, $per_core) = cpu_usage();

    return {
        model          => cpu_model(),
        architecture   => uname('-m'),
        physical_cores => $phys_cores,
        threads        => $threads,
        frequency      => cpu_frequency(),
        temperature    => cpu_temperature(),
        usage_pct      => $usage,
        per_core       => $per_core,
    };
}

# ---------------------------------------------------------------------------
# Section: memory
# ---------------------------------------------------------------------------

sub parse_meminfo {
    my %mem;
    for my $line (@{ read_lines('/proc/meminfo') }) {
        my @parts = split ' ', $line;
        next unless @parts >= 2;
        my $key = $parts[0];
        $key =~ s/:$//;
        $mem{$key} = $parts[1] + 0 if $parts[1] =~ /^\d+$/;
    }
    return \%mem;
}

sub top_mem_processes {
    my ($count) = @_;
    $count = 5 unless defined $count;
    my $p = run(['ps', '-eo', 'pid,user,rss,comm', '--sort=-rss', '--no-headers'], 5);
    my @procs;
    my @lines = split /\n/, $p->{out};
    for my $line (@lines[0 .. ($count - 1 > $#lines ? $#lines : $count - 1)]) {
        next unless defined $line;
        my @parts = split ' ', $line, 4;
        next unless @parts >= 4;
        next unless $parts[0] =~ /^\d+$/ && $parts[2] =~ /^\d+$/;
        push @procs, {
            pid     => $parts[0] + 0,
            user    => $parts[1],
            rss_mb  => sprintf('%.1f', $parts[2] / 1024),
            command => $parts[3],
        };
    }
    return \@procs;
}

sub collect_memory {
    my $mem = parse_meminfo();
    my %m = map { $_ => ($mem->{$_} // 0) } keys %$mem;

    my $total = int(($m{MemTotal} // 0) / 1024);
    my $free = int(($m{MemFree} // 0) / 1024);
    my $available = int(($m{MemAvailable} // 0) / 1024);
    my $used = $available ? $total - $available : $total - $free;

    my $swap_total = int(($m{SwapTotal} // 0) / 1024);
    my $swap_free = int(($m{SwapFree} // 0) / 1024);
    my $swap_used = $swap_total - $swap_free;

    return {
        total_mb        => $total,
        used_mb         => $used,
        free_mb         => $free,
        available_mb    => $available,
        usage_pct       => $total > 0 ? sprintf('%.1f', $used / $total * 100) : '0.0',
        swap_total_mb   => $swap_total,
        swap_used_mb    => $swap_used,
        swap_usage_pct  => $swap_total > 0 ? sprintf('%.1f', $swap_used / $swap_total * 100) : '0.0',
        top_processes   => top_mem_processes(),
        buffers_mb      => int(($m{Buffers} // 0) / 1024),
        cached_mb       => int(($m{Cached} // 0) / 1024),
    };
}

# ---------------------------------------------------------------------------
# Section: disk
# ---------------------------------------------------------------------------

sub skip_filesystem {
    my ($fs_type, $device) = @_;
    my %excluded = map { $_ => 1 } qw(
        tmpfs devtmpfs squashfs overlay proc sysfs devpts cgroup cgroup2 pstore bpf
        debugfs tracefs securityfs hugetlbfs fuse.gvfsd-fuse fuse.portal ramfs
        efivarfs configfs selinuxfs systemd-1 mqueue fusectl sunrpc binfmt_misc
        autofs rpc_pipefs nsfs
    );
    return 1 if $excluded{$fs_type};
    return 1 if index($device, 'tmpfs') == 0 || index($device, 'devtmpfs') == 0;
    # Network filesystems: stat() blocks in uninterruptible I/O while the server is
    # unreachable, which would stall the whole report.
    for my $prefix ('nfs', 'cifs', 'smbfs', 'ncpfs', 'sshfs', '9p', 'afs') {
        return 1 if index($fs_type, $prefix) == 0;
    }
    return 0;
}

# The four numbers statvfs would have given, through stat(1), which reports the
# same fields: total blocks, free blocks, blocks available to unprivileged users,
# and the fundamental block size.
sub filesystem_stats {
    my ($mountpoint) = @_;
    my $p = run(['stat', '-f', '-c', '%b %f %a %S', '--', $mountpoint], 5);
    return undef if $p->{rc} != 0;
    my @fields = split ' ', $p->{out};
    return undef unless @fields >= 4;
    for my $value (@fields[0 .. 3]) {
        return undef unless $value =~ /^\d+$/;
    }
    return {
        blocks  => $fields[0] + 0,
        frsize  => $fields[3] + 0,
        avail   => $fields[2] + 0,
    };
}

# The kernel octal-escapes space, tab, newline and backslash in the mount point
# field of /proc/mounts, and stat() needs the decoded path.
sub unescape_mount_point {
    my ($text) = @_;
    $text =~ s/\\(040|011|012|134)/chr(oct($1))/eg;
    return $text;
}

sub mounts {
    my @fs_list;
    my %seen_devices;
    for my $line (@{ read_lines('/proc/mounts') }) {
        my @parts = split ' ', $line;
        next if @parts < 6;
        my ($device, $mountpoint, $fs_type) = @parts[0 .. 2];
        next if skip_filesystem($fs_type, $device);
        $mountpoint = unescape_mount_point($mountpoint);
        my @st = stat($mountpoint);
        next unless @st;
        my $st_dev = $st[0];
        next if $seen_devices{$st_dev}++;
        my $fs = filesystem_stats($mountpoint);
        next unless defined $fs;
        my $total = $fs->{blocks} * $fs->{frsize};
        my $available = $fs->{avail} * $fs->{frsize};
        my $used = $total - $available;

        push @fs_list, {
            device       => $device,
            mountpoint   => $mountpoint,
            fstype       => $fs_type,
            size_gb      => sprintf('%.1f', $total / (1024**3)),
            used_gb      => sprintf('%.1f', $used / (1024**3)),
            available_gb => sprintf('%.1f', $available / (1024**3)),
            use_pct      => $total > 0 ? sprintf('%.1f', $used / $total * 100) : '0.0',
        };
    }
    return \@fs_list;
}

sub disk_io_stats {
    my $p = run(['iostat', '-d', '-x', '1', '2'], 10);
    my $out = $p->{out};
    return undef unless length $out;

    # Split into report blocks, each starting at a Device header.
    my @blocks;
    my @current;
    for my $line (split /\n/, $out) {
        if (index($line, 'Device') >= 0 && index($line, 'r/s') >= 0) {
            push @blocks, [@current] if @current;
            @current = ($line);
        }
        elsif (@current) {
            push @current, $line;
        }
    }
    push @blocks, [@current] if @current;
    return undef unless @blocks;

    my $lines = $blocks[-1];
    my @header = split ' ', $lines->[0];
    my %columns;
    for my $index (0 .. $#header) {
        $columns{ $header[$index] } = $index;
    }

    my $value = sub {
        my ($parts, @names) = @_;
        for my $name (@names) {
            my $index = $columns{$name};
            next unless defined $index && $index < @$parts;
            return $parts->[$index] =~ /^-?\d+(?:\.\d+)?$/ ? $parts->[$index] + 0 : 0.0;
        }
        return 0.0;
    };

    # Throughput in MB/s: the kB/s column current sysstat prints is converted, but
    # the MB/s column older sysstat printed is already in the unit asked for, so
    # dividing that one as well would report a value 1024 times too small.
    my $rate_mb_s = sub {
        my ($parts, $kb_name, $mb_name) = @_;
        for my $candidate ([$kb_name, 1024], [$mb_name, 1]) {
            my ($name, $divisor) = @$candidate;
            my $index = $columns{$name};
            next unless defined $index && $index < @$parts;
            return $parts->[$index] =~ /^-?\d+(?:\.\d+)?$/ ? $parts->[$index] / $divisor : 0.0;
        }
        return 0.0;
    };

    my @devices;
    for my $line (@$lines[1 .. $#$lines]) {
        my @parts = split ' ', $line;
        next unless @parts;
        next if $parts[0] eq 'Device';
        my $reads = $value->(\@parts, 'r/s');
        my $writes = $value->(\@parts, 'w/s');
        push @devices, {
            device      => $parts[0],
            tps         => sprintf('%.2f', $reads + $writes),
            read_mb_s   => sprintf('%.2f', $rate_mb_s->(\@parts, 'rkB/s', 'rMB/s')),
            write_mb_s  => sprintf('%.2f', $rate_mb_s->(\@parts, 'wkB/s', 'wMB/s')),
        };
    }

    return @devices ? { devices => \@devices } : undef;
}

sub in_container {
    return 1 if -e '/run/.containerenv' || -e '/.dockerenv';
    for my $line (@{ read_lines('/proc/mounts') }) {
        my @parts = split ' ', $line;
        return 1 if @parts >= 3 && $parts[1] eq '/' && $parts[2] eq 'overlay';
    }
    return 0;
}

sub collect_disk {
    my $mounts = mounts();
    my $total_gb = 0;
    my $used_gb = 0;
    for my $mount (@$mounts) {
        $total_gb += $mount->{size_gb};
        $used_gb += $mount->{used_gb};
    }
    my @critical = grep { $_->{use_pct} > 90 } @$mounts;

    return {
        filesystems => $mounts,
        total_gb    => sprintf('%.1f', $total_gb),
        used_gb     => sprintf('%.1f', $used_gb),
        usage_pct   => $total_gb > 0 ? sprintf('%.1f', $used_gb / $total_gb * 100) : '0.0',
        critical_fs => \@critical,
        io_stats    => disk_io_stats(),
        container   => in_container(),
    };
}

# ---------------------------------------------------------------------------
# Section: network
# ---------------------------------------------------------------------------

sub net_interfaces {
    my @ifaces;
    my $net_path = '/sys/class/net';
    return \@ifaces unless -d $net_path;
    my @entries;
    if (opendir(my $dh, $net_path)) {
        @entries = sort grep { $_ ne '.' && $_ ne '..' } readdir($dh);
        closedir($dh);
    }

    for my $iface (@entries) {
        next if $iface eq 'lo';
        my $operstate = read_file("$net_path/$iface/operstate");
        my $speed_raw = read_file("$net_path/$iface/speed");
        my $speed = length($speed_raw) && $speed_raw ne '-1' ? "$speed_raw Mbps" : 'unknown';

        my $p = run(['ip', '-br', 'addr', 'show', $iface], 5);
        my (@ipv4, @ipv6);
        my $out = $p->{out};
        if (length $out) {
            my @parts = split ' ', $out;
            my $skip_next = 0;
            for my $part (@parts[2 .. $#parts]) {
                next unless defined $part;
                if ($part eq 'peer') {
                    $skip_next = 1;   # the next token is the remote end's address
                    next;
                }
                if ($skip_next) { $skip_next = 0; next }
                if (index($part, '.') >= 0 && index($part, '/') >= 0) {
                    my ($address) = split /\//, $part, 2;
                    push @ipv4, $address;
                }
                elsif (index($part, ':') >= 0 && index($part, '/') >= 0) {
                    my ($address) = split /\//, $part, 2;
                    push @ipv6, $address;
                }
            }
        }

        push @ifaces, {
            name  => $iface,
            state => length($operstate) ? uc($operstate) : 'UNKNOWN',
            speed => $speed,
            ipv4  => \@ipv4,
            ipv6  => \@ipv6,
        };
    }
    return \@ifaces;
}

sub connection_summary {
    my $p = run(['ss', '-s'], 5);
    my %result;
    for my $line (split /\n/, $p->{out}) {
        if (index($line, 'TCP:') >= 0) {
            $result{tcp_established} = $1 + 0 if $line =~ /estab\s+(\d+)/;
        }
        if (index($line, 'Total:') >= 0) {
            $result{total} = $1 + 0 if $line =~ /(\d+)/;
        }
    }
    return \%result;
}

sub default_routes {
    my %routes = (v6 => '', v4 => '');
    my $p = run(['ip', '-6', 'route', 'show', 'default'], 5);
    my $out = $p->{out};
    $out =~ s/^\s+//;
    $out =~ s/\s+$//;
    $routes{v6} = $out if length $out;
    $p = run(['ip', '-4', 'route', 'show', 'default'], 5);
    $out = $p->{out};
    $out =~ s/^\s+//;
    $out =~ s/\s+$//;
    $routes{v4} = $out if length $out;
    return \%routes;
}

# Whether a string is an IPv4 or an IPv6 address.
sub is_address {
    my ($text) = @_;
    return 0 unless length $text;
    if (index($text, ':') >= 0) {
        return _valid_ipv6($text);
    }
    my @octets = split /\./, $text, -1;
    return 0 unless @octets == 4;
    for my $octet (@octets) {
        return 0 unless $octet =~ /^\d{1,3}$/ && $octet <= 255;
    }
    return 1;
}

sub _valid_ipv6 {
    my ($ip) = @_;
    $ip =~ s/%.*//;
    return 0 unless $ip =~ /^[0-9a-fA-F:.]+$/ && index($ip, ':') >= 0;
    my ($head, $tail) = ($ip, '');
    my $shorthand = 0;
    if (index($ip, '::') >= 0) {
        ($head, $tail) = split /::/, $ip, 2;
        $shorthand = 1;
    }
    my @head = length($head // '') ? split(/:/, $head, -1) : ();
    my @tail = length($tail // '') ? split(/:/, $tail, -1) : ();
    if (@tail && $tail[-1] =~ /\./) {
        my $quad = pop @tail;
        my @octets = split /\./, $quad, -1;
        return 0 unless @octets == 4;
        for my $octet (@octets) {
            return 0 unless $octet =~ /^\d{1,3}$/ && $octet <= 255;
        }
        push @tail, '0', '0';
    }
    return 0 if @head + @tail > ($shorthand ? 7 : 8);
    my @groups = $shorthand
        ? (@head, (0) x (8 - @head - @tail), @tail)
        : (@head, @tail);
    return 0 unless @groups == 8;
    for my $group (@groups) {
        return 0 unless $group =~ /^[0-9a-fA-F]{1,4}$/;
    }
    return 1;
}

sub external_ip {
    my %result = (v6 => 'unknown', v4 => 'unknown');
    for my $item (['v6', '-6'], ['v4', '-4']) {
        my ($family, $flag) = @$item;
        # -f fails on HTTP errors; without it a captive portal or an error page
        # would be accepted as the external address.
        my $p = run(['curl', $flag, '--max-time', '5', '-fsS', 'https://icanhazip.com'], 8);
        my $body = $p->{out};
        $body =~ s/^\s+//;
        $body =~ s/\s+$//;
        next unless is_address($body);
        $result{$family} = $body;
    }
    return \%result;
}

sub collect_network {
    my ($include_external) = @_;
    my %data = (
        interfaces  => net_interfaces(),
        connections => connection_summary(),
        routes      => default_routes(),
    );
    $data{external_ip} = external_ip() if $include_external;
    return \%data;
}

# ---------------------------------------------------------------------------
# Section: GPU
# ---------------------------------------------------------------------------
#
# The vendor side of the GPU section reports both sources together: AMD in detail
# through rocm-smi, which brings memory and utilisation, and AMD, Intel and Huawei
# cards through lspci, which needs no vendor tooling at all.  A compute device with
# no display class, such as an Instinct or an Ascend, is reached through its PCI
# identifier instead, and an AMD card rocm-smi has already described is not listed
# twice.

# Matches rocm-smi data lines across ROCm versions, with or without the bracketed
# card index: "GPU[0]\t\t: Card series:\t…" and "GPU\t\t: …".
my $ROCM_LINE = qr/^GPU(?:\[(\d+)\])?\s*:\s*([^:]+?)\s*:\s*(.+)$/;

sub rocm_smi_bin {
    my $found = find_exe('rocm-smi');
    return $found if defined $found;
    my $default = '/opt/rocm/bin/rocm-smi';
    return -f $default ? $default : undef;
}

sub rocm_vram {
    my ($binary) = @_;
    my $p = run([$binary, '--showmeminfo', 'vram'], 10);
    my $out = $p->{out};
    return undef unless length $out;

    my ($total_bytes, $used_bytes) = (0, 0);
    for my $line (split /\n/, $out) {
        my $stripped = $line;
        $stripped =~ s/^\s+//;
        $stripped =~ s/\s+$//;
        next unless $stripped =~ $ROCM_LINE;
        my $key = $2;
        $key =~ s/^\s+//;
        $key =~ s/\s+$//;
        my $raw = $3;
        my @fields = split ' ', $raw;
        next unless @fields && $fields[0] =~ /^\d+$/;
        my $value = $fields[0] + 0;
        # Keys are matched exactly: "VRAM Total Used Memory (B)" contains both words
        # "Total" and "Used", so substring matching would double-count.
        if ($key eq 'VRAM Total Used Memory (B)')      { $used_bytes += $value }
        elsif ($key eq 'VRAM Total Memory (B)')        { $total_bytes += $value }
    }

    return undef if $total_bytes <= 0;
    my $mib = 1024 * 1024;
    return {
        total_mb => int($total_bytes / $mib),
        used_mb  => int($used_bytes / $mib),
        free_mb  => int(($total_bytes - $used_bytes) / $mib),
    };
}

sub amd_gpu {
    my $binary = rocm_smi_bin();
    return undef unless defined $binary;
    my $p = run([$binary, '--showproductname', '--showuse'], 10);
    my $out = $p->{out};
    return undef unless length $out;

    # Every rocm-smi data line is prefixed with "GPU[N] :", so the pairs are grouped
    # by card: looping per line would make one card per line.
    my %cards;
    for my $line (split /\n/, $out) {
        my $stripped = $line;
        $stripped =~ s/^\s+//;
        $stripped =~ s/\s+$//;
        next unless $stripped =~ $ROCM_LINE;
        my $card_id = defined $1 && length $1 ? $1 : '0';
        my $key = $2;
        $key =~ s/^\s+//;
        $key =~ s/\s+$//;
        my $value = $3;
        $value =~ s/^\s+//;
        $value =~ s/\s+$//;
        $cards{$card_id} = { id => $card_id } unless exists $cards{$card_id};
        $cards{$card_id}{$key} = $value;
    }

    return undef unless %cards;
    my %info = (vendor => 'AMD', cards => [ map { $cards{$_} } sort keys %cards ]);
    my $vram = rocm_vram($binary);
    $info{vram} = $vram if $vram;
    return \%info;
}

sub lspci_gpu {
    return { unavailable => 1 } unless defined find_exe('lspci');
    my $p = run(['lspci'], 10);
    my $out = $p->{out};
    return { unavailable => 1 } unless length $out;
    my @cards;
    for my $line (split /\n/, $out) {
        my $lower = lc($line);
        next unless index($lower, 'vga') >= 0 || index($lower, 'display') >= 0
                 || index($lower, '3d') >= 0;
        my @parts = split /: /, $line, 3;
        my $model = @parts >= 2 ? $parts[-1] : $line;
        $model =~ s/^\s+//;
        $model =~ s/\s+$//;
        my $vendor = '';
        # The vendor names are matched as words, never as substrings: "ati" is
        # inside "Corporation", so a substring match would report every Intel card
        # as AMD.
        $vendor = 'AMD' if $lower =~ /\b(?:amd|radeon|ati)\b/;
        $vendor = 'Intel' if !length $vendor && $lower =~ /\bintel\b/;
        $vendor = 'Huawei' if !length $vendor && $lower =~ /\b(?:huawei|hisilicon|ascend)\b/;
        push @cards, { model => $model, vendor => $vendor, driver => '(not loaded)' };
    }
    if (!@cards) {
        # Probe for compute devices that carry no display class, such as an AMD
        # Instinct or a Huawei Ascend: they answer to the vendor's PCI identifier and
        # would otherwise be missed entirely.
        for my $probe (['1002:', 'AMD'], ['19e5:', 'Huawei']) {
            my ($id, $vendor) = @$probe;
            my $p2 = run(['lspci', '-d', $id], 10);
            for my $line (split /\n/, $p2->{out}) {
                my $stripped = $line;
                $stripped =~ s/^\s+//;
                $stripped =~ s/\s+$//;
                next unless length $stripped;
                push @cards, { model => $stripped, vendor => $vendor, driver => '(not loaded)' };
            }
        }
    }
    return undef unless @cards;
    return {
        vendor   => length($cards[0]{vendor}) ? $cards[0]{vendor} : 'unknown',
        cards    => \@cards,
        fallback => 1,
    };
}

# Both sources are reported together: the cards rocm-smi describes come first,
# with their memory and utilisation, and every other card lspci can see is
# appended, so a machine with an AMD card and an Intel or Huawei one reports all
# of them.  The fallback flag still means what it means: nothing but lspci
# answered.
sub collect_gpu {
    my $amd = amd_gpu();
    my $lspci = lspci_gpu();
    my $extra = [];
    if ($lspci && !$lspci->{unavailable}) {
        # An AMD card rocm-smi already described must not be listed twice, but with no
        # rocm-smi answer lspci's AMD card is the only one there is.
        $extra = [ grep { !$amd || !length $_->{vendor} || $_->{vendor} ne 'AMD' }
                       @{ $lspci->{cards} } ];
    }

    my @cards = (($amd ? @{ $amd->{cards} } : ()), @$extra);
    return $lspci unless @cards;

    # The AMD cards come from rocm-smi, which does not label them with a vendor, so
    # the summary takes AMD from its source and the rest from the cards themselves.
    my @vendor_list = $amd ? ('AMD') : ();
    push @vendor_list, map { $_->{vendor} // '' } @$extra;
    my %seen_vendor;
    my @vendors = grep { length && !$seen_vendor{$_}++ } @vendor_list;
    my %info = (
        vendor => @vendors ? join(', ', @vendors) : 'unknown',
        cards  => \@cards,
    );
    $info{vram}     = $amd->{vram} if $amd && $amd->{vram};
    $info{fallback} = 1 unless $amd;
    return \%info;
}

# ---------------------------------------------------------------------------
# Section: services
# ---------------------------------------------------------------------------

sub failed_units {
    return undef unless defined find_exe('systemctl');
    # --plain is required: without it systemd prefixes failed units with a bullet
    # even when the output is piped, which breaks field parsing.
    my $p = run(['systemctl', '--failed', '--no-legend', '--no-pager', '--plain'], 10);
    my $out = $p->{out};
    $out =~ s/^\s+//;
    $out =~ s/\s+$//;
    my @units;
    for my $line (split /\n/, $out) {
        # The columns are unit, load, active, sub, description: the unit's own state
        # is the sub column, not the load column.
        my @parts = split ' ', $line, 5;
        next if @parts < 4;
        push @units, { unit => $parts[0], state => $parts[3] };
    }
    return \@units;
}

sub check_service {
    my ($name) = @_;
    my $p = run(['systemctl', 'is-active', $name, '--no-pager'], 5);
    my $status = $p->{out};
    $status =~ s/^\s+//;
    $status =~ s/\s+$//;
    return { name => $name, status => length $status ? $status : 'not-found' };
}

sub collect_services {
    my @key_services = qw(sshd firewalld nginx postgresql);
    my %svc_status;
    $svc_status{$_} = check_service($_) for @key_services;
    return {
        failed_units => failed_units(),
        key_services => \%svc_status,
    };
}

# ---------------------------------------------------------------------------
# Section: security
# ---------------------------------------------------------------------------

sub selinux_status {
    my $p = run(['getenforce'], 5);
    my $out = $p->{out};
    $out =~ s/^\s+//;
    $out =~ s/\s+$//;
    return length $out ? $out : 'unknown';
}

sub firewalld_info {
    my %result = (available => 0, active => 0, default_zone => '', zones => []);
    my $p = run(['firewall-cmd', '--state'], 5);
    my $state = $p->{out};
    $state =~ s/^\s+//;
    $state =~ s/\s+$//;
    return \%result unless length $state;
    $result{available} = 1;
    $result{active} = $state eq 'running' ? 1 : 0;

    $p = run(['firewall-cmd', '--get-default-zone'], 5);
    my $zone = $p->{out};
    $zone =~ s/^\s+//;
    $zone =~ s/\s+$//;
    $result{default_zone} = $zone if length $zone;

    $p = run(['firewall-cmd', '--get-active-zones'], 5);
    my $out = $p->{out};
    if (length $out) {
        for my $line (split /\n/, $out) {
            my $stripped = $line;
            $stripped =~ s/^\s+//;
            $stripped =~ s/\s+$//;
            # Zone names sit at column 0; member lines are indented, so the
            # indentation has to be checked before stripping.
            next unless length $stripped;
            next if index($line, ' ') == 0 || index($line, "\t") == 0;
            push @{ $result{zones} }, $stripped;
        }
    }
    return \%result;
}

sub failed_ssh_attempts {
    my $p = run(['journalctl', '-u', 'sshd', '--since', 'today', '--no-pager'], 10);
    my $out = $p->{out};
    if (!length $out) {
        # Fall back to the "ssh" unit name used by some distributions.
        $p = run(['journalctl', '-u', 'ssh', '--since', 'today', '--no-pager'], 10);
        $out = $p->{out};
    }
    my $lower = lc($out);
    my $count = () = $lower =~ /failed password/g;
    return $count;
}

sub last_logins {
    my ($count) = @_;
    $count = 3 unless defined $count;
    my $p = run(['last', '-n', "$count", '--no-hostname'], 5);
    my @logins;
    for my $line (split /\n/, $p->{out}) {
        next unless length $line;
        my $lower = lc($line);
        next if index($lower, 'reboot') >= 0 || index($lower, 'wtmp') >= 0;
        $line =~ s/^\s+//;
        $line =~ s/\s+$//;
        push @logins, $line;
        last if @logins >= $count;
    }
    return \@logins;
}

sub open_ports_count {
    my $p = run(['ss', '-tlnp'], 5);
    my $out = $p->{out};
    $out =~ s/^\s+//;
    $out =~ s/\s+$//;
    my @lines = grep { length && index($_, 'LISTEN') >= 0 } split /\n/, $out;
    return scalar @lines;
}

sub collect_security {
    return {
        selinux             => selinux_status(),
        firewalld           => firewalld_info(),
        failed_ssh_attempts => failed_ssh_attempts(),
        last_logins         => last_logins(),
        open_ports_count    => open_ports_count(),
    };
}

# ---------------------------------------------------------------------------
# Section: performance
# ---------------------------------------------------------------------------

sub process_counts {
    my ($total, $zombies) = (0, 0);
    my @entries;
    if (opendir(my $dh, '/proc')) {
        @entries = grep { /^\d+$/ } readdir($dh);
        closedir($dh);
    }
    for my $entry (@entries) {
        $total++;
        my $status = read_file("/proc/$entry/status");
        for my $line (split /\n/, $status) {
            next unless index($line, 'State:') == 0;
            $zombies++ if index($line, 'Z') >= 0;
            last;
        }
    }
    return { total => $total, zombies => $zombies };
}

sub top_cpu_processes {
    my ($count) = @_;
    $count = 5 unless defined $count;
    my $p = run(['ps', '-eo', 'pid,user,%cpu,comm', '--sort=-%cpu', '--no-headers'], 5);
    my @procs;
    my @lines = split /\n/, $p->{out};
    for my $line (@lines[0 .. ($count - 1 > $#lines ? $#lines : $count - 1)]) {
        next unless defined $line;
        my @parts = split ' ', $line, 4;
        next unless @parts >= 4;
        next unless $parts[0] =~ /^\d+$/ && $parts[2] =~ /^-?\d+(?:\.\d+)?$/;
        push @procs, {
            pid     => $parts[0] + 0,
            user    => $parts[1],
            cpu_pct => sprintf('%.1f', $parts[2]),
            command => $parts[3],
        };
    }
    return \@procs;
}

sub context_switches {
    my %result = (ctxt => 0, intr => 0);
    for my $line (@{ read_lines('/proc/stat') }) {
        if (index($line, 'ctxt ') == 0) {
            my @fields = split ' ', $line;
            $result{ctxt} = $fields[1] + 0 if @fields >= 2 && $fields[1] =~ /^\d+$/;
        }
        if (index($line, 'intr ') == 0) {
            my @fields = split ' ', $line;
            $result{intr} = $fields[1] + 0 if @fields >= 2 && $fields[1] =~ /^\d+$/;
        }
    }
    return \%result;
}

sub collect_performance {
    my $counts = process_counts();
    my ($load1) = load_average();
    my $cores = cpu_count();

    return {
        processes_total   => $counts->{total},
        zombies           => $counts->{zombies},
        top_cpu_processes => top_cpu_processes(),
        context_switches  => context_switches(),
        load_vs_cores_ratio => sprintf('%.2f', $load1 / $cores),
    };
}

# ---------------------------------------------------------------------------
# Section: recent issues
# ---------------------------------------------------------------------------

sub _journal_lines {
    my ($cmd, $timeout, $keep_tail) = @_;
    my $p = run($cmd, $timeout);
    my $out = $p->{out};
    $out =~ s/^\s+//;
    $out =~ s/\s+$//;
    my @lines;
    for my $line (split /\n/, $out) {
        my $stripped = $line;
        $stripped =~ s/^\s+//;
        $stripped =~ s/\s+$//;
        next unless length $stripped;
        next if index($stripped, '-- No entries --') >= 0;
        next if index($stripped, 'No entries') >= 0;
        push @lines, $stripped;
    }
    return [] unless @lines;
    # Most journals keep their first ten lines and the OOM journal its last five,
    # without running off the end of a short answer.
    my $count = $keep_tail ? 5 : 10;
    if ($#lines > $count - 1) {
        return $keep_tail ? [@lines[$#lines - $count + 1 .. $#lines]] : [@lines[0 .. $count - 1]];
    }
    return \@lines;
}

sub collect_issues {
    my $recent_errors = _journal_lines(
        ['journalctl', '-p', 'err', '-n', '10', '--no-pager'], 10, 0);
    my $kernel_oops = _journal_lines(
        ['journalctl', '-k', '--no-pager', '--grep', 'Oops|BUG', '--output', 'short'], 10, 0);
    $kernel_oops = [@$kernel_oops[0 .. 4]] if @$kernel_oops > 5;

    # Also check for a kernel panic.
    if (!@$kernel_oops) {
        $kernel_oops = _journal_lines(
            ['journalctl', '-k', '--no-pager', '--grep', 'panic', '--output', 'short'], 10, 0);
        $kernel_oops = [@$kernel_oops[0 .. 4]] if @$kernel_oops > 5;
    }

    my $oom_events = _journal_lines(
        ['journalctl', '-k', '--no-pager', '--grep', 'Out of memory', '--output', 'short'],
        10, 1);

    return {
        recent_errors => $recent_errors,
        kernel_oops   => $kernel_oops,
        oom_events    => $oom_events,
    };
}

# ---------------------------------------------------------------------------
# Health score
# ---------------------------------------------------------------------------

# Each factor is worth a fixed maximum: CPU 10, memory 10, disk 15, SELinux 10,
# failed services 15, load 10, zombies 10, swap 10, firewall 10.  A factor whose
# data source is unavailable is excluded and the score is renormalised against the
# remaining maximum, so missing tooling never reads as a security failure, while an
# explicitly disabled control still scores nothing.
sub compute_health {
    my ($data) = @_;
    my $earned = 0;
    my $possible = 0;
    my (%breakdown, %maxima, @skipped);

    my $factor = sub {
        my ($name, $points, $maximum) = @_;
        if (!defined $points) {
            push @skipped, $name;
            return;
        }
        $breakdown{$name} = $points;
        $maxima{$name} = $maximum;
        $earned += $points;
        $possible += $maximum;
        return;
    };

    # Each section is read through a lexical first.  A chained lookup such as
    # $data->{cpu}{usage_pct} would autovivify $data->{cpu} into an empty hash when
    # the section was never collected, and the report would then print a section
    # full of unknowns instead of treating it as absent.
    my $cpu_data = $data->{cpu} // {};
    my $cpu_pct = $cpu_data->{usage_pct};
    my $cpu_points;
    if (defined $cpu_pct) {
        $cpu_points = $cpu_pct < 80 ? 10 : $cpu_pct < 90 ? 8 : $cpu_pct < 95 ? 4 : 0;
    }
    $factor->('cpu_usage', $cpu_points, 10);

    my $mem_data = $data->{memory} // {};
    my $mem_pct = $mem_data->{usage_pct};
    my $mem_points;
    if (defined $mem_pct) {
        $mem_points = $mem_pct < 85 ? 10 : $mem_pct < 90 ? 8 : $mem_pct < 95 ? 4 : 0;
    }
    $factor->('memory_usage', $mem_points, 10);

    my $disk_data = $data->{disk} // {};
    my $critical = $disk_data->{critical_fs};
    my $disk_points;
    if (defined $critical) {
        $disk_points = !@$critical ? 15 : @$critical == 1 ? 10 : 0;
    }
    $factor->('disk_usage', $disk_points, 15);

    # "unknown" means getenforce is not installed, so the factor is not assessable.
    my $security_data = $data->{security} // {};
    my $selinux = $security_data->{selinux};
    $selinux = 'unknown' unless defined $selinux;
    my $selinux_points;
    if ($selinux ne 'unknown') {
        $selinux_points = $selinux eq 'Enforcing' ? 10 : $selinux eq 'Permissive' ? 5 : 0;
    }
    $factor->('selinux', $selinux_points, 10);

    # undef means systemctl is not installed, so the factor is not assessable.
    my $services_data = $data->{services} // {};
    my $failed = $services_data->{failed_units};
    my $svc_points;
    if (defined $failed) {
        my $count = scalar @$failed;
        $svc_points = $count == 0 ? 15 : $count <= 2 ? 10 : $count <= 5 ? 5 : 0;
    }
    $factor->('services', $svc_points, 15);

    my $overview_data = $data->{overview} // {};
    my $load1 = $overview_data->{load_1min};
    my $cores = $overview_data->{cpu_cores} // 1;
    $cores = 1 unless $cores;
    my $load_points;
    if (defined $load1) {
        $load_points = $load1 < $cores ? 10 : $load1 < $cores * 2 ? 5 : 0;
    }
    $factor->('load', $load_points, 10);

    my $performance_data = $data->{performance} // {};
    my $zombies = $performance_data->{zombies};
    my $zombie_points;
    if (defined $zombies) {
        $zombie_points = $zombies == 0 ? 10 : $zombies <= 3 ? 5 : 0;
    }
    $factor->('zombies', $zombie_points, 10);

    my $swap_pct = $mem_data->{swap_usage_pct};
    my $swap_points;
    if (defined $swap_pct) {
        $swap_points = $swap_pct < 50 ? 10 : $swap_pct < 75 ? 5 : 0;
    }
    $factor->('swap', $swap_points, 10);

    # available false means firewall-cmd is not installed, so not assessable.
    my $fw = $security_data->{firewalld} // {};
    my $fw_points;
    if ($fw->{available}) {
        $fw_points = $fw->{active} ? 10 : 0;
    }
    $factor->('firewall', $fw_points, 10);

    # Nothing assessable at all, which a subset run or a failed collection can
    # produce, must not read as a failing grade.
    if ($possible <= 0) {
        return {
            score           => undef,
            max_score       => 100,
            grade           => 'N/A',
            breakdown       => \%breakdown,
            maxima          => \%maxima,
            factors_skipped => \@skipped,
        };
    }

    my $score = sprintf('%.0f', 100 * $earned / $possible);
    my $letter = $score >= 90 ? 'A' : $score >= 80 ? 'B' : $score >= 70 ? 'C'
               : $score >= 60 ? 'D' : 'F';

    return {
        score           => $score + 0,
        max_score       => 100,
        grade           => $letter,
        breakdown       => \%breakdown,
        maxima          => \%maxima,
        factors_skipped => \@skipped,
    };
}

# ---------------------------------------------------------------------------
# Human-readable report
# ---------------------------------------------------------------------------

sub section_header {
    my ($title) = @_;
    print "\n${BOLD}── $title ──$RESET\n";
    return;
}

sub kv {
    my ($label, $value, $colour) = @_;
    $colour = '' unless defined $colour;
    if (length $colour) {
        printf "  %-22s %s%s%s\n", $label, $colour, $value, $RESET;
    }
    else {
        printf "  %-22s %s\n", $label, $value;
    }
    return;
}

sub kv_status {
    my ($label, $ok, $ok_text, $fail_text) = @_;
    $ok_text = 'yes' unless defined $ok_text;
    $fail_text = 'no' unless defined $fail_text;
    if ($ok) {
        printf "  %-22s %s%s%s\n", $label, $GREEN, $ok_text, $RESET;
    }
    else {
        printf "  %-22s %s%s%s\n", $label, $RED, $fail_text, $RESET;
    }
    return;
}

sub print_report {
    my ($data) = @_;
    my $health = $data->{health} // {};
    my $grade_letter = defined $health->{grade} ? $health->{grade} : '?';
    my $grade_colour = $GRADE_COLOURS{$grade_letter} // $RESET;
    my $health_score_text = !defined $health->{score}
        ? 'not assessed'
        : '(' . ($health->{score} // '?') . '/' . ($health->{max_score} // 100) . ')';

    # Sections in canonical order; the numbers adapt to --section subsets.
    my @order = grep { exists $data->{$_} } @ALL_SECTIONS;
    my %position;
    $position{ $order[$_] } = $_ for 0 .. $#order;

    my $bar = "═" x $WIDTH;

    # Header
    print "\n";
    print "${BOLD}${bar}$RESET\n";
    my $overview = $data->{overview} // {};
    print "  ${BOLD}System Diagnostics  v$VERSION$RESET\n";
    print "${BOLD}${bar}$RESET\n";
    print '  Hostname:  ' . ($overview->{hostname} // 'unknown') . "\n";
    my @now = localtime(time());
    printf "  Date:      %04d-%02d-%02d %02d:%02d:%02d\n",
        $now[5] + 1900, $now[4] + 1, $now[3], $now[2], $now[1], $now[0];
    print "  Health:    ${grade_colour}${BOLD}${grade_letter}$RESET  $health_score_text\n";

    # System overview
    if (exists $data->{overview}) {
        section_header(($position{overview} + 1) . '. System Overview');
        my $o = $data->{overview};
        kv('OS', $o->{os} // 'unknown');
        kv('Kernel', $o->{kernel} // 'unknown');
        kv('Uptime', $o->{uptime_human} // 'unknown');
        kv('Boot time', $o->{boot_time} // 'unknown');

        my $load1 = $o->{load_1min} // 0;
        my $load5 = $o->{load_5min} // 0;
        my $load15 = $o->{load_15min} // 0;
        my $cores = $o->{cpu_cores} // 1;
        my $load_col = $load1 < $cores ? $GREEN : $load1 < $cores * 2 ? $YELLOW : $RED;
        kv('Load avg (1/5/15m)',
            sprintf('%s%.2f / %.2f / %.2f%s', $load_col, $load1, $load5, $load15, $RESET));
        kv('Users logged in', $o->{users_logged} // 0);
    }

    # CPU
    if (exists $data->{cpu}) {
        section_header(($position{cpu} + 1) . '. CPU');
        my $c = $data->{cpu};
        kv('Model', $c->{model} // 'unknown');
        kv('Architecture', $c->{architecture} // 'unknown');
        kv('Cores / Threads', ($c->{physical_cores} // 0) . ' physical / '
            . ($c->{threads} // 0) . ' logical');
        kv('Frequency', $c->{frequency} // 'unknown');
        kv('Temperature', $c->{temperature} // 'unknown');
        my $usage = $c->{usage_pct} // 0;
        my $usage_col = $usage < 80 ? $GREEN : $usage < 90 ? $YELLOW : $RED;
        kv('CPU usage', "$usage_col$usage%$RESET  " . _bar($usage));

        my $per_core = $c->{per_core} // [];
        if (@$per_core) {
            print "  ${BOLD}Per-core usage:$RESET\n";
            for my $core (@$per_core) {
                my $core_usage = $core->{usage_pct};
                my $core_col = $core_usage < 80 ? $GREEN : $core_usage < 90 ? $YELLOW : $RED;
                printf "    cpu%-4s %s%5.1f%%%s  %s\n",
                    $core->{cpu}, $core_col, $core_usage, $RESET, _bar($core_usage);
            }
        }
    }

    # Memory
    if (exists $data->{memory}) {
        section_header(($position{memory} + 1) . '. Memory');
        my $m = $data->{memory};
        kv('Total', ($m->{total_mb} // 0) . ' MiB');
        kv('Used', ($m->{used_mb} // 0) . ' MiB  ' . _bar($m->{usage_pct} // 0));
        kv('Available', ($m->{available_mb} // 0) . ' MiB');
        kv('Buffers', ($m->{buffers_mb} // 0) . ' MiB');
        kv('Cached', ($m->{cached_mb} // 0) . ' MiB');

        my $swap_total = $m->{swap_total_mb} // 0;
        my $swap_used = $m->{swap_used_mb} // 0;
        my $swap_pct = $m->{swap_usage_pct} // 0;
        my $swap_col = $swap_pct < 50 ? $GREEN : $swap_pct < 75 ? $YELLOW : $RED;
        kv('Swap', "${swap_col}$swap_used / $swap_total MiB$RESET  " . _bar($swap_pct));

        my $top_mem = $m->{top_processes} // [];
        if (@$top_mem) {
            print "\n  ${BOLD}Top 5 memory consumers:$RESET\n";
            printf "  %-8s %-10s %8s  COMMAND\n", 'PID', 'USER', 'RSS';
            for my $proc (@$top_mem) {
                printf "  %-8d %-10s %6.1fM  %s\n",
                    $proc->{pid}, $proc->{user}, $proc->{rss_mb}, $proc->{command};
            }
        }
    }

    # Disk
    if (exists $data->{disk}) {
        section_header(($position{disk} + 1) . '. Disk');
        my $d = $data->{disk};
        kv('Total space', sprintf('%.1f GiB', $d->{total_gb} // 0));
        kv('Used', sprintf('%.1f GiB  ', $d->{used_gb} // 0) . _bar($d->{usage_pct} // 0));

        my $fss = $d->{filesystems} // [];
        if (@$fss) {
            print "\n  ${BOLD}Filesystems:$RESET\n";
            my $header = sprintf('  %-20s %-18s %7s %7s %s', 'Device', 'Mount', 'Size', 'Used', 'Use%');
            print "$header\n";
            print '  ' . ('-' x (length($header) - 2)) . "\n";
            for my $fs (@$fss) {
                my $use_pct = $fs->{use_pct};
                my $pct_col = $use_pct < 80 ? $GREEN : $use_pct < 90 ? $YELLOW : $RED;
                my $dev = length($fs->{device}) > 19 ? substr($fs->{device}, 0, 19) : $fs->{device};
                my $mnt = length($fs->{mountpoint}) > 17 ? substr($fs->{mountpoint}, 0, 17) : $fs->{mountpoint};
                printf "  %-20s %-18s %6.0fG %6.0fG %s%4.1f%%%s\n",
                    $dev, $mnt, $fs->{size_gb}, $fs->{used_gb}, $pct_col, $use_pct, $RESET;
            }
        }

        if (!@$fss && $d->{container}) {
            print "  ${DIM}(container detected, overlay root filesystem not shown)$RESET\n";
        }

        my $critical = $d->{critical_fs} // [];
        if (@$critical) {
            print "\n  ${RED}⚠ Warning: " . scalar(@$critical)
                . " filesystem(s) above 90% usage!$RESET\n";
        }

        my $io_stats = $d->{io_stats};
        if ($io_stats) {
            print "\n  ${BOLD}I/O Stats (iostat):$RESET\n";
            for my $dev (@{ $io_stats->{devices} // [] }) {
                printf "  %-10s tps: %8.1f  read: %8.2f MB/s  write: %8.2f MB/s\n",
                    $dev->{device}, $dev->{tps}, $dev->{read_mb_s}, $dev->{write_mb_s};
            }
        }
    }

    # Network
    if (exists $data->{network}) {
        section_header(($position{network} + 1) . '. Network');
        my $n = $data->{network};

        for my $iface (@{ $n->{interfaces} // [] }) {
            my $state_col = $iface->{state} eq 'UP' ? $GREEN : $RED;
            my $v6 = @{ $iface->{ipv6} } ? join(', ', @{ $iface->{ipv6} }) : "${DIM}(none)$RESET";
            my $v4 = @{ $iface->{ipv4} } ? join(', ', @{ $iface->{ipv4} }) : "${DIM}(none)$RESET";
            printf "  %-8s %s%-5s%s  speed: %s\n",
                $iface->{name}, $state_col, $iface->{state}, $RESET,
                $iface->{speed} // 'unknown';
            print "    IPv6: $v6\n";
            print "    IPv4: $v4\n";
        }

        my $conns = $n->{connections} // {};
        if (%$conns) {
            kv('TCP established', $conns->{tcp_established} // '?');
            kv('Total connections', $conns->{total} // '?');
        }

        my $routes = $n->{routes} // {};
        kv('Default IPv6 route', $routes->{v6}) if $routes->{v6};
        kv('Default IPv4 route', $routes->{v4}) if $routes->{v4};

        my $ext_ip = $n->{external_ip} // {};
        kv('External IPv6', $ext_ip->{v6}) if ($ext_ip->{v6} // 'unknown') ne 'unknown';
        kv('External IPv4', $ext_ip->{v4}) if ($ext_ip->{v4} // 'unknown') ne 'unknown';
    }

    # GPU
    if (exists $data->{gpu}) {
        section_header(($position{gpu} + 1) . '. GPU');
        my $g = $data->{gpu};
        if ($g && $g->{unavailable}) {
            print "  ${DIM}GPU detection unavailable (no rocm-smi/lspci)$RESET\n";
        }
        elsif ($g) {
            print "  ${YELLOW}(hardware detected, GPU drivers not loaded)$RESET\n"
                if $g->{fallback};
            print '  Vendor: ' . ($g->{vendor} // 'unknown') . "\n";
            for my $card (@{ $g->{cards} // [] }) {
                # A card's properties print in the order their source listed them,
                # which is not recoverable from a Perl hash: a card from
                # lspci carries model, vendor and driver, one from rocm-smi carries id
                # followed by the properties rocm-smi printed, so the known keys are
                # laid out in those two orders and anything unexpected follows,
                # sorted.
                my %known = map { $_ => 1 } @CARD_KEY_ORDER;
                my @keys = grep { exists $card->{$_} } @CARD_KEY_ORDER;
                push @keys, sort grep { !$known{$_} } keys %$card;
                for my $key (@keys) {
                    kv(ucfirst($key), $card->{$key});
                }
            }
            my $vram = $g->{vram};
            if ($vram) {
                my $total = $vram->{total_mb} // 0;
                my $used = $vram->{used_mb} // 0;
                my $free = $vram->{free_mb} // 0;
                my $pct = $total > 0 ? $used / $total * 100 : 0;
                my $colour = $pct < 80 ? $GREEN : $pct < 90 ? $YELLOW : $RED;
                kv('VRAM Used/Total', sprintf('%s%d/%d MiB%s (%.0f%%)', $colour, $used, $total, $RESET, $pct));
                kv('VRAM Free', "$free MiB");
            }
        }
        else {
            print "  ${DIM}No GPU detected$RESET\n";
        }
    }

    # Services
    if (exists $data->{services}) {
        section_header(($position{services} + 1) . '. Services');
        my $s = $data->{services};

        my $failed = $s->{failed_units};
        if (!defined $failed) {
            print "  ${DIM}Failed units: unavailable (systemctl not installed)$RESET\n";
        }
        elsif (@$failed) {
            print "  ${RED}Failed units: " . scalar(@$failed) . "$RESET\n";
            for my $unit (@$failed) {
                print "    ${RED}✗$RESET $unit->{unit} ($unit->{state})\n";
            }
        }
        else {
            print "  ${GREEN}No failed units$RESET\n";
        }

        print "\n";
        my $ks = $s->{key_services} // {};
        for my $name (sort keys %$ks) {
            my $status = $ks->{$name}{status} // 'unknown';
            if ($status eq 'active') {
                printf "  %s●%s %-15s %s%s%s\n", $GREEN, $RESET, $name, $GREEN, $status, $RESET;
            }
            elsif ($status eq 'inactive') {
                printf "  %s○%s %-15s %s%s%s\n", $YELLOW, $RESET, $name, $YELLOW, $status, $RESET;
            }
            elsif ($status eq 'failed') {
                printf "  %s✗%s %-15s %s%s%s\n", $RED, $RESET, $name, $RED, $status, $RESET;
            }
            else {
                printf "  %s─%s %-15s %s%s%s\n", $DIM, $RESET, $name, $DIM, $status, $RESET;
            }
        }
    }

    # Security
    if (exists $data->{security}) {
        section_header(($position{security} + 1) . '. Security');
        my $sc = $data->{security};

        my $selinux = $sc->{selinux} // 'unknown';
        my $sel_col = $selinux eq 'Enforcing' ? $GREEN
                    : $selinux eq 'Permissive' ? $YELLOW
                    : $selinux eq 'Disabled' ? $RED
                    : $DIM;   # unknown: SELinux tooling not installed
        kv('SELinux', "$sel_col$selinux$RESET");

        my $fw = $sc->{firewalld} // {};
        if ($fw->{available}) {
            kv_status('Firewalld active', $fw->{active} ? 1 : 0, 'active', 'inactive');
            kv('Default zone', $fw->{default_zone}) if $fw->{default_zone};
            kv('Active zones', join(', ', @{ $fw->{zones} // [] })) if @{ $fw->{zones} // [] };
        }
        else {
            kv('Firewalld', "${DIM}not installed$RESET");
        }

        kv('Failed SSH (today)', $sc->{failed_ssh_attempts} // 0);
        kv('Open TCP ports', $sc->{open_ports_count} // 0);

        my $logins = $sc->{last_logins} // [];
        if (@$logins) {
            print "\n  ${BOLD}Last logins:$RESET\n";
            print "    $_\n" for @$logins;
        }
    }

    # Performance
    if (exists $data->{performance}) {
        section_header(($position{performance} + 1) . '. Performance');
        my $p = $data->{performance};

        kv('Processes total', $p->{processes_total} // 0);
        my $zombies = $p->{zombies} // 0;
        my $zombie_col = $zombies == 0 ? $GREEN : $RED;
        kv('Zombie processes', "$zombie_col$zombies$RESET");

        my $ctxt = $p->{context_switches} // {};
        kv('Ctxt switches (boot)', $ctxt->{ctxt} // '?');
        kv('Interrupts (boot)', $ctxt->{intr} // '?');

        my $load_ratio = $p->{load_vs_cores_ratio} // 0;
        my $ratio_col = $load_ratio < 1 ? $GREEN : $load_ratio < 2 ? $YELLOW : $RED;
        kv('Load / cores ratio', sprintf('%s%.2f%s', $ratio_col, $load_ratio, $RESET));

        my $top_cpu = $p->{top_cpu_processes} // [];
        if (@$top_cpu) {
            print "\n  ${BOLD}Top 5 CPU consumers (lifetime average):$RESET\n";
            printf "  %-8s %-10s %6s  COMMAND\n", 'PID', 'USER', 'CPU%';
            for my $proc (@$top_cpu) {
                printf "  %-8d %-10s %5.1f%%  %s\n",
                    $proc->{pid}, $proc->{user}, $proc->{cpu_pct}, $proc->{command};
            }
        }
    }

    # Recent issues
    if (exists $data->{issues}) {
        section_header(($position{issues} + 1) . '. Recent Issues');
        my $i = $data->{issues};

        my $errors = $i->{recent_errors} // [];
        if (@$errors) {
            print "  ${BOLD}Last " . scalar(@$errors) . " errors from journal:$RESET\n";
            for my $line (@$errors) {
                my $display = length($line) > 120 ? substr($line, 0, 120) . "…" : $line;
                print "    ${DIM}$display$RESET\n";
            }
        }
        else {
            print "  ${GREEN}No recent errors in journal$RESET\n";
        }

        my $oops = $i->{kernel_oops} // [];
        if (@$oops) {
            print "\n  ${RED}⚠ Kernel OOPS / panic messages:$RESET\n";
            for my $line (@$oops) {
                my $display = length($line) > 120 ? substr($line, 0, 120) . "…" : $line;
                print "    ${RED}$display$RESET\n";
            }
        }
        else {
            print "\n  ${GREEN}No kernel OOPS detected$RESET\n";
        }

        my $oom = $i->{oom_events} // [];
        if (@$oom) {
            print "\n  ${RED}⚠ OOM events:$RESET\n";
            for my $line (@$oom) {
                my $display = length($line) > 120 ? substr($line, 0, 120) . "…" : $line;
                print "    ${RED}$display$RESET\n";
            }
        }
        else {
            print "\n  ${GREEN}No OOM events in kernel log$RESET\n";
        }
    }

    # Health score
    section_header((scalar(@order) + 1) . '. Health Score');
    my $bd = $health->{breakdown} // {};
    my @labels = (
        ['cpu_usage',    'CPU usage < 80%'],
        ['memory_usage', 'Memory usage < 85%'],
        ['disk_usage',   'No disk > 90%'],
        ['selinux',      'SELinux enforcing'],
        ['services',     'No failed services'],
        ['load',         'Load < cores'],
        ['zombies',      'No zombie processes'],
        ['swap',         'Swap usage < 50%'],
        ['firewall',     'Firewall active'],
    );
    my %label_for = map { $_->[0] => $_->[1] } @labels;
    my $maxima = $health->{maxima} // {};
    for my $item (@labels) {
        my ($key, $label) = @$item;
        next unless exists $bd->{$key};
        my $points = $bd->{$key};
        my $max_points = $maxima->{$key} // 10;
        my $bar_line = ("█" x ($points > 0 ? $points : 0))
                     . ("░" x ($max_points - ($points > 0 ? $points : 0)));
        printf "  %-24s %s %s/%s\n", $label, $bar_line, $points, $max_points;
    }
    my $skipped = $health->{factors_skipped} // [];
    if (@$skipped) {
        my $names = join(', ', map { $label_for{$_} // $_ } @$skipped);
        print "  ${DIM}Not assessed (data unavailable, score renormalised):$RESET\n";
        print "  ${DIM}$names$RESET\n";
    }

    # Footer
    print "\n";
    print "${BOLD}${bar}$RESET\n";
    # An absent score prints the string None: the key exists with a null value,
    # so no defined-or default would apply and the text is what shows.
    my $score_text = defined $health->{score} ? $health->{score} : 'None';
    print "  ${BOLD}Health Score: ${grade_colour}${grade_letter}$RESET  "
        . '(' . $score_text . '/' . ($health->{max_score} // 100) . ")\n";
    print "${BOLD}${bar}$RESET\n";
    print "\n";
    return;
}

# ---------------------------------------------------------------------------
# Collection, in forked children
# ---------------------------------------------------------------------------

sub perl_literal {
    my ($value) = @_;
    return 'undef' unless defined $value;
    if (ref $value eq 'HASH') {
        return '{ ' . join(', ', map { perl_literal($_) . ' => ' . perl_literal($value->{$_}) }
                                  sort keys %$value) . ' }';
    }
    if (ref $value eq 'ARRAY') {
        return '[' . join(', ', map { perl_literal($_) } @$value) . ']';
    }
    # A whole number stays a number, so the collector hashes keep their integers and
    # their boolean flags usable.  Everything else is quoted: a value rounded to
    # a decimal has to survive this round trip as the text it is, or 18.0
    # would come back as 18 and be written to JSON as an integer.  A leading zero
    # must be quoted too, because unquoted it would read back as octal: 010 comes
    # back as 8 and 08 fails to parse at all.
    return $value if !ref $value && $value =~ /^(?:0|-?[1-9][0-9]*)$/;
    my $text = $value;
    $text =~ s/([\\'])/\\$1/g;
    return "'$text'";
}

sub read_literal {
    my ($file) = @_;
    return (undef, 'result file was not written') unless -f $file;
    open(my $fh, '<', $file) or return (undef, "cannot read the result: $!");
    my $text = do { local $/ = undef; <$fh> };
    close($fh);
    return (undef, 'empty result') unless defined $text && length $text;
    my $value = eval $text;
    return (undef, 'unreadable result') if $@;
    return ($value, '');
}

# The sections are independent and each is dominated by waiting, so they run as
# forked children, one per section.  A child writes its result as a Perl literal
# into the private scratch directory and the parent reads it back after reaping;
# progress is reported in completion order.
sub collect_all {
    my ($sections, $external_ip) = @_;
    my %data = (
        version   => $VERSION,
        timestamp => timestamp_fields(time()),
    );

    my @collectors = (
        ['overview',    'system overview', sub { collect_overview() }],
        ['cpu',         'CPU',             sub { collect_cpu() }],
        ['memory',      'memory',          sub { collect_memory() }],
        ['disk',        'disk',            sub { collect_disk() }],
        ['network',     'network',         sub { collect_network($external_ip) }],
        ['gpu',         'GPU',             sub { collect_gpu() }],
        ['services',    'services',        sub { collect_services() }],
        ['security',    'security',        sub { collect_security() }],
        ['performance', 'performance',     sub { collect_performance() }],
        ['issues',      'recent issues',   sub { collect_issues() }],
    );

    my %seen;
    my @plan;
    for my $section (@$sections) {
        next if $seen{$section}++;
        for my $entry (@collectors) {
            push @plan, $entry if $entry->[0] eq $section;
        }
    }
    return \%data unless @plan;

    my $dir = scratch_dir();
    my (%pid_of, %file_of, %label_of);
    for my $entry (@plan) {
        my ($section, $label, $code) = @$entry;
        my $file = "$dir/$section";
        $file_of{$section} = $file;
        $label_of{$section} = $label;
        my $pid = fork();
        die "cannot fork: $!\n" unless defined $pid;
        if ($pid == 0) {
            # A child must not inherit the parent's interrupt handling.
            $SIG{INT} = 'DEFAULT';
            $SIG{TERM} = 'DEFAULT';
            my $ok = eval {
                open(my $fh, '>', $file) or die "cannot write $file: $!\n";
                print {$fh} perl_literal($code->()), "\n";
                close($fh);
                1;
            };
            if (!$ok) {
                my $error = $@ || 'unknown error';
                $error =~ s/\s+\z//;
                if (open(my $fh, '>', $file)) {
                    print {$fh} perl_literal({ error => $error }), "\n";
                    close($fh);
                }
            }
            exit($ok ? 0 : 1);
        }
        $pid_of{$pid} = $section;
    }

    for (1 .. scalar @plan) {
        my $pid = waitpid(-1, 0);
        last if $pid <= 0;
        my $section = $pid_of{$pid};
        next unless defined $section;
        my $exit_status = $? >> 8;
        my $label = $label_of{$section};
        my ($result, $read_error) = read_literal($file_of{$section});

        _status("Collecting $label");
        # A child that exits well and wrote the literal undef collected honestly:
        # collect_gpu returns undef when there is no GPU, which is a result, not a
        # failure.  Only a nonzero exit or an unreadable file is a failure.
        if ($exit_status != 0 || (!defined $result && length $read_error)) {
            my $message = $read_error;
            $message = $result->{error} if ref $result eq 'HASH' && $result->{error};
            $message = 'collection failed' unless defined $message && length $message;
            $data{$section} = { error => $message };
            _status_done('error');
            print STDERR "  [$label] $message\n";
            next;
        }
        $data{$section} = $result;
        _status_done();
    }

    remove_scratch();
    return \%data;
}

# ---------------------------------------------------------------------------
# Command line
# ---------------------------------------------------------------------------

sub usage {
    my $name = $0;
    $name =~ s{.*/}{};
    return <<"USAGE";
Usage: $name [options]

System diagnostics: CPU, memory, disk, network, GPU, services, security, performance

Options:
  --section LIST   Comma-separated sections to run. Available: @{[ join(', ', @ALL_SECTIONS) ]}  [default: all]
  --external-ip    Also detect external IP addresses via icanhazip.com (sends a request to a third-party service)
  --json           Output machine-readable JSON to stdout
  --version        Show the version and exit
  -h, --help       Show this help and exit
USAGE
}

sub parse_args {
    my %opt = (section => '', external_ip => 0, json => 0);
    my @argv = @ARGV;
    while (defined(my $arg = shift @argv)) {
        if ($arg eq '--section') {
            my $value = shift @argv;
            if (!defined $value) {
                print STDERR "argument --section: expected one argument\n";
                exit 2;
            }
            $opt{section} = $value;
            next;
        }
        if ($arg =~ /^--section=(.*)$/s) { $opt{section} = $1; next }
        if ($arg eq '--external-ip') { $opt{external_ip} = 1; next }
        if ($arg eq '--json') { $opt{json} = 1; next }
        if ($arg eq '--help' || $arg eq '-h') { print usage(); exit 0 }
        if ($arg eq '--version') {
            my $name = $0;
            $name =~ s{.*/}{};
            print "$name $VERSION\n";
            exit 0;
        }
        print STDERR "unrecognised argument: $arg\n";
        print STDERR usage();
        exit 2;
    }
    return %opt;
}

# ---------------------------------------------------------------------------
# Entry point
# ---------------------------------------------------------------------------

sub main {
    my %opt = parse_args();

    if ($^O ne 'linux') {
        print STDERR "${RED}Error: system-diag.pl currently supports Linux only "
            . "(detected platform: $^O).$RESET\n";
        exit 1;
    }

    my @sections;
    if (length $opt{section}) {
        my @requested = map {
            my $name = $_;
            $name =~ s/^\s+//;
            $name =~ s/\s+$//;
            lc $name;
        } split /,/, $opt{section};
        my @invalid = grep {
            my $name = $_;
            !grep { $_ eq $name } @ALL_SECTIONS;
        } @requested;
        if (@invalid) {
            print STDERR "${RED}Error: unknown section(s): " . join(', ', @invalid) . "$RESET\n";
            print STDERR 'Available: ' . join(', ', @ALL_SECTIONS) . "\n";
            exit 1;
        }
        @sections = @requested;
    }
    else {
        @sections = @ALL_SECTIONS;
    }

    my $data = collect_all(\@sections, $opt{external_ip});
    $data->{health} = compute_health($data);

    if ($opt{json}) {
        print json_encode($data);
    }
    else {
        print_report($data);
    }
    return 0;
}

$SIG{INT} = sub {
    print STDERR "\nInterrupted.\n";
    remove_scratch();
    exit 130;
};
$SIG{TERM} = sub {
    remove_scratch();
    exit 143;
};
END {
    remove_scratch();
}

# Only when this file is the program: a test harness may require it and call the
# pure functions directly.
exit(main()) unless caller;