commit 788cf0571f4b77b7e513350ce2a0c5578a50c40c
Author: Petr Balvín <opensource@petrbalvin.org>
Date:   Thu Sep 10 04:00:00 2026 +0000

    feat: initial release of the scripts collection
    
    Assisted-by: GLM 5.3 Flash

diff --git a/.gitea/workflows/deploy.yml b/.gitea/workflows/deploy.yml
new file mode 100644
index 0000000..9dce71e
--- /dev/null
+++ b/.gitea/workflows/deploy.yml
@@ -0,0 +1,104 @@
+# Deploy: the scripts over rsync. Runs on every push to main and on manual dispatch,
+# because scripts are not versioned and go live immediately.
+#
+# Requires secrets: DEPLOY_HOST, DEPLOY_USER, DEPLOY_PATH, DEPLOY_PASSWORD,
+# DEPLOY_KNOWN_HOSTS (the host key, from ssh-keyscan -t ed25519 HOST).
+#
+# Every step is one command, and the scripted steps are Perl rather than shell, so
+# nothing has to be trusted to a shell option and no shell ever parses an argument.
+# The Perl uses builtins only.  The host key is pinned from the secret before the
+# first connection: pointing UserKnownHostsFile at /dev/null would disable
+# verification and turn every deploy into a blind trust on first use.
+name: Deploy
+
+on:
+  push:
+    branches: [main]
+  workflow_dispatch:
+
+jobs:
+  deploy:
+    runs-on: alpine
+    timeout-minutes: 10
+    steps:
+      - uses: actions/checkout@v7
+
+      - name: Install Perl
+        # The alpine base image carries no Perl.
+        run: apk add --no-cache perl
+
+      - name: Generate SHA256SUMS
+        run: |
+          perl -e '
+            my @files = sort glob q{*.pl};
+            @files or die qq{ERROR: no scripts found\n};
+            open(my $out, q{>}, q{SHA256SUMS}) or die qq{SHA256SUMS: $!\n};
+            for my $file (@files) {
+              open(my $sums, q{-|}, q{sha256sum}, $file) or die qq{sha256sum: $!\n};
+              my $line = <$sums>;
+              # close waits for the child and answers false when it failed.
+              close($sums) or die qq{ERROR: sha256sum failed for $file\n};
+              defined $line or die qq{ERROR: sha256sum produced nothing for $file\n};
+              print $out $line;
+              print $line;
+            }
+            close($out) or die qq{SHA256SUMS: $!\n};
+          '
+
+      - name: Pin the host key
+        env:
+          DEPLOY_KNOWN_HOSTS: ${{ secrets.DEPLOY_KNOWN_HOSTS }}
+        run: |
+          # The runner has no persistent known_hosts, so the key comes from a secret
+          # and is written before the first connection.
+          perl -e '
+            my $key = $ENV{DEPLOY_KNOWN_HOSTS} // q{};
+            $key =~ m{\S} or die qq{ERROR: DEPLOY_KNOWN_HOSTS is empty\n};
+            my $dir = ($ENV{HOME} // q{.}) . q{/.ssh};
+            mkdir($dir, 0700) unless -d $dir;
+            open(my $out, q{>}, qq{$dir/known_hosts}) or die qq{known_hosts: $!};
+            print $out $key;
+            $key =~ m{\n\z} or print $out qq{\n};
+            close($out);
+            chmod(0600, qq{$dir/known_hosts}) or die qq{chmod: $!};
+            print qq{host key pinned in $dir/known_hosts\n};
+          '
+
+      - name: Deploy via rsync
+        env:
+          DEPLOY_HOST: ${{ secrets.DEPLOY_HOST }}
+          DEPLOY_USER: ${{ secrets.DEPLOY_USER }}
+          DEPLOY_PATH: ${{ secrets.DEPLOY_PATH }}
+          DEPLOY_PASSWORD: ${{ secrets.DEPLOY_PASSWORD }}
+        run: |
+          # rsync is driven from Perl through system() with a list, so no shell ever
+          # parses the password, the remote path or the ssh options.  The published
+          # set is staged into one directory and mirrored whole, because --delete
+          # only prunes when rsync walks a directory: a file list transfer would
+          # leave a script removed from the repository live on the host.
+          perl -e '
+            my $host = $ENV{DEPLOY_HOST} // die qq{ERROR: DEPLOY_HOST is unset\n};
+            my $user = $ENV{DEPLOY_USER} // die qq{ERROR: DEPLOY_USER is unset\n};
+            my $path = $ENV{DEPLOY_PATH} // die qq{ERROR: DEPLOY_PATH is unset\n};
+            my $pass = $ENV{DEPLOY_PASSWORD} // die qq{ERROR: DEPLOY_PASSWORD is unset\n};
+            my @files = sort glob q{*.pl};
+            @files or die qq{ERROR: no scripts found\n};
+            my $stage = ($ENV{HOME} // q{.}) . q{/.deploy-stage.} . $$;
+            mkdir($stage, 0700) or die qq{ERROR: cannot create the staging directory: $!\n};
+            for my $file (@files, q{SHA256SUMS}) {
+              system(q{cp}, q{-p}, $file, $stage) == 0
+                or die qq{ERROR: cannot stage $file\n};
+            }
+            # The staged files are public on the host, so the directory must stay
+            # traversable by nginx: rsync -a would carry 0700 over and every URL
+            # behind it would answer 403.
+            chmod(0755, $stage) or die qq{ERROR: cannot chmod the staging directory: $!\n};
+            print qq{Deploying to $user\@$host:$path\n};
+            my @cmd = (q{sshpass}, q{-p}, $pass, q{rsync}, q{-avz}, q{--delete},
+              q{-e}, q{ssh -o StrictHostKeyChecking=yes}, qq{$stage/},
+              qq{$user\@$host:$path});
+            system(@cmd) == 0 or die qq{ERROR: rsync failed\n};
+            system(q{rm}, q{-rf}, $stage) == 0
+              or die qq{ERROR: cannot remove the staging directory\n};
+            print qq{Deploy complete.\n};
+          '
diff --git a/.gitea/workflows/test.yml b/.gitea/workflows/test.yml
new file mode 100644
index 0000000..b7b049f
--- /dev/null
+++ b/.gitea/workflows/test.yml
@@ -0,0 +1,107 @@
+# Test: the push-path gates for the scripts collection. Runs on every push and pull
+# request against development, never on main, which is release-only.
+#
+# The gates are the same set the repository documents in docs/DEVELOPMENT.md: every
+# script compiles, carries its licence header, uses no dash as punctuation, and passes
+# its own checks under tests/.  They are the affordable ones: the container rigs that
+# verify a script against a real system need podman and a privileged container, which
+# belong to the machine at the keyboard, not to a shared runner.
+#
+# Every step is one command, and the scripted steps are Perl rather than shell, so no
+# shell option has to be trusted for the run to stop.  The Perl uses builtins only:
+# the runner packages the modules separately.
+name: Test
+
+on:
+  push:
+    branches: [development]
+  pull_request:
+    branches: [development]
+
+jobs:
+  test:
+    runs-on: fedora
+    timeout-minutes: 10
+    steps:
+      - uses: actions/checkout@v7
+
+      - name: Install Perl
+        run: dnf install -y perl
+
+      - name: Every script compiles
+        run: |
+          perl -e '
+            my @files = sort glob q{*.pl};
+            @files or die qq{ERROR: no scripts found\n};
+            for my $file (@files) {
+              system(q{perl}, q{-c}, $file) == 0 or die qq{ERROR: $file does not compile\n};
+            }
+            print qq{compiled @files[0..$#files]: }, scalar(@files), qq{ scripts\n};
+          '
+
+      - name: Every script carries the licence header
+        run: |
+          perl -e '
+            my @files = sort glob q{*.pl};
+            @files or die qq{ERROR: no scripts found\n};
+            for my $file (@files) {
+              open(my $fh, q{<}, $file) or die qq{ERROR: $file: $!\n};
+              my @head = map { my $line = <$fh> // q{}; chomp $line; $line } 1 .. 3;
+              close($fh);
+              $head[0] =~ m{^#!/usr/bin/env perl\z}
+                or die qq{ERROR: $file has no Perl shebang in the form this collection uses\n};
+              # The name carries a non-ASCII letter and the files are byte strings,
+              # so its UTF-8 bytes are matched rather than a wildcard width.
+              $head[1] =~ m{^# Copyright \(c\) \d{4} Petr Balv\xc3\xadn <opensource\@petrbalvin\.org> \(https://petrbalvin\.org\)\z}
+                or die qq{ERROR: $file has no copyright line\n};
+              $head[2] =~ m{^# SPDX-License-Identifier: MIT\z}
+                or die qq{ERROR: $file has no SPDX line, or names another licence\n};
+            }
+            print qq{licence header present in }, scalar(@files), qq{ scripts\n};
+          '
+
+      - name: No dash as punctuation
+        run: |
+          perl -e '
+            my @files = (sort(glob q{*.pl}), sort(glob q{tests/*.pl}), sort(glob q{*.md}),
+              sort(glob q{.gitea/workflows/*.yml}));
+            @files or die qq{ERROR: no files found\n};
+            my $found = 0;
+            for my $file (@files) {
+              open(my $fh, q{<}, $file) or die qq{ERROR: $file: $!\n};
+              my $number = 0;
+              while (my $line = <$fh>) {
+                $number++;
+                # The bytes matter: the files are byte strings, so the em dash and
+                # the en dash are matched as their UTF-8 sequences.
+                if ($line =~ /\xe2\x80\x94|\xe2\x80\x93/) {
+                  print qq{ERROR: $file:$number uses a dash as punctuation\n};
+                  $found++;
+                }
+              }
+              close($fh);
+            }
+            die qq{ERROR: $found line(s) use a dash as punctuation\n} if $found;
+            print qq{no dash used as punctuation in }, scalar(@files), qq{ files\n};
+          '
+
+      - name: network-diag.pl
+        run: perl tests/network-diag.pl
+
+      - name: security-audit.pl
+        run: perl tests/security-audit.pl
+
+      - name: server-setup.pl
+        run: perl tests/server-setup.pl
+
+      - name: sglang-deploy.pl
+        run: perl tests/sglang-deploy.pl
+
+      - name: system-diag.pl
+        run: perl tests/system-diag.pl
+
+      - name: system-optimise.pl
+        run: perl tests/system-optimise.pl
+
+      - name: workstation-setup.pl
+        run: perl tests/workstation-setup.pl
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..5bd27cb
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,5 @@
+.idea/
+.zcode/
+
+# Generated by CI, deployed alongside the scripts
+SHA256SUMS
diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md
new file mode 100644
index 0000000..556dbae
--- /dev/null
+++ b/CONTRIBUTING.md
@@ -0,0 +1,114 @@
+# Contributing
+
+Thanks for contributing to **scripts**.
+
+## Development setup
+
+Requirements: Perl 5.38 or newer, which is what the oldest supported system ships
+(CentOS Stream 10 carries 5.40, openEuler 24.03 LTS carries 5.38). No module beyond the
+interpreter is needed, by design: the scripts use builtins only. Podman is needed only
+for the container rigs described in [docs/DEVELOPMENT.md](docs/DEVELOPMENT.md).
+
+```sh
+git clone https://sourcedock.dev/petrbalvin/scripts.git
+cd scripts
+perl -c network-diag.pl
+perl tests/network-diag.pl
+```
+
+## Workflow
+
+1. Branch from `development`. Never commit directly to `main`, which is release-only.
+2. Commit in [Conventional Commits](https://www.conventionalcommits.org/) form:
+   `type(scope): description`, subject line only, imperative mood, lowercase after the
+   colon, no trailing full stop. Allowed types: `feat`, `fix`, `docs`, `style`,
+   `refactor`, `perf`, `test`, `chore`, `ci`, `build`, `revert`.
+3. One logical change per commit. A refactor, a behaviour change and a formatting pass
+   are three commits, never one.
+4. Add or extend the checks in `tests/` for the code you touched. A new script arrives
+   with its own `tests/<script>.pl`.
+5. Update the documentation when the flags, the behaviour or the target systems change.
+6. Open a pull request against `development`.
+
+`main` is not a release branch in the usual sense: the deploy pipeline publishes the
+scripts on every push to it, so a merge to `main` is a release. The scripts carry their
+own versions, and the commit history is the record of what changed.
+
+## Code style
+
+There is no formatter to run, and the style is the one the other scripts already share.
+Read the script nearest to your change and follow it.
+
+- **Builtins only.** No `use` beyond `strict` and `warnings`. A job Perl has no builtin
+  for is either written out in the script (the command runner, version comparison, the
+  JSON codecs, IPv4 and IPv6 arithmetic) or delegated to a system binary through the
+  script's `run` helper, which is how `dnf`, `rpm`, `curl`, `openssl`, `podman`,
+  `systemctl` and the rest are driven.
+- **Every external command is one argument list.** `run([...])` never builds a string,
+  so no shell parses a path, a key or a URL.
+- **Idempotence is the contract.** Every operation checks the current state first and
+  reports what it found; running a script twice must change nothing the second time.
+- **`--dry-run` changes nothing**, and the summary of a dry run reads as a preview, not
+  as an accomplishment.
+- **Messages are in British English, on stderr**, and none of them uses a dash as
+  punctuation.
+- `perl -c <script>` must be clean, and so must `perl tests/<script>.pl`.
+- New files open with the shebang `#!/usr/bin/env perl`, then the two-line licence
+  header whose SPDX identifier matches [LICENSE](LICENSE).
+
+The gates are listed in [docs/DEVELOPMENT.md](docs/DEVELOPMENT.md), and the test
+pipeline runs the same set.
+
+## AI contribution policy
+
+AI tools are welcome as productivity aids and are a normal part of modern software
+development. What matters is that the contribution stays understandable, reviewable and
+genuinely useful.
+
+- **Disclose the assistance.** If AI helped draft any part of a commit, issue, pull
+  request or review, say so.
+- **Commit messages carry exactly one trailer**, on the line after the subject:
+
+  ```
+  Assisted-by: MODEL
+  ```
+
+  Name the model that did the work, spelled the way its maker spells it, for example
+  `GLM 5.3`, `DeepSeek V4.1 Flash` or `Qwen 3.8 Flash`. No `Co-Authored-By`, no
+  `Signed-off-by`, no other trailers, and no prose: the trailer is the disclosure.
+- **Issues and pull requests** attribute the assistance in a comment, for example
+  `_Assisted-by: GLM 5.3_`. It does not belong in the pull request description.
+- **Take responsibility.** You are accountable for the accuracy, completeness and
+  intent of everything you submit, whether or not AI produced it.
+- **Review before marking ready.** Read the diff carefully, run it locally, and add the
+  tests it needs. Do not mark a pull request ready until you can defend every change in
+  it.
+- **Quality over quantity.** Contributions that look like un-reviewed output, or whose
+  author cannot engage substantively during review, may be closed.
+- **Preferred models.** Prefer open-weight models with transparent training data and
+  minimal output filtering.
+
+AI assists. It does not replace judgement.
+
+## Continuous integration
+
+Workflows live in `.gitea/workflows/` and run on the project's own runners:
+
+| Workflow | Trigger | What it does |
+|---|---|---|
+| Test | push or pull request to `development` | every script compiles, carries its licence header and uses no dash as punctuation, then the six check files under `tests/` |
+| Deploy | push to `main` | writes `SHA256SUMS` over every script and publishes them over rsync |
+
+The container rigs are not in the pipeline: they need Podman and a privileged
+container, which belong to the machine at the keyboard rather than to a shared runner.
+A change to a script that touches a system is expected to be verified that way locally,
+and the pull request says what was run.
+
+## Reporting bugs
+
+Open an issue at `https://sourcedock.dev/petrbalvin/scripts/issues` with the script and
+its version (the script's `--version`), the operating system and version, the exact
+command, the full output, and the expected against the actual behaviour.
+
+**Security issues do not go in the issue tracker.** Report them as
+[SECURITY.md](SECURITY.md) describes.
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..f83dd2a
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,21 @@
+MIT License
+
+Copyright (c) 2026 Petr Balvín <opensource@petrbalvin.org> (https://petrbalvin.org)
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..54bd5d5
--- /dev/null
+++ b/README.md
@@ -0,0 +1,126 @@
+# Scripts: DevOps Toolbox
+
+A personal collection of standalone scripts for Linux server and desktop management:
+diagnostics, first-time server and workstation setup, routine cleanup, and an
+inference server deployment. Every script is Perl, every one runs on the interpreter's
+own builtins, and none of them needs a module installed beside it.
+
+## Features
+
+- **Diagnostics**: `network-diag.pl` measures latency, packet loss, DNS resolution,
+  MTU and dual-stack reachability and grades the connection; `system-diag.pl` reads
+  the whole machine (CPU, memory, disk, network, GPU, services, security, performance)
+  and grades its health.
+- **Security audit**: `security-audit.pl` grades the machine's defences A to F from the
+  state it is actually in: the effective sshd configuration, the running firewalld
+  checked against the sockets that really listen, SELinux now and at the next boot,
+  pending security updates, accounts and sudo, kernel hardening, and an opt-in deep
+  scan of the file system. A critical finding is a non-zero exit, so a cron job fails
+  loudly.
+- **Setup**: `server-setup.pl` takes a fresh server to a working state (packages,
+  firewall with the SSH rule verified before the service is enabled, SELinux, Podman,
+  automatic updates); `workstation-setup.pl` sets up a Fedora desktop (Brave, the
+  official Go toolchain, Rust, GoLand, Flatpak applications, firewall, SELinux).
+- **Deployment**: `sglang-deploy.pl` puts an SGLang inference server on an AMD GPU
+  behind nginx with HTTPS and an API key, runs the engine from the project's ROCm
+  container image, and downloads the model weights from ModelScope.
+- **Maintenance**: `system-optimise.pl` removes old kernels (the running one and one
+  fallback always stay), vacuums journals, clears temporary files and core dumps, and
+  audits the installed packages against their repositories.
+- **Idempotent by construction**: every operation checks the current state before
+  acting, so a second run reports what is already in place and changes nothing.
+
+## Install
+
+The scripts are single files. Take the repository, or take one script with `curl`:
+
+```sh
+git clone https://sourcedock.dev/petrbalvin/scripts.git
+cd scripts
+```
+
+Requirements: Perl, which every supported system ships. Nothing else: the scripts
+drive the system's own tools (`dnf`, `systemctl`, `podman`, `openssl`, `curl`) rather
+than carrying a library layer, and where a language has no builtin for a job the
+script does the work itself.
+
+## Quick start
+
+```sh
+# Network diagnostics, no root needed
+perl network-diag.pl
+
+# System health, no root needed
+perl system-diag.pl
+
+# Security audit, deeper answers as root
+sudo perl security-audit.pl --deep
+
+# Server setup, as root
+sudo perl server-setup.pl --dry-run
+
+# SGLang on an AMD GPU, as root
+sudo perl sglang-deploy.pl --model ZhipuAI/GLM-5.3
+```
+
+Any script can also be fetched and run in one step:
+
+```sh
+curl -sSf https://petrbalvin.org/scripts/system-diag.pl | perl
+```
+
+#### Integrity verification
+
+A single `SHA256SUMS` file covers every published script. Verify before running:
+
+```sh
+curl -sSfO https://petrbalvin.org/scripts/server-setup.pl
+curl -sSfO https://petrbalvin.org/scripts/SHA256SUMS
+sha256sum -c --ignore-missing SHA256SUMS
+sudo perl server-setup.pl --dry-run
+```
+
+## Usage
+
+Each script documents its own flags; `--help` prints them and `--dry-run` shows what
+a change would do without doing it.
+
+| Script | Version | Purpose |
+|---|---|---|
+| `network-diag.pl` | 2.0.0 | Network latency, DNS, MTU, packet loss and dual-stack on Linux and FreeBSD |
+| `system-diag.pl` | 2.0.0 | System health with a grade from A to F. Linux only |
+| `security-audit.pl` | 2.0.0 | Security posture with a grade from A to F and an exit code for cron. Linux only |
+| `server-setup.pl` | 2.0.0 | Server initial setup for Fedora, CentOS Stream and openEuler |
+| `workstation-setup.pl` | 2.0.0 | Fedora desktop setup |
+| `sglang-deploy.pl` | 2.0.0 | SGLang inference server on an AMD GPU, behind nginx with HTTPS |
+| `system-optimise.pl` | 2.0.0 | System cleanup; refuses rpm-ostree systems |
+
+The full flag reference is in [docs/CLI.md](docs/CLI.md).
+
+## Development
+
+```sh
+perl -c network-diag.pl       # every script compiles
+perl tests/network-diag.pl    # that script's checks
+perl tests/system-diag.pl     # and so on for each script
+```
+
+The local gates are the syntax check, the seven test files, the licence header and the
+punctuation rule; the container rigs that verify a script against a real system are
+described in [docs/DEVELOPMENT.md](docs/DEVELOPMENT.md). See
+[CONTRIBUTING.md](CONTRIBUTING.md) for how to contribute.
+
+## Documentation
+
+- [docs/ARCHITECTURE.md](docs/ARCHITECTURE.md): the shared shape of the scripts and
+  what each one owns
+- [docs/CLI.md](docs/CLI.md): every flag of every script
+- [docs/DEPLOYMENT.md](docs/DEPLOYMENT.md): how the scripts are published, and what
+  they deploy on a host
+- [docs/DEVELOPMENT.md](docs/DEVELOPMENT.md): prerequisites, commands and verification
+
+## Licence
+
+MIT. See [LICENSE](LICENSE).
+
+Copyright © 2026 [Petr Balvín](https://petrbalvin.org)
diff --git a/SECURITY.md b/SECURITY.md
new file mode 100644
index 0000000..cff4721
--- /dev/null
+++ b/SECURITY.md
@@ -0,0 +1,69 @@
+# Security policy
+
+## Supported versions
+
+The published scripts are not versioned artefacts: `https://petrbalvin.org/scripts/` is
+updated on every push to `main`, and each script carries its own version string. A
+security fix goes to the newest published copy and to the `development` branch of the
+repository. Older copies that were downloaded earlier do not receive fixes; take the
+current file again.
+
+`SHA256SUMS` is published beside the scripts and covers every one of them, so a
+downloaded copy can be checked before it runs:
+
+```sh
+curl -sSfO https://petrbalvin.org/scripts/server-setup.pl
+curl -sSfO https://petrbalvin.org/scripts/SHA256SUMS
+sha256sum -c --ignore-missing SHA256SUMS
+```
+
+## Reporting a vulnerability
+
+**Do not open a public issue for a security problem.** A public report tells everyone
+about the flaw before there is a fix. Report it privately to
+**opensource@petrbalvin.org**.
+
+Include:
+
+- the script and its version (`--version`), and the platform
+- what the problem is, and what an attacker gains from it
+- the smallest reproducer you have, ideally a single command
+- a suggested fix, if you have one
+
+## What to expect
+
+- A human reads the report, and you get an acknowledgement.
+- You are kept informed while the fix is being made, and told when it ships.
+- The fix is published before the details are, and the timing is agreed with you.
+- You are credited in the commit message of the fix, by name or by handle, as you
+  prefer.
+
+## What the scripts already do
+
+These are the properties to check first, because a finding that contradicts one of them
+is a defect worth reporting:
+
+- `server-setup.pl` writes the SSH rule into the permanent firewalld configuration and
+  verifies it through the offline client **before** firewalld is enabled, so enabling
+  the firewall cannot lock the operator out.
+- `sglang-deploy.pl` protects the endpoint with an API key stored in a root-only
+  `EnvironmentFile` (`/etc/sysconfig/sglang`, mode 0600), serves it over TLS only, and
+  binds the engine to the loopback address.
+- `workstation-setup.pl` verifies what it downloads: the Go tarball against the SHA-256
+  in go.dev's download API, the GoLand tarball against JetBrains' published checksum,
+  and Brave's repository key against the fingerprints published on brave.com.
+- Downloads are never piped into a shell: a fetched installer lands in a file first and
+  is executed only after the transfer completed.
+
+## Out of scope
+
+- Findings that require the attacker to already have root, or to already run code as the
+  user who runs the script.
+- Missing hardening with no demonstrated impact, such as a script not setting a stricter
+  umask than the system's.
+- Flaws in a third-party tool the scripts drive (`dnf`, `podman`, `openssl`, `nginx` and
+  the rest): report those to that project, and here only when this repository's use of
+  the tool makes the flaw reachable in a way the tool's own documentation does not
+  anticipate.
+- The published copies being fetched over HTTPS from a domain the operator does not
+  control, which is the deployment model rather than a defect in the scripts.
diff --git a/docs/ARCHITECTURE.md b/docs/ARCHITECTURE.md
new file mode 100644
index 0000000..d793a26
--- /dev/null
+++ b/docs/ARCHITECTURE.md
@@ -0,0 +1,128 @@
+# Architecture
+
+How the scripts collection is put together. Every script, helper and arrow below
+exists in the repository; nothing is aspirational.
+
+## Overview
+
+There is no shared library. Each script is one file that can be fetched and run on its
+own, and the six of them share a skeleton rather than a module: the same command
+runner, the same progress reporting, the same state checks before every action, and the
+same shape of a run.
+
+```mermaid
+flowchart TD
+    Start[invocation] --> Args[parse_args reads ARGV]
+    Args --> Version{version or help?}
+    Version -->|yes| Print[print and exit]
+    Version -->|no| Root[check_root, detect_os]
+    Root --> Sections[sections run in order]
+    Sections --> Each[each section checks state first]
+    Each --> Done{changed?}
+    Done -->|no| Report[report what is already in place]
+    Done -->|yes| Act[act, then verify what was done]
+    Act --> Report
+    Report --> Summary[print_summary on stderr]
+```
+
+A run is idempotent because of that loop: a section reads the state of the system,
+compares it with the desired one, and acts only on the difference, so a second run
+reports everything as already in place and changes nothing.
+
+## The seven scripts
+
+| Script | Owns | Deliberately does not |
+|---|---|---|
+| `network-diag.pl` | Latency, loss, DNS timing, MTU discovery, dual-stack reachability, listening ports, and the grade of the connection | Touch any configuration; it only measures |
+| `system-diag.pl` | Reading CPU, memory, disk, network, GPU, services, security and performance, and grading the result | Change anything on the host; it is read-only |
+| `server-setup.pl` | Base packages, firewall (with the SSH rule verified before the service starts), SELinux, Podman, automatic updates | Install the services themselves; that is the operator's, and the deploy scripts' |
+| `workstation-setup.pl` | A Fedora desktop: Brave, the official Go toolchain, Rust, GoLand, Flatpak applications, firewall, SELinux | Anything on a server distribution; it targets Fedora Workstation |
+| `sglang-deploy.pl` | The SGLang deployment: the container engine, the systemd unit, nginx with TLS, the API key, the firewall rule and the SELinux boolean | The host's own setup, which `server-setup.pl` does first |
+| `system-optimise.pl` | Old kernels (the running one and one fallback always stay), journals, temporary files, core dumps, and the package audit | Touch an rpm-ostree system, which it refuses |
+
+## Data flow: a forked section collection
+
+`system-diag.pl` is the one script whose shape is not linear. Its sections are
+independent and dominated by waiting, so each runs in its own child process, writes its
+result into a private scratch directory as a Perl literal, and the parent reads the
+results back after reaping. The runner keeps stdout and stderr apart in that same
+directory, which is why the file names carry the process id.
+
+```mermaid
+sequenceDiagram
+    participant Parent
+    participant Child as Section child
+    participant Disk as Scratch directory
+    Parent->>Child: fork, one per requested section
+    Child->>Child: collect one section
+    Child->>Disk: write the result as a Perl literal
+    Parent->>Parent: waitpid, report the section as it lands
+    Parent->>Disk: read_literal for each child
+    Parent->>Parent: compute the grade and render the report
+    Parent->>Disk: remove the scratch directory
+```
+
+Only the process that created the scratch directory removes it: a forked child inherits
+the `END` block, so the cleanup is guarded by a parent pid comparison. A child that
+cannot write its result is reported as a missing section, and the grade drops that
+component rather than inventing a value for it.
+
+## Conventions every script follows
+
+- **Builtins only.** No module beyond the interpreter is loaded, because the systems
+  this targets package modules separately. What Perl has no builtin for is written out:
+  the command runner, RPM's version comparison, the JSON decoders and the encoder, the
+  IPv4 and IPv6 arithmetic, `sockaddr` packing, a `which`, and argument parsing.
+- **External binaries as transport.** `dnf`, `rpm`, `curl`, `openssl`, `podman`,
+  `systemctl`, `journalctl`, `find`, `stat`, `sha256sum`, `tar`, `gpg`, `lspci` and the
+  rest are driven as argument lists through `run`, which keeps stdout and stderr apart,
+  forces `LANG=C` and `LC_ALL=C` for parseable output, and turns a timeout, a missing
+  binary and a failed exec into exit codes 124, 127 and 126 rather than exceptions.
+- **One optional module.** `Time::HiRes` is loaded inside an `eval` in the scripts that
+  time something. Where it is absent the affected figures are reported as not measured
+  and the grade drops that component, rather than the script failing.
+- **Atomic writes for system configuration.** A file that a boot depends on is written
+  to a temporary name, flushed, given its mode and owner, and renamed over the target.
+  Perl has no `fsync`, so that barrier is delegated to `sync` where the binary exists.
+- **Errors carry what the tool said.** A failure reproduces the errno, the reason and
+  the path, so a message can be searched for as it stands.
+
+## The SGLang deployment
+
+`sglang-deploy.pl` is the only script that deploys a service, and its engine runs as a
+container. That is a consequence of the material rather than a preference: SGLang
+publishes no ROCm wheel, and its AMD install paths are the project's container images
+or a source build against a full ROCm toolchain that Fedora carries only partly and
+that CentOS Stream and openEuler cannot carry at all.
+
+```mermaid
+flowchart LR
+    Client[client] -->|443| Nginx[nginx on the host, TLS]
+    Nginx -->|loopback, plain HTTP| Engine[SGLang in a Podman container]
+    Engine -->|device nodes| GPU[/dev/kfd, /dev/dri]
+    Engine -->|bind mount| Cache[state directory, model cache]
+    Unit[systemd unit] -->|podman run| Engine
+    EnvFile[EnvironmentFile, mode 0600] -->|API key| Unit
+```
+
+The host therefore needs the amdgpu kernel driver and its device nodes, never a ROCm
+userland. The image tag is resolved from the card's family (mi30x for an MI300 or
+MI325, mi35x for an MI350 or MI355) and from the host's ROCm, because the container's
+ROCm userland must not be newer than the host's kernel driver. A Radeon 8060S or 8050S
+(gfx1151) has no stable tag anywhere; AMD's dated development builds are resolved
+instead, and `--image` pins one. Radeon cards need `SGLANG_USE_AITER=false` and
+`SGLANG_ROCM_FUSED_DECODE_MLA=false` in the unit, which the script writes for them and
+never for an Instinct host.
+
+## Dependencies
+
+Nothing outside the interpreter, and nothing that has to be installed beyond the tools
+each script's own dependency section installs. The non-obvious ones and their reasons:
+
+- `podman` for `sglang-deploy.pl`, because the engine is a container.
+- `lspci` for the GPU family, and `rocm-smi` in `system-diag.pl` for AMD memory and
+  utilisation figures.
+- `sha256sum` in `workstation-setup.pl`, because Perl's builtins have no hash.
+- `sync` for the write barrier after an atomic write.
+- `getent` or `host` in `network-diag.pl` as the resolver transport, since `getent` on
+  FreeBSD implements neither of the `ahosts` databases.
diff --git a/docs/CLI.md b/docs/CLI.md
new file mode 100644
index 0000000..8b30367
--- /dev/null
+++ b/docs/CLI.md
@@ -0,0 +1,197 @@
+# Command line
+
+Every script is its own program, and there is no global command. The reference below is
+taken from each script's own `--help`; if the two disagree, the program is right and
+this file is a defect.
+
+Common to all six: `--version` prints the version and exits, `-h` / `--help` prints the
+usage and exits, options are given as `--name value` or `--name=value`, and an unknown
+option is refused with the usage and exit code 2.
+
+## network-diag.pl
+
+```
+Usage: network-diag.pl [options]
+
+Network diagnostics: latency, DNS, MTU, dual-stack, ports
+
+Options:
+  --target HOST     Target host for tests (default: cloudflare.com)
+  --protocol FAMILY Address family: auto (dual-stack), v4 (IPv4 only),
+                    v6 (IPv6 only) (default: auto)
+  --version         Show the version and exit
+  -h, --help        Show this help and exit
+```
+
+| Flag | Default | Effect |
+|---|---|---|
+| `--target HOST` | `cloudflare.com` | The host pinged, resolved and probed for MTU |
+| `--protocol FAMILY` | `auto` | `auto` measures both families, `v4` and `v6` restrict the run |
+
+Runs without root. Ports belonging to other users are reported as `(no permission)`
+rather than silently dropped.
+
+## system-diag.pl
+
+```
+Usage: system-diag.pl [options]
+
+System diagnostics: CPU, memory, disk, network, GPU, services, security, performance
+
+Options:
+  --section LIST   Comma-separated sections to run. Available: overview, cpu, memory, disk, network, gpu, services, security, performance, issues  [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
+```
+
+| Flag | Default | Effect |
+|---|---|---|
+| `--section LIST` | all | Runs only the named sections |
+| `--external-ip` | off | Sends a request to `icanhazip.com` to report the public address |
+| `--json` | off | Writes the JSON document to stdout instead of the report |
+
+Runs without root; some figures need it and are reported as unavailable instead. Colour
+is used only on a terminal and is suppressed by `NO_COLOR`. The report goes to stderr,
+so `--json` keeps stdout clean.
+
+## server-setup.pl
+
+```
+Usage: server-setup.pl [options]
+
+Idempotent server setup for Fedora Server, CentOS Stream and openEuler
+
+Options:
+  --dry-run             Print what would be done without making changes
+  --skip-update         Skip system update
+  --skip-packages       Skip base package installation
+  --skip-epel           Skip EPEL repository setup on CentOS
+  --skip-firewall       Skip firewall setup
+  --skip-selinux        Skip SELinux configuration
+  --skip-podman         Skip Podman installation
+  --skip-auto-updates   Skip automatic updates configuration
+  --version             Show the version and exit
+  -h, --help            Show this help and exit
+```
+
+Needs root. The `--skip-*` flags exist per section so a section can be left to another
+tool; the sections are ordered update, EPEL, packages, firewall, SELinux, Podman,
+automatic updates.
+
+## workstation-setup.pl
+
+```
+Usage: workstation-setup.pl [options]
+
+Idempotent workstation setup for Fedora
+
+Options:
+  --dry-run        Print what would be done without making changes
+  --skip-update    Skip system update
+  --skip-rpm       Skip RPM package installation
+  --skip-flatpak   Skip Flatpak apps
+  --skip-repos     Skip adding third-party repos
+  --skip-remove    Skip removing pre-installed apps
+  --skip-go        Skip Go toolchain installation
+  --skip-rust      Skip Rust toolchain installation
+  --skip-jetbrains Skip JetBrains IDE installation
+  --skip-firewall  Skip firewall setup
+  --skip-selinux   Skip SELinux setup
+  --version        Show the version and exit
+  -h, --help       Show this help and exit
+```
+
+Needs root, and targets Fedora only. The Go toolchain and GoLand are downloaded and
+verified by checksum; Brave's repository key is verified by fingerprint before import.
+
+## sglang-deploy.pl
+
+```
+Usage: sglang-deploy.pl [options]
+
+  --model ID                     Hugging Face model ID (menu when omitted)
+  --port N                       internal engine port (default: 8000, not 443)
+  --tensor-parallel N            GPUs for tensor parallelism (default: 1, written as
+                                 the engine's --tp-size)
+  --max-model-len N              context length (default: 4096, written as the
+                                 engine's --context-length)
+  --gpu-memory-utilization F     static memory fraction (default: 0.90, written as
+                                 the engine's --mem-fraction-static)
+  --state-dir PATH               state and model cache directory (default: /opt/sglang)
+  --service-name NAME            systemd service name (default: sglang)
+  --cert-dir PATH                TLS certificate directory (default: /etc/ssl/sglang)
+  --image TAG                    engine image (default: resolved from the GPU and
+                                 the newest SGLang release; a Radeon card resolves
+                                 AMD's newest dated gfx1151 build)
+  --rocm-flavour NAME            ROCm flavour of the image (default: from the host
+                                 ROCm; rocm10, rocm724, rocm720 or rocm700)
+  --api-key KEY                  API key for the endpoint (default: generate and
+                                 store in /etc/sysconfig)
+  --dry-run                      preview without making changes
+  --uninstall                    tear down the service, container, nginx config
+                                 and certificates
+  --help                         show this help
+  --version                      show the version
+```
+
+Needs root. Without `--model` an interactive menu offers GLM 5.3, GLM 5.3 Flash,
+DeepSeek V4 Pro, DeepSeek V4 Flash, MiMo V2.5 Pro and MiMo V2.5, plus a free-form
+entry. `--tensor-parallel`, `--max-model-len` and `--gpu-memory-utilization` are
+written to the unit as the engine's own `--tp-size`, `--context-length` and
+`--mem-fraction-static`. The API key is shown once when it is generated; a key given
+with `--api-key` is never echoed. `--uninstall` stops and disables the service, removes
+the unit, the container, the nginx configuration and the certificates, and keeps the
+image and the model cache.
+
+## system-optimise.pl
+
+```
+Usage: system-optimise.pl [options]
+
+Idempotent system cleanup and optimisation for Fedora, CentOS Stream and openEuler
+
+Options:
+  --dry-run       Preview without making changes
+  --skip-dnf      Skip DNF cleanup (autoremove, old kernels, cache)
+  --skip-journal  Skip journal vacuum
+  --skip-tmp      Skip temp file cleanup
+  --skip-cores    Skip core dump cleanup
+  --version       Show the version and exit
+  -h, --help      Show this help and exit
+```
+
+Needs root. The running kernel and one fallback are always kept. Both dnf generations
+are driven: Fedora ships dnf 5, CentOS Stream 10 and openEuler ship dnf 4.
+
+## Exit codes
+
+| Code | Meaning |
+|---|---|
+| `0` | The run completed, and every step it attempted succeeded |
+| `1` | A step failed, a required tool is missing, the hardware does not qualify, or the system is unsupported |
+| `2` | The arguments were wrong, or interactive input was needed and stdin is not a terminal |
+
+A run that finishes with failed steps prints them at the end of the summary and exits 1,
+so a pipeline notices even when the failure was not fatal.
+
+## Examples
+
+```sh
+# Is the connection healthy, and is IPv6 working?
+perl network-diag.pl --target example.org --protocol auto
+
+# The same machine's health as JSON, for a monitoring poll
+perl system-diag.pl --json --section cpu,memory,disk
+
+# A new server, seen before it is changed
+sudo perl server-setup.pl --dry-run
+
+# Cleanup, leaving journals and core dumps alone
+sudo perl system-optimise.pl --skip-journal --skip-cores
+
+# Deploy a model and then take it down again
+sudo perl sglang-deploy.pl --model deepseek-ai/DeepSeek-V4-Flash-0731
+sudo perl sglang-deploy.pl --uninstall
+```
diff --git a/docs/DEPLOYMENT.md b/docs/DEPLOYMENT.md
new file mode 100644
index 0000000..c154f0d
--- /dev/null
+++ b/docs/DEPLOYMENT.md
@@ -0,0 +1,105 @@
+# Deployment
+
+The collection has two senses of deployment: how the scripts themselves are published,
+and what they deploy when they run on a host. Both are below.
+
+## Topology: publishing
+
+The scripts are served from `https://petrbalvin.org/scripts/`, which is a directory on a
+host reached over SSH. The Gitea instance at `sourcedock.dev` holds the repository and
+runs the pipeline; there is no package, no tag and no artefact store, because a script
+that is a single file is published by copying it.
+
+```mermaid
+flowchart LR
+    Dev[development branch] -->|merge| Main[main]
+    Main --> Runner[Gitea runner, alpine]
+    Runner -->|rsync over ssh| Host[petrbalvin.org]
+    Host -->|https| Client[client]
+    Runner -->|SHA256SUMS| Host
+```
+
+## Requirements
+
+- The runner image is `alpine`, which carries `ssh`, `sshpass`, `rsync` and no Perl: the
+  pipeline installs Perl in its first step.
+- Five repository secrets: `DEPLOY_HOST`, `DEPLOY_USER`, `DEPLOY_PATH`,
+  `DEPLOY_PASSWORD`, and `DEPLOY_KNOWN_HOSTS`.
+- `DEPLOY_KNOWN_HOSTS` holds the host key, from
+  `ssh-keyscan -t ed25519 <host>`. The pipeline writes it into `~/.ssh/known_hosts` and
+  connects with `StrictHostKeyChecking=yes`; without the secret the deploy stops before
+  it starts, deliberately, because the alternative is trusting whatever answers on the
+  first connection.
+
+## Build
+
+There is nothing to build. The pipeline writes `SHA256SUMS`, one line per script, hashed
+with `sha256sum` in sorted filename order so the file is stable between runs, and then
+sends the scripts and that file.
+
+## Run
+
+The pipeline runs itself: merging into `main` publishes, and a manual dispatch republishes
+the current tree.
+
+```mermaid
+sequenceDiagram
+    participant Dev
+    participant CI as Gitea runner
+    participant Host as petrbalvin.org
+    Dev->>CI: push to main
+    CI->>CI: write SHA256SUMS over every script
+    CI->>CI: pin the host key from DEPLOY_KNOWN_HOSTS
+    CI->>Host: rsync -avz --delete, the scripts and SHA256SUMS
+    Host-->>CI: exit status of rsync
+    CI->>CI: stop the run unless it was zero
+```
+
+`--delete` is deliberate: the host directory mirrors the repository, so a script removed
+here disappears there. Nothing else lives in that directory.
+
+## Upgrade and rollback
+
+A publish is atomic per file as rsync writes it, and the previous copy is overwritten in
+place. Rollback is a revert commit on `main`: the pipeline publishes the reverted tree on
+the next push, and the host is back to the earlier scripts within the minute the run
+takes. There is no rehearsal of that procedure on a staging host; it is the same
+pipeline with the same single target.
+
+## Monitoring
+
+Nothing polls the host. Two things are worth watching by hand:
+
+- The pipeline's own run history in Gitea, which fails loudly on a non-zero `rsync` or a
+  missing secret.
+- `https://petrbalvin.org/scripts/SHA256SUMS`, which a client can compare against what it
+  downloaded. A file that is on the host but missing from `SHA256SUMS` means a publish was
+  interrupted.
+
+## What the scripts deploy
+
+Two of the six change a host's role, and a third prepares a desktop. Their output is the
+deployment an operator cares about, so the pipeline that publishes them never runs them.
+
+| Script | What it leaves behind | Where it is documented |
+|---|---|---|
+| `server-setup.pl` | Packages, firewalld with the SSH rule already allowed, SELinux enforcing, Podman, unattended updates | [docs/CLI.md](CLI.md) |
+| `sglang-deploy.pl` | A systemd unit running the engine in a Podman container, nginx with TLS in front, an API key file, the firewall rule and the SELinux boolean | [docs/ARCHITECTURE.md](ARCHITECTURE.md) |
+| `workstation-setup.pl` | A Fedora desktop with the toolchains and applications installed | [docs/CLI.md](CLI.md) |
+
+The SGLang deployment is the only service in the collection, and the host needs no ROCm
+installation for it: the engine runs from the project's ROCm image and reaches the GPU
+through `/dev/kfd` and `/dev/dri`, which the amdgpu kernel driver provides. The image tag
+follows the card and the host's ROCm, which is why the script resolves it rather than
+carrying a constant.
+
+## Production configuration
+
+Nothing in this repository holds a secret. The values that differ per host come from
+where the script reads them:
+
+- The published copies are unversioned: whatever is on `main` is what is served.
+- `sglang-deploy.pl` keeps the engine's API key in `/etc/sysconfig/sglang`, mode 0600,
+  written by the script and never committed. A Hugging Face token for a gated model goes
+  into that same file as `HF_TOKEN`, which the unit forwards to the container.
+- The deploy secrets live in the Gitea repository settings, under Actions, Secrets.
diff --git a/docs/DEVELOPMENT.md b/docs/DEVELOPMENT.md
new file mode 100644
index 0000000..c149479
--- /dev/null
+++ b/docs/DEVELOPMENT.md
@@ -0,0 +1,146 @@
+# Development
+
+How to work on the scripts collection.
+
+## Prerequisites
+
+- Perl 5.38 or newer, which is what the oldest supported system ships. Measured on the
+  three test platforms: Fedora 44 carries 5.42.3, CentOS Stream 10 carries 5.40.2, and
+  openEuler 24.03 LTS carries 5.38.0.
+- Podman, for the container rigs that verify a script against a real system.
+- Nothing else. There is no build step, no dependency to install and no module to fetch:
+  the scripts use the interpreter's builtins, and the checks use nothing beyond them
+  either.
+
+## Setup
+
+```sh
+git clone https://sourcedock.dev/petrbalvin/scripts.git
+cd scripts
+perl -c network-diag.pl
+```
+
+## Commands
+
+There is no recipe file: the gates are the commands below, and the test pipeline runs
+the same set.
+
+| Command | What it does |
+|---|---|
+| `perl -c <script>` | Compiles one script. All six in a loop is what the pipeline's first gate does |
+| `perl tests/<script>.pl` | One script's checks, each printing `ok` or `FAIL` and exiting non-zero on a failure |
+| `perl tests/container/rig.pl` | The container rig, which must be run through Podman as root: see below |
+
+The whole local gate, one line per script:
+
+```sh
+for f in *.pl; do perl -c "$f" || exit 1; done
+for t in tests/*.pl; do perl "$t" || exit 1; done
+```
+
+Two more gates have no command of their own because the pipeline carries them: every
+script opens with the shebang `#!/usr/bin/env perl` and the two-line licence header,
+and no file in the repository uses a dash as punctuation. Both are checked in
+`.gitea/workflows/test.yml`.
+
+## The checks under tests/
+
+One file per script, named after it, run as `perl tests/<script>.pl`. They cover the
+pure functions, which is where the arithmetic and the parsing live: RPM's version
+comparison (checked against `rpm`'s own implementation, which is the definition of the
+ordering), the two JSON decoders and the encoder, IPv4 and IPv6 parsing with the
+`sockaddr` packing and the address classification, the ping transcript parser, the
+grading, the dnf-automatic renderer, the checksum reader, the writers, and the argument
+parsing of every script.
+
+They need no root, no network and no Podman, except where a case is skipped for that
+reason and says so: `atomic_write` settles the owner of the file it writes, so it can
+only be exercised as root.
+
+## The container rig
+
+`tests/container/rig.pl` runs the real `sglang-deploy.pl` as root inside a container
+against a stub `PATH`: every command the script drives (`dnf`, `rpm`, `podman`,
+`systemctl`, `curl`, `openssl`, `nginx`, `firewall-cmd`, `getsebool`, `lspci`) is a
+stub that answers from a fixture, so a run is deterministic and needs no network and no
+GPU. It covers the deploy end to end: the resolved image tag, the unit file, the nginx
+configuration, the TLS certificate and its modes, the API key file, the SELinux
+boolean, the firewall rule, the idempotent second run, the dry run, the uninstall, the
+Radeon and MI300 paths, the offline and unpublished-tag failures, the argument
+validation and the non-root refusal.
+
+Prepare the platform image once, since the base images carry no Perl:
+
+```sh
+podman run --name sglang-prep registry.fedoraproject.org/fedora:44 dnf install -y perl
+podman commit sglang-prep localhost/sglang-rig:fedora
+podman rm sglang-prep
+```
+
+Then run the scenarios. The repository is mounted read-only at its own path and the
+work directory is a scratch directory outside it:
+
+```sh
+podman run --rm --privileged \
+  -v "$PWD:$PWD:ro,z" \
+  -v /tmp/sglang-rig:/tmp/sglang-rig:Z \
+  localhost/sglang-rig:fedora perl "$PWD/tests/container/rig.pl"
+```
+
+The device nodes the script requires are faked by the rig itself, which is why the
+container needs `--privileged`. The one scenario that checks the *missing* driver needs
+a run without it:
+
+```sh
+podman run --rm \
+  -v "$PWD:$PWD:ro,z" \
+  -v /tmp/sglang-rig:/tmp/sglang-rig:Z \
+  localhost/sglang-rig:fedora perl "$PWD/tests/container/rig.pl" no_driver
+```
+
+The same rig was run on all three platforms, which is how the script's behaviour
+against their package managers and their `os-release` was confirmed; only the image tag
+in the commands changes:
+
+| Platform | Image | Perl |
+|---|---|---|
+| Fedora 44 | `registry.fedoraproject.org/fedora:44` | 5.42.3 |
+| CentOS Stream 10 | `quay.io/centos/centos:stream10` | 5.40.2 |
+| openEuler 24.03 LTS | `docker.io/openeuler/openeuler:24.03-lts` | 5.38.0 |
+
+A run leaves its log in `/tmp/sglang-rig/log/`, including `run.out`, the script's own
+output, and `stubs.log`, every command it issued with its arguments. That log is the
+quickest way to see what a run actually did.
+
+## Running one script for real
+
+The diagnostic scripts need no root and can simply be run:
+
+```sh
+perl network-diag.pl
+perl system-diag.pl --json
+```
+
+The four that change a system need root and, except for
+`workstation-setup.pl`, run in a disposable container the same way the rig does. Start
+from the platform image, and read the summary before anything else: every one of them
+supports `--dry-run`, which changes nothing and prints what it would do.
+
+## Continuous integration
+
+Workflows live in `.gitea/workflows/` and run on the project's own runners:
+
+| Workflow | Trigger | Steps |
+|---|---|---|
+| Test | push or pull request to `development` | install Perl, then the syntax gate, the licence-header gate, the punctuation gate, and the six check files |
+| Deploy | push to `main`, or dispatched by hand | write `SHA256SUMS`, pin the host key from `DEPLOY_KNOWN_HOSTS`, publish over rsync |
+
+The container rig is deliberately not in the pipeline: it needs `--privileged`, and the
+runner is a small box shared with the forge. A change that touches a system is expected
+to be verified with the rig locally, and the pull request says which platform was used.
+
+## Releases
+
+There are none. Each script carries its own version string, and the deploy pipeline
+publishes the scripts on every push to `main`, so a merge is a release and the commit
+history is the record of what changed.
diff --git a/network-diag.pl b/network-diag.pl
new file mode 100644
index 0000000..6624f78
--- /dev/null
+++ b/network-diag.pl
@@ -0,0 +1,1584 @@
+#!/usr/bin/env perl
+# Copyright (c) 2026 Petr Balvín <opensource@petrbalvin.org> (https://petrbalvin.org)
+# SPDX-License-Identifier: MIT
+
+# Network diagnostics: latency, DNS, MTU, packet loss, dual-stack and port checks.
+#
+# Perl builtins only.  No module is required to run this.  The two capabilities
+# that Perl no longer exposes as builtins are handled the way the rules prescribe:
+#
+#   * Address arithmetic (inet_aton and its relatives moved into Socket) is
+#     hand-rolled below, in ip4_bytes and ip6_bytes.
+#   * Name resolution, sockets aside, is delegated to a system binary that speaks
+#     getaddrinfo, which keeps /etc/hosts, nsswitch and any caching resolver in the
+#     picture.  getent is preferred and host, present in the FreeBSD base system and
+#     shipped with bind-utils on Linux, is the fallback.  Which one is in use is
+#     probed at run time rather than assumed.
+#
+# One capability has no builtin substitute at all: a monotonic clock with
+# millisecond resolution, which the TCP and DNS latency figures are measured with.
+# Time::HiRes is therefore loaded opportunistically inside eval and never assumed.
+# The measurement behind that caution: on Fedora, perl-Time-HiRes is its own RPM
+# and is not among the requirements of perl-interpreter, so a bare perl need not
+# have it.  Where it is absent the report says the figure was not measured and the
+# grade drops that component rather than inventing a number.
+#
+# External binaries used: ping, ip, ifconfig, netstat, ss, sockstat, sudo, getent
+# or host, and uname.
+#
+# Linux and FreeBSD are supported in their current releases, with no branch for a
+# superseded one: the unified ping that understands -4 and -6 is the only one
+# driven here.
+#
+# Usage:
+#     network-diag.pl                              # full diagnostic
+#     network-diag.pl --target cloudflare.com      # target a specific host
+#     network-diag.pl --protocol v4                # IPv4 only
+#     network-diag.pl --protocol v6                # IPv6 only
+
+use strict;
+use warnings;
+
+my $VERSION = '2.0.0';
+
+my $BOLD   = "\033[1m";
+my $RED    = "\033[31m";
+my $GREEN  = "\033[32m";
+my $YELLOW = "\033[33m";
+my $DIM    = "\033[2m";
+my $RESET  = "\033[0m";
+
+# Well-known hosts for the connectivity tests, in report order.
+my @CONNECTIVITY_HOSTS = (['cloudflare.com', 443], ['google.com', 443]);
+
+# The optional clock.  Loaded here, once, and guarded everywhere it is used.
+my $HAVE_HIRES = eval { require Time::HiRes; 1 } ? 1 : 0;
+
+# Socket constants.  AF_INET6 is 10 on Linux and 28 on FreeBSD, the only two
+# platforms this script supports; the other values are the same on both.
+sub af_inet6 { return $^O eq 'freebsd' ? 28 : 10 }
+my $AF_INET   = 2;
+my $SOCK_STREAM = 1;
+my $IPPROTO_TCP = 6;
+
+# Address families as the user names them.
+my $FAMILY_LABEL = { v4 => 'IPv4', v6 => 'IPv6' };
+
+my $TMP_DIR;            # private scratch directory, created only when needed
+my $PARENT_PID = $$;    # forked children must never clean up for the parent
+my $RESOLVER;           # cached resolver transport: 'getent', 'host' or ''
+my $RESOLVER_OVERHEAD;  # measured start-up cost of that transport, in ms
+
+# ---------------------------------------------------------------------------
+# Small helpers
+# ---------------------------------------------------------------------------
+
+# Monotonic milliseconds source.  Returns undef when no clock is available, and
+# every caller then reports the figure as not measured instead of guessing.
+sub now {
+    return $HAVE_HIRES ? Time::HiRes::time() : undef;
+}
+
+# One decimal place, as the report prints it.
+sub round1 {
+    my ($value) = @_;
+    return sprintf('%.1f', $value);
+}
+
+sub detect_os {
+    return $^O eq 'freebsd' ? 'freebsd' : 'linux';
+}
+
+sub status {
+    my ($msg) = @_;
+    print STDERR "  $msg...";
+}
+
+sub status_done {
+    my ($msg) = @_;
+    $msg = 'done' unless defined $msg;
+    print STDERR " $msg\n";
+}
+
+# A hand-rolled which(1): the system command is the transport, so the lookup
+# itself must not need one.
+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;
+}
+
+# Run a command, capturing stdout and stderr merged, with a timeout.
+#
+# The child is forked rather than opened as a pipe because the two streams have to
+# be merged and a wedged process has to be killable, which the builtin pipe forms
+# do not offer.  The locale is forced to C because iputils translates its own
+# output (under a Czech locale "time=" becomes "cas=" and the statistics line stops
+# saying "transmitted"), and the whole report parses English.  Returns the output
+# and a status: 'ok', 'timeout' when the wait expired, or 'notfound' when the
+# binary is missing, so callers can tell "tool unavailable" from "no output".
+sub run {
+    my ($cmd, $timeout) = @_;
+    $timeout = 15 unless defined $timeout;
+
+    my $exe = find_exe($cmd->[0]);
+    return ('', 'notfound') unless defined $exe;
+
+    my ($rd, $wr);
+    pipe($rd, $wr) or die "cannot create a pipe: $!\n";
+    my $pid = fork();
+    die "cannot fork: $!\n" unless defined $pid;
+
+    if ($pid == 0) {
+        close($rd);
+        open(STDOUT, '>&', $wr) or exit 127;
+        open(STDERR, '>&', $wr) or exit 127;
+        close($wr);
+        $ENV{LANG} = 'C';
+        $ENV{LC_ALL} = 'C';
+        exec { $exe } @$cmd;
+        exit 127;   # reached only when exec itself fails
+    }
+
+    close($wr);
+    my $out = '';
+    my $timed_out = 0;
+    eval {
+        local $SIG{ALRM} = sub { die "alarm\n" };
+        alarm($timeout);
+        local $/ = undef;
+        $out = <$rd>;
+        alarm(0);
+        1;
+    } or do { $timed_out = 1; alarm(0) };
+    $out = '' unless defined $out;
+    close($rd);
+
+    # Terminate the child, then reap it.  A Term-ed process that ignores the
+    # signal is followed by a KILL, so the wait below cannot hang.
+    kill('TERM', $pid);
+    select(undef, undef, undef, 0.1);
+    kill('KILL', $pid);
+    waitpid($pid, 0);
+    my $exit_code = $? >> 8;
+
+    return ('', 'timeout') if $timed_out;
+    return ($out, 'notfound') if $exit_code == 127;
+    return ($out, 'ok');
+}
+
+# ---------------------------------------------------------------------------
+# ICMP latency
+# ---------------------------------------------------------------------------
+
+# Per-reply latencies and the received counter, which differ between iputils and
+# FreeBSD: "5 packets transmitted, 5 received" against "5 packets transmitted,
+# 5 packets received".  The counter is undef when no statistics line was seen, and
+# callers then fall back to the number of parsed replies.
+sub parse_ping_output {
+    my ($output) = @_;
+    my @latencies = $output =~ /time=(\d+(?:\.\d+)?)/g;
+    my $received;
+    for my $line (split /\n/, $output, -1) {
+        next unless index($line, 'transmitted') >= 0;
+        $received = $1 if $line =~ /(\d+)\s+(?:packets?\s+)?received/;
+        last;
+    }
+    return (\@latencies, $received);
+}
+
+sub min_max_sum {
+    my ($values) = @_;
+    my ($min, $max, $sum) = ($values->[0], $values->[0], 0);
+    for my $v (@$values) {
+        $min = $v if $v < $min;
+        $max = $v if $v > $max;
+        $sum += $v;
+    }
+    return ($min, $max, $sum);
+}
+
+# A standardised ping result.  loss_pct comes from the received counter rather
+# than from the number of parsed replies, which is the authoritative figure.
+sub ping_result {
+    my ($host, $latencies, $received, $count, $protocol) = @_;
+    my $loss = $count > 0 ? round1(($count - $received) / $count * 100) : '100.0';
+    my %result = (
+        host       => $host,
+        protocol   => $protocol,
+        sent       => $count,
+        received   => $received,
+        loss_pct   => $loss,
+        min_ms     => '0.0',
+        avg_ms     => '0.0',
+        max_ms     => '0.0',
+        stddev_ms  => '0.0',
+    );
+    if (@$latencies) {
+        my ($min, $max, $sum) = min_max_sum($latencies);
+        my $n = scalar @$latencies;
+        $result{min_ms} = round1($min);
+        $result{avg_ms} = round1($sum / $n);
+        $result{max_ms} = round1($max);
+        if ($n > 1) {
+            my $mean = $sum / $n;
+            my $sq = 0;
+            $sq += ($_ - $mean) ** 2 for @$latencies;
+            $result{stddev_ms} = round1(sqrt($sq / ($n - 1)));
+        }
+    }
+    return \%result;
+}
+
+# The ping command for an address family.  Every supported release ships the
+# unified ping that understands -4 and -6, so there is nothing to choose between.
+sub ping_base_cmd {
+    my ($family) = @_;
+    return ['ping', ($family eq 'v6' ? '-6' : '-4')];
+}
+
+# Per-reply wait flag: iputils -W takes seconds, and FreeBSD ping -W takes
+# milliseconds, which is the one difference between the two.
+sub ping_wait_args {
+    my ($os_type, $timeout) = @_;
+    return $os_type eq 'freebsd' ? ['-W', $timeout * 1000] : ['-W', $timeout];
+}
+
+sub ping_host {
+    my ($host, $os_type, %opt) = @_;
+    my $count    = $opt{count}    // 5;
+    my $timeout  = $opt{timeout}  // 5;
+    my $protocol = $opt{protocol} // 'v4';
+
+    my $base = ping_base_cmd($protocol);
+    my @cmd = (@$base, '-c', $count, @{ping_wait_args($os_type, $timeout)}, '--', $host);
+    # The timeout must also cover the resolution ping does itself.
+    my ($out, $run_status) = run(\@cmd, $count + $timeout + 10);
+    if ($run_status eq 'notfound') {
+        my $result = ping_result($host, [], 0, $count, $protocol);
+        $result->{note} = "'$base->[0]' not found";
+        return $result;
+    }
+
+    my ($latencies, $parsed_received) = parse_ping_output($out);
+    my $received = defined $parsed_received ? $parsed_received : scalar @$latencies;
+    return ping_result($host, $latencies, $received, $count, $protocol);
+}
+
+# ---------------------------------------------------------------------------
+# Address arithmetic, hand-rolled because Socket no longer shares it
+# ---------------------------------------------------------------------------
+
+# Dotted quad to four bytes, or undef when it is not a dotted quad.
+sub ip4_bytes {
+    my ($ip) = @_;
+    my @octets = split /\./, $ip, -1;
+    return undef unless @octets == 4;
+    for my $octet (@octets) {
+        return undef unless $octet =~ /^\d{1,3}$/ && $octet <= 255;
+    }
+    return pack('C4', @octets);
+}
+
+# Textual IPv6 to sixteen bytes, or undef.  Handles the :: shorthand and a
+# trailing embedded IPv4 form, and ignores a zone suffix.
+sub ip6_bytes {
+    my ($ip) = @_;
+    $ip =~ s/%.*//;
+    return undef 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 = ip4_bytes(pop @tail);
+        return undef unless defined $quad;
+        my @words = unpack('n2', $quad);
+        push @tail, sprintf('%x', $words[0]), sprintf('%x', $words[1]);
+    }
+    return undef if @head + @tail > ($shorthand ? 7 : 8);
+
+    my @groups = $shorthand ? (@head, (0) x (8 - @head - @tail), @tail) : (@head, @tail);
+    return undef unless @groups == 8;
+    for my $group (@groups) {
+        return undef unless $group =~ /^[0-9a-fA-F]{1,4}$/;
+    }
+    return pack('n8', map { hex } @groups);
+}
+
+# Is this textual address an IPv4-mapped IPv6 one (::ffff:a.b.c.d)?  glibc's
+# ahostsv6 answers with a mapped address for a name that has no AAAA record, and
+# connecting to it silently uses IPv4, so it must never be taken for IPv6.
+sub is_mapped6 {
+    my ($addr) = @_;
+    my $bytes = ip6_bytes($addr);
+    return 0 unless defined $bytes;
+    # Twelve bytes: ten of zero, then the 0xffff marker.
+    return substr($bytes, 0, 12) eq ("\0" x 10) . "\xff\xff" ? 1 : 0;
+}
+
+# sockaddr_in and sockaddr_in6, packed by hand.  Linux has a two-byte sin_family
+# and no length field; FreeBSD has sin_len first and a one-byte family.
+sub sa_in {
+    my ($ip, $port) = @_;
+    my $bytes = ip4_bytes($ip);
+    return undef unless defined $bytes;
+    return pack('S n a4 x8', $AF_INET, $port, $bytes);
+}
+
+sub sa_in6 {
+    my ($ip, $port) = @_;
+    my $bytes = ip6_bytes($ip);
+    return undef unless defined $bytes;
+    return $^O eq 'freebsd'
+        ? pack('C C n N a16 N', 28, 28, $port, 0, $bytes, 0)
+        : pack('S n N a16 N', 10, $port, 0, $bytes, 0);
+}
+
+# Address classification, approximating the IANA tables: 'global' is what the
+# report calls a globally scoped
+# address, 'private' everything else that is still usable, and the remaining
+# kinds are excluded from consideration entirely.
+sub class4 {
+    my ($bytes) = @_;
+    my @o = unpack('C4', $bytes);
+    return 'loopback'    if $o[0] == 127;
+    return 'linklocal'   if $o[0] == 169 && $o[1] == 254;
+    return 'unspecified' if $o[0] == 0;
+    return 'multicast'   if $o[0] >= 224 && $o[0] <= 239;
+    return 'private'     if $o[0] >= 240;
+    return 'private'     if $o[0] == 10;
+    return 'private'     if $o[0] == 172 && $o[1] >= 16 && $o[1] <= 31;
+    return 'private'     if $o[0] == 192 && $o[1] == 168;
+    return 'private'     if $o[0] == 100 && $o[1] >= 64 && $o[1] <= 127;
+    return 'private'     if $o[0] == 192 && $o[1] == 0 && $o[2] == 0;
+    return 'private'     if $o[0] == 192 && $o[1] == 0 && $o[2] == 2;
+    return 'private'     if $o[0] == 192 && $o[1] == 88 && $o[2] == 99;
+    return 'private'     if $o[0] == 198 && ($o[1] == 18 || $o[1] == 19);
+    return 'private'     if $o[0] == 198 && $o[1] == 51 && $o[2] == 100;
+    return 'private'     if $o[0] == 203 && $o[1] == 0 && $o[2] == 113;
+    return 'global';
+}
+
+sub class6 {
+    my ($bytes) = @_;
+    my @w = unpack('n8', $bytes);
+    return 'unspecified' if !grep { $_ } @w;
+    # The parentheses matter: without them the && joins grep's list and the
+    # condition collapses, which reported other addresses as loopback.
+    return 'loopback'    if !(grep { $_ } @w[0 .. 6]) && $w[7] == 1;
+    return 'mapped'      if !(grep { $_ } @w[0 .. 4]) && $w[5] == 0xffff;
+    return 'linklocal'   if ($w[0] & 0xffc0) == 0xfe80;
+    return 'multicast'   if ($w[0] & 0xff00) == 0xff00;
+    return 'private'     if ($w[0] & 0xfe00) == 0xfc00;   # unique local
+    return 'private'     if $w[0] == 0x2002;               # 6to4
+    return 'private'     if $w[0] == 0x2001 && $w[1] == 0x0000;   # Teredo
+    return 'global';
+}
+
+# Usable addresses of one family from the collected interface data, globally
+# scoped ones first.  Loopback, link-local, unspecified and multicast addresses
+# are dropped.
+sub family_addresses {
+    my ($iface_info, $family) = @_;
+    my (@global, @other);
+    for my $iface (@{ $iface_info->{interfaces} // [] }) {
+        for my $raw (@{ $iface->{ips} // [] }) {
+            my $addr = $raw;
+            $addr =~ s{/.*$}{};
+            my $kind;
+            if ($family eq 'v6') {
+                next unless index($addr, ':') >= 0;
+                my $bytes = ip6_bytes($addr);
+                next unless defined $bytes;
+                $kind = class6($bytes);
+                next if $kind eq 'loopback' || $kind eq 'linklocal'
+                     || $kind eq 'unspecified' || $kind eq 'multicast';
+            }
+            else {
+                next if index($addr, ':') >= 0;
+                my $bytes = ip4_bytes($addr);
+                next unless defined $bytes;
+                $kind = class4($bytes);
+                next if $kind eq 'loopback' || $kind eq 'linklocal'
+                     || $kind eq 'unspecified' || $kind eq 'multicast';
+            }
+            push @{ $kind eq 'global' ? \@global : \@other }, $addr;
+        }
+    }
+    return (@global, @other);
+}
+
+sub address_kind {
+    my ($family, $addr) = @_;
+    my $bytes = $family eq 'v6' ? ip6_bytes($addr) : ip4_bytes($addr);
+    return '' unless defined $bytes;
+    return $family eq 'v6' ? class6($bytes) : class4($bytes);
+}
+
+# ---------------------------------------------------------------------------
+# Interfaces
+# ---------------------------------------------------------------------------
+
+sub interface_info {
+    my ($os_type) = @_;
+    my %info = (
+        interfaces       => [],
+        default_route_v4 => '',
+        default_route_v6 => '',
+        error            => '',
+    );
+    return interface_info_freebsd(\%info) if $os_type eq 'freebsd';
+    return interface_info_linux(\%info);
+}
+
+sub interface_info_linux {
+    my ($info) = @_;
+    my ($out, $run_status) = run(['ip', '-br', 'addr', 'show']);
+    if ($run_status eq 'notfound') {
+        $info->{error} = "'ip' not found";
+        return $info;
+    }
+    for my $line (split /\n/, $out, -1) {
+        my @parts = split ' ', $line;
+        next if @parts < 2 || $parts[0] eq 'lo';
+        push @{ $info->{interfaces} }, {
+            name  => $parts[0],
+            state => $parts[1],
+            ips   => [ @parts[2 .. $#parts] ],
+        };
+    }
+
+    for my $item (['-4', 'default_route_v4'], ['-6', 'default_route_v6']) {
+        my ($family_flag, $key) = @$item;
+        my ($route, $route_status) = run(['ip', $family_flag, 'route', 'show', 'default']);
+        next unless $route_status eq 'ok';
+        my @parts = split ' ', $route;
+        for my $i (0 .. $#parts) {
+            next unless $parts[$i] eq 'via' && $i + 1 <= $#parts;
+            $info->{$key} = $parts[$i + 1];
+            last;
+        }
+    }
+    return $info;
+}
+
+sub interface_info_freebsd {
+    my ($info) = @_;
+    my ($iflist, $list_status) = run(['ifconfig', '-l']);
+    if ($list_status eq 'notfound') {
+        $info->{error} = "'ifconfig' not found";
+        return $info;
+    }
+    my @names = split ' ', $iflist;
+    return $info unless @names;
+
+    for my $name (@names) {
+        next if $name eq 'lo0';
+        my ($out, $run_status) = run(['ifconfig', $name]);
+        next unless $run_status eq 'ok';
+        my @lines = split /\n/, $out, -1;
+        next unless @lines && length $lines[0];
+
+        my $state = (index($lines[0], '<UP,') >= 0 || index($lines[0], '<UP>') >= 0)
+            ? 'UP' : 'DOWN';
+
+        my @ips;
+        for my $line (@lines[1 .. $#lines]) {
+            my $stripped = $line;
+            $stripped =~ s/^\s+//;
+            $stripped =~ s/\s+$//;
+            if ($stripped =~ /^inet /) {
+                my @parts = split ' ', $stripped;
+                push @ips, $parts[1] if @parts >= 2 && $parts[1] ne '127.0.0.1';
+            }
+            elsif ($stripped =~ /^inet6 /) {
+                my @parts = split ' ', $stripped;
+                next if @parts < 2;
+                my $addr = $parts[1];
+                $addr =~ s/%.*//;
+                next if $addr =~ /^fe80:/ || $addr eq '::1';
+                push @ips, $addr;
+            }
+        }
+        push @{ $info->{interfaces} }, { name => $name, state => $state, ips => \@ips };
+    }
+
+    my ($route, $route_status) = run(['netstat', '-rn']);
+    return $info unless $route_status eq 'ok';
+    for my $line (split /\n/, $route, -1) {
+        next unless $line =~ /^default/;
+        my @parts = split ' ', $line;
+        next if @parts < 2;
+        my $gateway = $parts[1];
+        $gateway =~ s/%.*//;
+        if (index($gateway, ':') >= 0) {
+            $info->{default_route_v6} = $gateway unless $info->{default_route_v6};
+        }
+        elsif (!$info->{default_route_v4}) {
+            $info->{default_route_v4} = $gateway;
+        }
+    }
+    return $info;
+}
+
+# ---------------------------------------------------------------------------
+# Name resolution
+# ---------------------------------------------------------------------------
+
+# The transport is probed once: getent implements getaddrinfo directly, so it is
+# preferred, and host is the fallback for systems without the ahosts databases.
+sub resolver_transport {
+    return $RESOLVER if defined $RESOLVER;
+    $RESOLVER = '';
+    if (defined find_exe('getent')) {
+        my ($out, $run_status) = run(['getent', 'ahostsv4', 'localhost']);
+        $RESOLVER = 'getent' if $run_status eq 'ok' && index($out, 'localhost') >= 0;
+    }
+    $RESOLVER = 'host' if !$RESOLVER && defined find_exe('host');
+    return $RESOLVER;
+}
+
+# Resolve a name for one address family, in resolver order, with IPv4-mapped
+# answers excluded.  An empty list means the name has no address of that family.
+sub resolve_family {
+    my ($host, $family) = @_;
+    my $transport = resolver_transport();
+    return () if $transport eq '';
+
+    if ($transport eq 'getent') {
+        my ($out, $run_status) = run(['getent', $family eq 'v6' ? 'ahostsv6' : 'ahostsv4', $host]);
+        return () unless $run_status eq 'ok';
+        my @addrs;
+        for my $line (split /\n/, $out, -1) {
+            my @parts = split ' ', $line;
+            next unless @parts >= 2 && $parts[1] eq 'STREAM';
+            next if is_mapped6($parts[0]);
+            push @addrs, $parts[0];
+        }
+        return @addrs;
+    }
+
+    my ($out, $run_status) = run(['host', '-W', 3, '-t', $family eq 'v6' ? 'AAAA' : 'A', $host]);
+    return () unless $run_status eq 'ok';
+    my @addrs;
+    for my $line (split /\n/, $out, -1) {
+        if ($family eq 'v6') {
+            push @addrs, $1 if $line =~ /\bhas IPv6 address (\S+)/;
+        }
+        else {
+            push @addrs, $1 if $line =~ /\bhas address (\S+)/;
+        }
+    }
+    return @addrs;
+}
+
+# The resolver runs as a separate process, so its start-up cost sits inside every
+# sample taken around it.  That cost is measured once against a name that never
+# leaves the machine and subtracted, leaving the resolution itself.  The
+# subtraction is conservative: the calibration name is answered from the hosts
+# file and so never exercises the code path a network query goes through, which
+# leaves a residual measured at about 3 ms per sample on this workstation.  That
+# residual is a fraction of the 20 ms that separates one DNS score from the next,
+# so it does not move the grade, and it is recorded rather than hidden because
+# the figure is not exact.
+sub resolver_overhead {
+    return $RESOLVER_OVERHEAD if defined $RESOLVER_OVERHEAD;
+    $RESOLVER_OVERHEAD = 0;
+    return 0 unless $HAVE_HIRES && resolver_transport() ne '';
+    my @samples;
+    for (1 .. 5) {
+        my $start = now();
+        my @ignored = resolve_family('localhost', 'v4');
+        push @samples, (now() - $start) * 1000;
+    }
+    @samples = sort { $a <=> $b } @samples;
+    $RESOLVER_OVERHEAD = $samples[int(@samples / 2)];
+    return $RESOLVER_OVERHEAD;
+}
+
+sub dns_samples {
+    my ($domain, $family) = @_;
+    # One untimed resolution first.  The resolver's machinery, an NSS module for
+    # instance, is loaded once per process, and letting the first sample pay for
+    # that would report the loader instead of the resolver.  Measured here: the
+    # first AAAA sample taken in a fresh process cost 37 ms against 3 ms for the
+    # rest, because the calibration below resolves a name that never reaches the
+    # module in question.
+    my @warm_up = resolve_family($domain, $family);
+    my @results;
+    for (1 .. 3) {
+        my $start = now();
+        my @addrs = resolve_family($domain, $family);
+        my $ms;
+        if (defined $start) {
+            $ms = (now() - $start) * 1000 - resolver_overhead();
+            $ms = 0 if $ms < 0;
+        }
+        my %sample = (ip => (@addrs ? $addrs[0] : 'N/A'));
+        $sample{ms} = defined $ms ? round1($ms) : -1;
+        push @results, \%sample;
+    }
+    return \@results;
+}
+
+# The machine's own name, and its fully qualified form.  The hostname comes from
+# uname; the qualified name is only chased when the short name carries no dot.
+sub check_hostname {
+    my ($out, $run_status) = run(['uname', '-n']);
+    my $name = $run_status eq 'ok' ? $out : '';
+    $name =~ s/\s+$//;
+    return $name;
+}
+
+sub check_fqdn {
+    my ($name) = @_;
+    return '' unless length $name;
+    return $name if index($name, '.') >= 0;
+    my ($canonical, $aliases, $addrtype, $length, @addresses) = gethostbyname($name);
+    return $name unless @addresses;
+    my ($reverse, $r_aliases) = gethostbyaddr($addresses[0], $AF_INET);
+    return $name unless defined $reverse && index($reverse, '.') >= 0;
+    return $reverse;
+}
+
+sub check_dns {
+    my ($protocol) = @_;
+    my $hostname = check_hostname();
+    my %info = (
+        hostname  => $hostname,
+        fqdn      => check_fqdn($hostname),
+        resolvers => [],
+        v4        => {},
+        v6        => {},
+    );
+    # Without a clock the latency column has nothing to report, and the grade
+    # leaves that component out rather than scoring a figure that was not taken.
+    $info{no_clock} = 1 unless $HAVE_HIRES;
+
+    for my $entry (@CONNECTIVITY_HOSTS) {
+        my $domain = $entry->[0];
+        $info{v6}{$domain} = dns_samples($domain, 'v6') if $protocol ne 'v4';
+        $info{v4}{$domain} = dns_samples($domain, 'v4') if $protocol ne 'v6';
+    }
+
+    if (open(my $fh, '<', '/etc/resolv.conf')) {
+        while (my $line = <$fh>) {
+            next unless $line =~ /^nameserver/;
+            my @parts = split ' ', $line;
+            push @{ $info{resolvers} }, $parts[1] if @parts >= 2;
+        }
+        close($fh);
+    }
+    return \%info;
+}
+
+# ---------------------------------------------------------------------------
+# TCP reachability
+# ---------------------------------------------------------------------------
+
+# A TCP handshake to one host over one family.  Candidates are tried in resolver
+# order and the first success wins; the timing covers the connect alone.
+sub tcp_probe {
+    my ($host, $port, $family) = @_;
+    my @addrs = resolve_family($host, $family);
+    return { reachable => 0 } unless @addrs;
+
+    for my $addr (@addrs) {
+        my $sockaddr = $family eq 'v6' ? sa_in6($addr, $port) : sa_in($addr, $port);
+        next unless defined $sockaddr;
+        my $family_const = $family eq 'v6' ? af_inet6() : $AF_INET;
+        socket(my $sock, $family_const, $SOCK_STREAM, $IPPROTO_TCP) or next;
+
+        my $start = now();
+        my $connected = 0;
+        eval {
+            local $SIG{ALRM} = sub { die "alarm\n" };
+            alarm(5);
+            $connected = connect($sock, $sockaddr);
+            alarm(0);
+            1;
+        } or do { $connected = 0; alarm(0) };
+        my $ms = defined $start ? round1((now() - $start) * 1000) : undef;
+        close($sock);
+        next unless $connected;
+
+        my %result = (reachable => 1, ip => $addr);
+        $result{ms} = $ms if defined $ms;
+        return \%result;
+    }
+    return { reachable => 0 };
+}
+
+# TCP handshake probes to well-known hosts over both families, IPv6 first.  This
+# is the only place TCP probes are made; the per-family reachability sections
+# reuse these results.  A family excluded with --protocol is left empty, so the
+# reachability section and the grade skip it instead of penalising a probe the
+# user asked not to make.
+sub check_connectivity {
+    my ($protocol) = @_;
+    my %info = (v4 => {}, v6 => {});
+    for my $entry (@CONNECTIVITY_HOSTS) {
+        my ($host, $port) = @$entry;
+        $info{v6}{$host} = tcp_probe($host, $port, 'v6') if $protocol ne 'v4';
+        $info{v4}{$host} = tcp_probe($host, $port, 'v4') if $protocol ne 'v6';
+    }
+    return \%info;
+}
+
+# The best address for the target over one family, preferring IPv6, together with
+# the family it belongs to.  Resolving here rather than letting ping decide keeps
+# the family deterministic, which the MTU header arithmetic depends on.
+sub resolve_probe_target {
+    my ($target, $protocol) = @_;
+    my @order = $protocol eq 'auto' ? ('v6', 'v4') : ($protocol);
+    for my $family (@order) {
+        my @addrs = resolve_family($target, $family);
+        return ($family, $addrs[0]) if @addrs;
+    }
+    return (undef, undef);
+}
+
+# ---------------------------------------------------------------------------
+# Path MTU
+# ---------------------------------------------------------------------------
+
+# A DF probe walk from 1500 downwards over one family.  Success is a parsed
+# reply, and header sizes are per family: 28 bytes for IPv4, 48 for IPv6.  Every
+# failure falls through to the next size, whether it was a definitive "too big"
+# answer or a timeout.  Returns the largest size that drew a reply (0 when none
+# did) and, when the ping binary itself is missing, the method note for it.
+sub mtu_probe_walk {
+    my ($addr, $family, $os_type) = @_;
+    my $header = $family eq 'v6' ? 48 : 28;
+
+    my $base = ping_base_cmd($family);
+    my @df_args   = $os_type eq 'freebsd' ? ('-D') : ('-M', 'do');
+    my @wait_args = @{ ping_wait_args($os_type, 2) };
+
+    for my $size (1500, 1400, 1300, 1280, 1200, 1000) {
+        my $payload = $size - $header;
+        my @cmd = (@$base, @df_args, '-c', 1, @wait_args, '-s', $payload, '--', $addr);
+        my ($out, $run_status) = run(\@cmd, 12);
+        return (0, "'$base->[0]' not found") if $run_status eq 'notfound';
+        my ($latencies, $received) = parse_ping_output($out);
+        return ($size, undef) if defined $received && $received > 0;
+    }
+    return (0, undef);
+}
+
+sub check_mtu {
+    my ($target, $protocol, $os_type) = @_;
+    my %info = (path_mtu => 0, target => $target, method => '');
+    my %family_label = (v4 => 'IPv4', v6 => 'IPv6');
+
+    my ($family, $addr) = resolve_probe_target($target, $protocol);
+    if (!defined $family) {
+        $info{method} = 'target did not resolve';
+        return \%info;
+    }
+
+    my ($size, $missing) = mtu_probe_walk($addr, $family, $os_type);
+    if (defined $missing) {
+        $info{method} = $missing;
+        return \%info;
+    }
+
+    # A name that resolves over the preferred family but has no route there must
+    # not read as a missing path MTU: with --protocol auto the other family gets
+    # the same walk before the section gives up.  An explicit --protocol keeps
+    # the single family the user asked for.
+    if (!$size && $protocol eq 'auto') {
+        my $other = $family eq 'v6' ? 'v4' : 'v6';
+        my @addrs = resolve_family($target, $other);
+        if (@addrs) {
+            my ($alt_size, $alt_missing) = mtu_probe_walk($addrs[0], $other, $os_type);
+            if (defined $alt_missing) {
+                $info{method} = $alt_missing;
+                return \%info;
+            }
+            if ($alt_size) {
+                $info{path_mtu} = $alt_size;
+                $info{method} = "ping DF probe (${alt_size}B OK, $family_label{$other} fallback)";
+                return \%info;
+            }
+        }
+    }
+
+    if ($size) {
+        $info{path_mtu} = $size;
+        $info{method} = "ping DF probe (${size}B OK)";
+    }
+    else {
+        $info{method} = 'ping DF probe (no probe size succeeded)';
+    }
+    return \%info;
+}
+
+# ---------------------------------------------------------------------------
+# Listening ports
+# ---------------------------------------------------------------------------
+
+sub parse_ss_output {
+    my ($out) = @_;
+    my @lines = split /\n/, $out, -1;
+    shift @lines;   # header
+    my @entries;
+    for my $line (@lines) {
+        next unless index($line, 'LISTEN') >= 0;
+        my @parts = split ' ', $line;
+        next if @parts < 5;
+        # State Recv-Q Send-Q LocalAddress:Port PeerAddress:Port Process
+        my $local = $parts[3];
+        push @entries, {
+            addr => $local,
+            # A process name may contain a space, so the tail is joined whole.
+            process => (@parts > 5 ? join(' ', @parts[5 .. $#parts]) : ''),
+            # IPv6 sockets are written in bracket notation, [::]:port
+            bucket  => index($local, '[') == 0 ? 'tcp6' : 'tcp4',
+        };
+    }
+    return @entries;
+}
+
+sub listening_ports {
+    my ($os_type) = @_;
+    return listening_ports_freebsd() if $os_type eq 'freebsd';
+    return listening_ports_linux();
+}
+
+sub listening_ports_linux {
+    my %info = (tcp4 => [], tcp6 => [], tcp46 => [], error => '');
+    my ($out, $run_status) = run(['ss', '-tlnp'], 5);
+    if ($run_status eq 'notfound') {
+        $info{error} = "'ss' not found";
+        return \%info;
+    }
+    my @entries = parse_ss_output($out);
+
+    # Ports owned by other users come back without a process name; sudo without a
+    # password prompt fills those in where it can.
+    if (grep { $_->{process} eq '' } @entries) {
+        my ($sudo_out, $sudo_status) = run(['sudo', '-n', 'ss', '-tlnp'], 5);
+        if ($sudo_status eq 'ok' && length $sudo_out) {
+            my %by_addr;
+            $by_addr{ $_->{addr} } = $_ for parse_ss_output($sudo_out);
+            for my $entry (@entries) {
+                next unless $entry->{process} eq '' && exists $by_addr{ $entry->{addr} };
+                $entry->{process} = $by_addr{ $entry->{addr} }{process};
+            }
+        }
+    }
+
+    for my $entry (@entries) {
+        my $process = length $entry->{process} ? $entry->{process} : '(no permission)';
+        push @{ $info{ $entry->{bucket} } }, { addr => $entry->{addr}, process => $process };
+    }
+    return \%info;
+}
+
+sub listening_ports_freebsd {
+    my %info = (tcp4 => [], tcp6 => [], tcp46 => [], error => '');
+    my ($out, $run_status) = run(['sockstat', '-l4', '-l6'], 5);
+    if ($run_status eq 'notfound') {
+        $info{error} = "'sockstat' not found";
+        return \%info;
+    }
+    my @lines = split /\n/, $out, -1;
+    shift @lines;   # header
+    for my $line (@lines) {
+        my @parts = split ' ', $line;
+        next if @parts < 6;
+        my $proto = $parts[4];   # tcp4, tcp6, or tcp46 for a dual-stack socket
+        next unless $proto eq 'tcp4' || $proto eq 'tcp6' || $proto eq 'tcp46';
+        push @{ $info{$proto} }, { addr => $parts[5], process => $parts[1] };
+    }
+    return \%info;
+}
+
+# ---------------------------------------------------------------------------
+# Reachability sections
+# ---------------------------------------------------------------------------
+
+sub reachability_report {
+    my ($family, $iface_info, $probes) = @_;
+    my @addresses = family_addresses($iface_info, $family);
+    my $best = $addresses[0];
+    return {
+        available  => defined $best ? 1 : 0,
+        addr       => defined $best ? $best : '',
+        is_global  => defined $best && address_kind($family, $best) eq 'global' ? 1 : 0,
+        test_sites => $probes,
+    };
+}
+
+# ---------------------------------------------------------------------------
+# Grade
+# ---------------------------------------------------------------------------
+
+sub grade_letter {
+    my ($pct) = @_;
+    return 'A' if $pct >= 90;
+    return 'B' if $pct >= 80;
+    return 'C' if $pct >= 70;
+    return 'D' if $pct >= 60;
+    return 'F';
+}
+
+# Five components of twenty points each: packet loss, latency, DNS speed, IPv4
+# reachability and IPv6 support.  A component that was not measured, because the
+# family was excluded with --protocol or because no clock was available, is
+# removed from the maximum, so the letter grades the achievable points.
+sub compute_grade {
+    my ($data) = @_;
+    my $score = 0;
+    my %breakdown;
+
+    my $ping = $data->{ping} // {};
+    my $loss = $ping->{loss_pct} // 100;
+    my $loss_score =
+          $loss <= 0  ? 20
+        : $loss <= 5  ? 15
+        : $loss <= 10 ? 10
+        : $loss <= 30 ? 5
+        : 0;
+    $breakdown{packet_loss} = $loss_score;
+    $score += $loss_score;
+
+    my $avg_ms = $ping->{avg_ms} // 0;
+    my $latency_score =
+          $avg_ms <= 0  ? 0
+        : $avg_ms < 30  ? 20
+        : $avg_ms < 80  ? 15
+        : $avg_ms < 150 ? 10
+        : $avg_ms < 300 ? 5
+        : 0;
+    $breakdown{latency} = $latency_score;
+    $score += $latency_score;
+
+    my $max_score = 100;
+
+    my $dns = $data->{dns} // {};
+    my $dns_score = 0;
+    if ($dns->{no_clock}) {
+        $max_score -= 20;
+    }
+    else {
+        my ($samples, $total) = (0, 0);
+        for my $family ('v6', 'v4') {
+            for my $domain (keys %{ $dns->{$family} // {} }) {
+                for my $sample (@{ $dns->{$family}{$domain} }) {
+                    next unless $sample->{ms} > 0;
+                    $samples++;
+                    $total += $sample->{ms};
+                }
+            }
+        }
+        if ($samples > 0) {
+            my $average = $total / $samples;
+            $dns_score =
+                  $average < 20  ? 20
+                : $average < 50  ? 15
+                : $average < 100 ? 10
+                : $average < 200 ? 5
+                : 0;
+        }
+    }
+    $breakdown{dns_speed} = $dns_score;
+    $score += $dns_score;
+
+    my $ipv4 = $data->{ipv4} // {};
+    my $v4_score = 0;
+    if ($ipv4->{skipped}) {
+        $max_score -= 20;
+    }
+    elsif ($ipv4->{available}) {
+        $v4_score += 10;
+        my $reachable = grep { $_->{reachable} } values %{ $ipv4->{test_sites} // {} };
+        $v4_score += $reachable * 5 > 10 ? 10 : $reachable * 5;
+    }
+    $breakdown{ipv4_reachability} = $v4_score;
+    $score += $v4_score;
+
+    my $ipv6 = $data->{ipv6} // {};
+    my $v6_score = 0;
+    if ($ipv6->{skipped}) {
+        $max_score -= 20;
+    }
+    elsif ($ipv6->{available}) {
+        $v6_score += 10;
+        my $reachable = grep { $_->{reachable} } values %{ $ipv6->{test_sites} // {} };
+        $v6_score += $reachable * 5 > 10 ? 10 : $reachable * 5;
+    }
+    $breakdown{ipv6_dualstack} = $v6_score;
+    $score += $v6_score;
+
+    my $pct = $max_score > 0 ? sprintf('%.0f', $score * 100 / $max_score) : 0;
+    my $letter = grade_letter($pct);
+    my $colour = ($letter eq 'A' || $letter eq 'B') ? $GREEN
+               : ($letter eq 'C' || $letter eq 'D') ? $YELLOW
+               : $RED;
+
+    return {
+        grade     => $letter,
+        score     => $score,
+        max_score => $max_score,
+        colour    => $colour,
+        breakdown => \%breakdown,
+    };
+}
+
+# ---------------------------------------------------------------------------
+# Report
+# ---------------------------------------------------------------------------
+
+sub ms_colour {
+    my ($ms) = @_;
+    return $DIM if !defined $ms || $ms <= 0;
+    return $GREEN if $ms < 50;
+    return $YELLOW if $ms < 200;
+    return $RED;
+}
+
+sub print_ping_block {
+    my ($label, $info) = @_;
+    return unless ref $info eq 'HASH';
+    if (($info->{received} // 0) == 0) {
+        my $note = $info->{note} // $info->{error} // '';
+        my $suffix = length $note ? " ($note)" : '';
+        print "  $label: ${RED}no response$suffix$RESET\n";
+        return;
+    }
+    my $loss = $info->{loss_pct} // 0;
+    my $loss_colour = $loss > 10 ? $RED : $loss > 0 ? $YELLOW : $GREEN;
+    my $avg = $info->{avg_ms} // 0;
+    my $latency_colour = ms_colour($avg);
+    printf "  %s: %s/%s received  Loss: %s%.1f%%%s  Avg: %s%.1fms%s  Min/Max: %.1f/%.1fms  σ: %.1fms\n",
+        $label,
+        $info->{sent} // 0, $info->{received} // 0,
+        $loss_colour, $loss, $RESET,
+        $latency_colour, $avg, $RESET,
+        $info->{min_ms} // 0, $info->{max_ms} // 0,
+        $info->{stddev_ms} // 0;
+}
+
+sub print_reachability {
+    my ($family, $info) = @_;
+    return unless ref $info eq 'HASH';
+    my $label = $FAMILY_LABEL->{$family};
+    if ($info->{skipped}) {
+        my $protocol_note = $family eq 'v6' ? '--protocol v4' : '--protocol v6';
+        print "  ${DIM}○$RESET $label reachability skipped ($protocol_note)\n";
+        return;
+    }
+    if (!$info->{available}) {
+        print "  ${YELLOW}○$RESET No $label address detected on any interface\n";
+        return;
+    }
+    my $scope = $info->{is_global} ? 'Global' : 'Private';
+    print "  ${GREEN}✓$RESET $scope $label address: $info->{addr}\n";
+    my $suffix = $family eq 'v6' ? ' over IPv6' : '';
+    for my $entry (@CONNECTIVITY_HOSTS) {
+        my $site = $entry->[0];
+        my $result = $info->{test_sites}{$site};
+        next unless ref $result eq 'HASH';
+        if ($result->{reachable}) {
+            printf "  %s✓%s %-20s %sms  (%s)\n",
+                $GREEN, $RESET, $site, round1($result->{ms} // 0), $result->{ip} // '';
+        }
+        else {
+            print "  ${RED}✗$RESET ", sprintf('%-20s', $site), " unreachable$suffix\n";
+        }
+    }
+}
+
+sub print_report {
+    my ($data) = @_;
+    my $grade_info = $data->{grade} // {};
+    my $grade_letter = $grade_info->{grade} // '?';
+    my $grade_colour = $grade_info->{colour} // $RESET;
+
+    my $bar = "═" x 60;
+
+    # Header
+    my $os_label = ucfirst($data->{os} // 'linux');
+    print "\n${BOLD}${bar}$RESET\n";
+    print "${BOLD}  Network Diagnostics  v$VERSION  ($os_label)$RESET\n";
+    print "${BOLD}${bar}$RESET\n";
+    print "  Hostname: $data->{hostname}\n";
+    print "  Protocol: ", ($data->{protocol} // 'auto'), "\n";
+    print "  Summary Grade: ${grade_colour}${BOLD}${grade_letter}$RESET  ",
+        "(", ($grade_info->{score} // '?'), "/", ($grade_info->{max_score} // 100), ")\n";
+
+    # Interfaces
+    print "\n${BOLD}── Interfaces ──$RESET\n";
+    my $iface = $data->{interfaces} // {};
+    print "  ${DIM}unavailable: $iface->{error}$RESET\n" if $iface->{error};
+    for my $entry (@{ $iface->{interfaces} // [] }) {
+        my $state_colour = $entry->{state} eq 'UP' ? $GREEN : $RED;
+        printf "  %-8s %s%-5s%s  %s\n",
+            $entry->{name}, $state_colour, $entry->{state}, $RESET,
+            join(', ', @{ $entry->{ips} // [] });
+    }
+    print "  Default IPv6 route → $iface->{default_route_v6}\n" if $iface->{default_route_v6};
+    print "  Default IPv4 route → $iface->{default_route_v4}\n" if $iface->{default_route_v4};
+
+    # Internet connectivity
+    print "\n${BOLD}── Internet Connectivity ──$RESET\n";
+    my $conn = $data->{connectivity} // {};
+    if ($conn->{error}) {
+        print "  ${DIM}unavailable: $conn->{error}$RESET\n";
+    }
+    elsif (%$conn) {
+        for my $item (['IPv6', 'v6'], ['IPv4', 'v4']) {
+            my ($family_label, $family) = @$item;
+            my $family_probes = ref $conn->{$family} eq 'HASH' ? $conn->{$family} : {};
+            my @parts;
+            for my $entry (@CONNECTIVITY_HOSTS) {
+                my $host = $entry->[0];
+                my $result = $family_probes->{$host};
+                next unless ref $result eq 'HASH';
+                if ($result->{reachable}) {
+                    my $ms = $result->{ms};
+                    if (defined $ms) {
+                        push @parts, sprintf("%s✓%s %s %s%.0fms%s", $GREEN, $RESET, $host, ms_colour($ms), $ms, $RESET);
+                    }
+                    else {
+                        push @parts, sprintf("%s✓%s %s", $GREEN, $RESET, $host);
+                    }
+                }
+                else {
+                    push @parts, sprintf("%s✗%s %s", $RED, $RESET, $host);
+                }
+            }
+            my $hosts_line = @parts ? join(', ', @parts) : "${DIM}(none)$RESET";
+            print "  $family_label: $hosts_line\n";
+        }
+    }
+
+    # Latency
+    print "\n${BOLD}── Latency (ICMP ping) ──$RESET\n";
+    print_ping_block('IPv6', $data->{ping_v6});
+    print_ping_block('IPv4', $data->{ping_v4});
+
+    # DNS
+    print "\n${BOLD}── DNS Resolution ──$RESET\n";
+    my $dns = $data->{dns} // {};
+    if ($dns->{error}) {
+        print "  ${DIM}unavailable: $dns->{error}$RESET\n";
+    }
+    elsif (%$dns) {
+        print "  FQDN: ", ($dns->{fqdn} // '?'), "\n";
+        print "  Resolvers: ", join(', ', @{ $dns->{resolvers} // [] }), "\n" if @{ $dns->{resolvers} // [] };
+        print "  ${DIM}latency not measured: no millisecond clock available$RESET\n" if $dns->{no_clock};
+        for my $item (['AAAA (IPv6)', 'v6'], ['A (IPv4)', 'v4']) {
+            my ($family_label, $family) = @$item;
+            my $domains = $dns->{$family} // {};
+            next unless %$domains;
+            print "  ${BOLD}${family_label}:$RESET\n";
+            for my $entry (@CONNECTIVITY_HOSTS) {
+                my $domain = $entry->[0];
+                my $results = $domains->{$domain};
+                next unless ref $results eq 'ARRAY';
+                my @valid = grep { $_->{ms} > 0 } @$results;
+                my $average = @valid ? (eval { my $t = 0; $t += $_->{ms} for @valid; $t / scalar @valid }) : 0;
+                my $colour = ms_colour($average);
+                my @ips = grep { $_->{ip} ne 'N/A' } @$results;
+                my $ip_str = @ips ? $ips[0]{ip} : 'N/A';
+                if ($dns->{no_clock}) {
+                    printf "    %-25s → %s\n", $domain, $ip_str;
+                }
+                else {
+                    printf "    %-25s → %s%-18s%s %.0fms\n",
+                        $domain, $colour, $ip_str, $RESET, $average;
+                }
+            }
+        }
+    }
+
+    # Reachability
+    print "\n${BOLD}── IPv6 Reachability ──$RESET\n";
+    print_reachability('v6', $data->{ipv6});
+    print "\n${BOLD}── IPv4 Reachability ──$RESET\n";
+    print_reachability('v4', $data->{ipv4});
+
+    # Path MTU
+    print "\n${BOLD}── Path MTU ──$RESET\n";
+    my $mtu = $data->{mtu} // {};
+    if (%$mtu) {
+        if ($mtu->{path_mtu}) {
+            my $colour = $mtu->{path_mtu} < 1500 ? $YELLOW : $GREEN;
+            print "  ${colour}$mtu->{path_mtu}B$RESET  (", ($mtu->{method} // ''), ")\n";
+        }
+        elsif ($mtu->{method}) {
+            print "  ${DIM}$mtu->{method}$RESET\n";
+        }
+        elsif ($mtu->{error}) {
+            print "  ${DIM}unavailable: $mtu->{error}$RESET\n";
+        }
+    }
+
+    # Listening ports
+    print "\n${BOLD}── Listening Ports ──$RESET\n";
+    my $ports = $data->{listening} // {};
+    if (%$ports) {
+        if ($ports->{error}) {
+            print "  ${DIM}unavailable: $ports->{error}$RESET\n";
+        }
+        else {
+            my $total = 0;
+            $total += scalar @{ $ports->{$_} } for grep { ref $ports->{$_} eq 'ARRAY' } keys %$ports;
+            if ($total > 0) {
+                for my $version ('tcp6', 'tcp4', 'tcp46') {
+                    for my $entry (@{ $ports->{$version} // [] }) {
+                        printf "  %s  %-22s  %s%s%s\n", $version, $entry->{addr}, $DIM, $entry->{process}, $RESET;
+                    }
+                }
+            }
+            else {
+                print "  (none)\n";
+            }
+        }
+    }
+
+    # Grade breakdown
+    print "\n${BOLD}── Grade Breakdown ──$RESET\n";
+    my $breakdown = $grade_info->{breakdown} // {};
+    my @labels = (
+        ['packet_loss',       'Packet loss'],
+        ['latency',           'Latency'],
+        ['dns_speed',         'DNS speed'],
+        ['ipv6_dualstack',    'IPv6 / dual-stack'],
+        ['ipv4_reachability', 'IPv4 reachability'],
+    );
+    for my $item (@labels) {
+        my ($key, $label) = @$item;
+        my $points = $breakdown->{$key} // 0;
+        my $filled = int($points / 2);
+        my $bar_line = ("█" x $filled) . ("░" x (10 - $filled));
+        printf "  %-20s %s %s/20\n", $label, $bar_line, $points;
+    }
+
+    # Footer
+    print "\n${BOLD}${bar}$RESET\n";
+    print "  ${BOLD}Overall Grade: ${grade_colour}${grade_letter}$RESET  ";
+    print "(", ($grade_info->{score} // '?'), "/", ($grade_info->{max_score} // 100), ")\n";
+    print "${BOLD}${bar}$RESET\n\n";
+}
+
+# ---------------------------------------------------------------------------
+# Parallel collection
+# ---------------------------------------------------------------------------
+
+# The checks are independent and each is dominated by waiting, so they run as
+# forked children, one per check.  A child writes its result as a Perl literal
+# into the private scratch directory and the parent reads it back once the child
+# has been reaped, because the builtin pipe forms give no way to collect several
+# results without a select loop over them.  Progress lines appear in completion
+# order.
+sub scratch_dir {
+    return $TMP_DIR if defined $TMP_DIR;
+    # An empty TMPDIR counts as unset: an empty base would place the scratch
+    # directory at the filesystem root, where a root run would even succeed.
+    my $base = defined $ENV{TMPDIR} && length $ENV{TMPDIR} ? $ENV{TMPDIR} : '/tmp';
+    for my $attempt (0 .. 9) {
+        my $dir = "$base/network-diag.$$" . ($attempt ? ".$attempt" : '');
+        # mkdir is atomic and refuses to follow a symlink, so a hostile entry in a
+        # shared /tmp cannot redirect the writes.
+        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;
+    # Every forked child inherits the END block, so removal is restricted to the
+    # process that created the directory.  Without this the first child to finish
+    # would delete the result files its siblings have yet to write.
+    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;
+}
+
+# A value as Perl source, which is what the parent eval's back.  Only the
+# characters a single-quoted string cannot carry are escaped.
+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) . ']';
+    }
+    return $value if !ref $value && $value =~ /^-?(?:0|[1-9][0-9]*)(?:\.[0-9]+)?$/;
+    my $text = $value;
+    $text =~ s/([\\'])/\\$1/g;
+    return "'$text'";
+}
+
+sub write_literal {
+    my ($file, $value) = @_;
+    open(my $fh, '>', $file) or die "cannot write the result file $file: $!\n";
+    print {$fh} perl_literal($value), "\n";
+    close($fh) or die "cannot write the result file $file: $!\n";
+    return 1;
+}
+
+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: $!");
+    local $/ = undef;
+    my $text = <$fh>;
+    close($fh);
+    return (undef, 'empty result') unless defined $text && length $text;
+    my $value = eval $text;      # written by our own child, read before it is removed
+    return (undef, 'unreadable result') if $@;
+    return ($value, '');
+}
+
+sub collect_checks {
+    my ($data, $os_type, $target, $protocol) = @_;
+
+    my @plan = (
+        ['connectivity', 'internet connectivity', sub { check_connectivity($protocol) }],
+    );
+    # Only the families the user asked for, IPv6 first.
+    if ($protocol ne 'v4') {
+        push @plan, ['ping_v6', 'ping (IPv6)', sub { ping_host($target, $os_type, protocol => 'v6') }];
+    }
+    if ($protocol ne 'v6') {
+        push @plan, ['ping_v4', 'ping (IPv4)', sub { ping_host($target, $os_type, protocol => 'v4') }];
+    }
+    push @plan,
+        ['dns',       'DNS resolution',  sub { check_dns($protocol) }],
+        ['mtu',       'path MTU',        sub { check_mtu($target, $protocol, $os_type) }],
+        ['listening', 'listening ports', sub { listening_ports($os_type) }];
+
+    my $dir = scratch_dir();
+    my (%pid_of, %file_of, %label_of);
+    for my $item (@plan) {
+        my ($key, $label, $code) = @$item;
+        my $file = "$dir/$key";
+        $file_of{$key} = $file;
+        $label_of{$key} = $label;
+        my $pid = fork();
+        die "cannot fork: $!\n" unless defined $pid;
+        if ($pid == 0) {
+            # A child must not inherit the parent's interrupt handling, or one
+            # Ctrl-C would print the message once per process.
+            $SIG{INT} = 'DEFAULT';
+            $SIG{TERM} = 'DEFAULT';
+            my $ok = eval { write_literal($file, $code->()) };
+            unless ($ok) {
+                my $error = $@ || 'unknown error';
+                $error =~ s/\s+\z//;
+                write_literal($file, { error => $error });
+            }
+            exit($ok ? 0 : 1);
+        }
+        $pid_of{$pid} = $key;
+    }
+
+    my $count = scalar @plan;
+    print STDERR "  Running $count checks in parallel...\n";
+    for (1 .. $count) {
+        my $pid = waitpid(-1, 0);
+        last if $pid <= 0;
+        my $key = $pid_of{$pid};
+        next unless defined $key;
+        my $exit_status = $? >> 8;
+        my ($result, $read_error) = read_literal($file_of{$key});
+        my $label = $label_of{$key};
+
+        if ($exit_status != 0 || !defined $result) {
+            my $message = $read_error;
+            $message = $result->{error} if ref $result eq 'HASH' && $result->{error};
+            $message = 'check failed' unless defined $message && length $message;
+            $data->{$key} = { error => $message };
+            print STDERR "    $label... failed ($message)\n";
+            next;
+        }
+        $data->{$key} = $result;
+        if (ref $result eq 'HASH' && $result->{note}) {
+            print STDERR "    $label... warning ($result->{note})\n";
+        }
+        else {
+            print STDERR "    $label... done\n";
+        }
+    }
+    remove_scratch();
+    return;
+}
+
+# ---------------------------------------------------------------------------
+# Entry point
+# ---------------------------------------------------------------------------
+
+sub usage {
+    my $name = $0;
+    $name =~ s{.*/}{};
+    return <<"USAGE";
+Usage: $name [options]
+
+Network diagnostics: latency, DNS, MTU, dual-stack, ports
+
+Options:
+  --target HOST     Target host for tests (default: cloudflare.com)
+  --protocol FAMILY Address family: auto (dual-stack), v4 (IPv4 only),
+                    v6 (IPv6 only) (default: auto)
+  --version         Show the version and exit
+  -h, --help        Show this help and exit
+USAGE
+}
+
+sub parse_args {
+    my %opt = (target => 'cloudflare.com', protocol => 'auto');
+    my @argv = @ARGV;
+    while (defined(my $arg = shift @argv)) {
+        if ($arg eq '--target' || $arg eq '--protocol') {
+            my $value = shift @argv;
+            if (!defined $value) {
+                print STDERR "argument $arg: expected one argument\n";
+                print STDERR usage();
+                exit 2;
+            }
+            $opt{ substr($arg, 2) } = $value;
+        }
+        elsif ($arg =~ /^--(target|protocol)=(.*)$/s) {
+            $opt{$1} = $2;
+        }
+        elsif ($arg eq '--help' || $arg eq '-h') {
+            print usage();
+            exit 0;
+        }
+        elsif ($arg eq '--version') {
+            my $name = $0;
+            $name =~ s{.*/}{};
+            print "$name $VERSION\n";
+            exit 0;
+        }
+        else {
+            print STDERR "unrecognised argument: $arg\n";
+            print STDERR usage();
+            exit 2;
+        }
+    }
+    if ($opt{protocol} ne 'auto' && $opt{protocol} ne 'v4' && $opt{protocol} ne 'v6') {
+        print STDERR "argument --protocol: invalid choice: '$opt{protocol}' (choose from auto, v4, v6)\n";
+        print STDERR usage();
+        exit 2;
+    }
+    return %opt;
+}
+
+sub main {
+    my %opt = parse_args();
+    my $target   = $opt{target};
+    my $protocol = $opt{protocol};
+    my $os_type  = detect_os();
+
+    my $hostname = check_hostname();
+    my $data = {
+        hostname     => $hostname,
+        version      => $VERSION,
+        os           => $os_type,
+        protocol     => $protocol,
+        interfaces   => {},
+        connectivity => {},
+        ping         => {},
+        ping_v4      => undef,
+        ping_v6      => undef,
+        dns          => {},
+        ipv4         => {},
+        ipv6         => {},
+        mtu          => {},
+        listening    => {},
+        grade        => {},
+    };
+
+    # Interfaces first: instant, sequential, and the reachability sections
+    # below depend on the result.
+    status('Checking interfaces');
+    $data->{interfaces} = interface_info($os_type);
+    my $iface_error = $data->{interfaces}{error};
+    status_done($iface_error ? "warning: $iface_error" : 'done');
+
+    collect_checks($data, $os_type, $target, $protocol);
+
+    # Per-family reachability from interface data plus the shared probes.
+    my $conn = $data->{connectivity} // {};
+    my $probes_v4 = ref $conn->{v4} eq 'HASH' ? $conn->{v4} : {};
+    my $probes_v6 = ref $conn->{v6} eq 'HASH' ? $conn->{v6} : {};
+    $data->{ipv6} = reachability_report('v6', $data->{interfaces}, $probes_v6);
+    $data->{ipv4} = reachability_report('v4', $data->{interfaces}, $probes_v4);
+    if ($protocol eq 'v4')     { $data->{ipv6}{skipped} = 1 }
+    elsif ($protocol eq 'v6')  { $data->{ipv4}{skipped} = 1 }
+
+    # The ping that summarises the run: the requested family, or IPv6 when it
+    # answered, which is the dual-stack preference.
+    if ($protocol eq 'v4') {
+        $data->{ping} = $data->{ping_v4} // {};
+    }
+    elsif ($protocol eq 'v6') {
+        $data->{ping} = $data->{ping_v6} // {};
+    }
+    else {
+        my $ping_v4 = $data->{ping_v4};
+        my $ping_v6 = $data->{ping_v6};
+        my $v6_received = ref $ping_v6 eq 'HASH' ? ($ping_v6->{received} // 0) : 0;
+        if ($v6_received > 0 && ref $ping_v6 eq 'HASH') {
+            $data->{ping} = $ping_v6;
+        }
+        elsif (ref $ping_v4 eq 'HASH') {
+            $data->{ping} = $ping_v4;
+        }
+        else {
+            $data->{ping} = {};
+        }
+    }
+
+    $data->{grade} = compute_grade($data);
+    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();
+}
+
+exit(main()) unless caller;
diff --git a/security-audit.pl b/security-audit.pl
new file mode 100644
index 0000000..dd2dcc5
--- /dev/null
+++ b/security-audit.pl
@@ -0,0 +1,2350 @@
+#!/usr/bin/env perl
+# Copyright (c) 2026 Petr Balvín <opensource@petrbalvin.org> (https://petrbalvin.org)
+# SPDX-License-Identifier: MIT
+
+# Security audit: SSH, firewall, SELinux, updates, accounts, services, kernel
+# hardening, and an opt-in file system scan, graded A to F.
+#
+# The audit reads the state the machine is in, not what a configuration file
+# promises.  sshd is asked for its effective configuration through `sshd -T`,
+# the firewall is read from the running firewalld and compared against the
+# sockets that really have a listener, SELinux is read at runtime and checked
+# against what it will be at the next boot, and pending security updates come
+# from dnf's own metadata.  Where a source cannot answer, the check is reported
+# as unknown and the grade is renormalised, so missing tooling never reads as a
+# security failure; an explicitly weakened control still scores nothing.
+#
+# It runs unprivileged where that is enough.  As root, sshd answers with its
+# effective values, /etc/shadow and the sudoers files open, and dnf's cache is
+# the system's.  Unprivileged, the same sections degrade to unknown rather than
+# to a guess, and the report names the sources that need root.
+#
+# Deliberate limits, stated rather than hidden:
+#
+#   * firewalld rich rules, direct rules and source based allowances are not
+#     modelled.  A listener the zone rules do not explain may be intentional;
+#     the finding says what was and was not matched, not what is wrong.
+#   * dnf is queried with --cacheonly, so the audit never touches the network.
+#     Metadata that is not cached means an unknown, not an empty answer.
+#   * the sshd fallback that parses /etc/ssh/sshd_config when `sshd -T` cannot
+#     run applies OpenSSH's defaults to absent keywords and ignores Match
+#     blocks, which `sshd -T` would have resolved.  The report says when the
+#     source is the file rather than the running daemon.
+#   * the deep file scan covers the root file system only (-xdev).
+#
+# A critical finding makes the exit status 1, so a cron job or a pipeline fails
+# loudly; --strict extends that to warnings.  A usage error exits 2.
+#
+# Perl builtins only: no module has to be installed.  The command runner forks
+# and keeps stdout and stderr apart in a private scratch directory, the JSON
+# encoder for --json is written by hand, and the port ranges of a firewalld
+# service are read from its XML with a regular expression.
+#
+# External binaries used: sshd, ss, firewall-cmd, getenforce, dnf, rpm,
+# systemctl, find and uname.
+#
+# Linux only.  Progress goes to stderr, the report to stdout.
+#
+# Usage:
+#     security-audit.pl                             # full audit
+#     security-audit.pl --section ssh,firewall      # only selected sections
+#     security-audit.pl --deep                      # also scan the file system
+#     security-audit.pl --json                      # machine-readable output
+#     security-audit.pl --strict                    # fail on warnings too
+#     security-audit.pl --version
+
+use strict;
+use warnings;
+
+my $VERSION = '2.0.0';
+
+# Colour, in the shape the collection uses: NO_COLOR (https://no-color.org) or a
+# stdout that is not a terminal disables every escape.
+my ($BOLD, $RED, $GREEN, $YELLOW, $CYAN, $DIM, $RESET) = (
+    "\033[1m", "\033[31m", "\033[32m", "\033[33m",
+    "\033[36m", "\033[2m", "\033[0m",
+);
+if (defined $ENV{NO_COLOR} || !-t STDOUT) {
+    ($BOLD, $RED, $GREEN, $YELLOW, $CYAN, $DIM, $RESET) = ('') x 7;
+}
+
+# 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(ssh firewall selinux updates accounts services kernel files);
+
+my %SECTION_TITLES = (
+    ssh      => 'SSH',
+    firewall => 'Firewall',
+    selinux  => 'SELinux',
+    updates  => 'Updates',
+    accounts => 'Accounts',
+    services => 'Services',
+    kernel   => 'Kernel hardening',
+    files    => 'File system scan',
+);
+
+# OpenSSH's own defaults, applied to keywords an effective dump never omits but
+# a configuration file can.  sshd_config(5) is the source for each one.
+my %SSHD_DEFAULTS = (
+    permitrootlogin         => 'prohibit-password',
+    passwordauthentication  => 'yes',
+    permitemptypasswords    => 'no',
+    pubkeyauthentication    => 'yes',
+    x11forwarding           => 'no',
+    maxauthtries            => '6',
+);
+
+my $TMP_DIR;           # private scratch directory, created only when needed
+my $PARENT_PID = $$;   # nothing forks today, but the cleanup contract stays
+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 _trim {
+    my ($text) = @_;
+    return '' unless defined $text;
+    $text =~ s/^\s+//;
+    $text =~ s/\s+$//;
+    return $text;
+}
+
+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/security-audit.$$" . ($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;
+    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 defined $text ? _trim($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 can_read_file {
+    my ($path) = @_;
+    return -f $path && -r _ ? 1 : 0;
+}
+
+sub is_root {
+    return $> == 0 ? 1 : 0;
+}
+
+# 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;
+}
+
+# The +hhmm offset.  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));
+}
+
+sub hostname_of {
+    my $name = read_file('/proc/sys/kernel/hostname');
+    return length $name ? $name : 'unknown';
+}
+
+# ---------------------------------------------------------------------------
+# JSON, written by hand
+# ---------------------------------------------------------------------------
+
+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 . '"';
+}
+
+# Values written as true and false, because Perl has no boolean type and the
+# paths must be listed.  The exact paths first, then the shape of the listener
+# entries: array elements carry no index in a path, so one shape covers them.
+my @JSON_BOOLEANS = (
+    'root',
+    'deep',
+    'sections.ssh.available',
+    'sections.firewall.available',
+    'sections.firewall.active',
+    'sections.selinux.available',
+    'sections.updates.reboot_required',
+);
+my %JSON_BOOLEAN = map { $_ => 1 } @JSON_BOOLEANS;
+my @JSON_BOOLEAN_PATHS = (
+    qr/^sections\.firewall\.listeners\.(?:loopback|allowed|exposed)$/,
+);
+
+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} || grep { $path =~ $_ } @JSON_BOOLEAN_PATHS) {
+        $$out .= $value ? 'true' : 'false';
+        return;
+    }
+    if ($value =~ /^-?(?:0|[1-9][0-9]*)(?:\.[0-9]+)?(?:[eE][-+]?[0-9]+)?$/) {
+        $$out .= $value;
+        return;
+    }
+    $$out .= json_quote($value);
+    return;
+}
+
+sub json_encode {
+    my ($value) = @_;
+    my $out = '';
+    json_render($value, '', 0, \$out);
+    return $out . "\n";
+}
+
+# ---------------------------------------------------------------------------
+# RPM version comparison, the collection's own implementation of rpmvercmp
+# ---------------------------------------------------------------------------
+
+# Segments alternate between digits and letters, numeric segments compare by
+# value, tilde sorts before everything, and separators are skipped.
+sub rpmvercmp {
+    my ($ver_a, $ver_b) = @_;
+    my $len_a = length $ver_a;
+    my $len_b = length $ver_b;
+    my ($pos_a, $pos_b) = (0, 0);
+
+    while ($pos_a < $len_a || $pos_b < $len_b) {
+        my $tilde_a = $pos_a < $len_a && substr($ver_a, $pos_a, 1) eq '~';
+        my $tilde_b = $pos_b < $len_b && substr($ver_b, $pos_b, 1) eq '~';
+        if ($tilde_a || $tilde_b) {
+            if ($tilde_a && $tilde_b) { $pos_a++; $pos_b++; next }
+            return $tilde_a ? -1 : 1;
+        }
+
+        $pos_a++ while $pos_a < $len_a && substr($ver_a, $pos_a, 1) !~ /[A-Za-z0-9]/;
+        $pos_b++ while $pos_b < $len_b && substr($ver_b, $pos_b, 1) !~ /[A-Za-z0-9]/;
+        last if $pos_a >= $len_a || $pos_b >= $len_b;
+
+        my $numeric_a = substr($ver_a, $pos_a, 1) =~ /[0-9]/ ? 1 : 0;
+        my $numeric_b = substr($ver_b, $pos_b, 1) =~ /[0-9]/ ? 1 : 0;
+        if ($numeric_a != $numeric_b) {
+            return $numeric_a ? 1 : -1;
+        }
+
+        my ($start_a, $start_b) = ($pos_a, $pos_b);
+        my ($seg_a, $seg_b);
+        if ($numeric_a) {
+            $pos_a++ while $pos_a < $len_a && substr($ver_a, $pos_a, 1) =~ /[0-9]/;
+            $pos_b++ while $pos_b < $len_b && substr($ver_b, $pos_b, 1) =~ /[0-9]/;
+            $seg_a = substr($ver_a, $start_a, $pos_a - $start_a);
+            $seg_b = substr($ver_b, $start_b, $pos_b - $start_b);
+            $seg_a =~ s/^0+//;
+            $seg_b =~ s/^0+//;
+            $seg_a = '0' unless length $seg_a;
+            $seg_b = '0' unless length $seg_b;
+            if (length $seg_a != length $seg_b) {
+                return length $seg_a > length $seg_b ? 1 : -1;
+            }
+        }
+        else {
+            $pos_a++ while $pos_a < $len_a && substr($ver_a, $pos_a, 1) =~ /[A-Za-z]/;
+            $pos_b++ while $pos_b < $len_b && substr($ver_b, $pos_b, 1) =~ /[A-Za-z]/;
+            $seg_a = substr($ver_a, $start_a, $pos_a - $start_a);
+            $seg_b = substr($ver_b, $start_b, $pos_b - $start_b);
+        }
+        if ($seg_a ne $seg_b) {
+            return $seg_a gt $seg_b ? 1 : -1;
+        }
+    }
+
+    return 1 if $pos_a < $len_a;
+    return -1 if $pos_b < $len_b;
+    return 0;
+}
+
+# ---------------------------------------------------------------------------
+# Check construction
+# ---------------------------------------------------------------------------
+
+# One check: an id, a severity of pass, warn, critical, unknown or info, a weight
+# that must be an even number (a warning is worth half), a short title for the
+# report, a message, and optionally a detail list of lines.
+sub _check {
+    my (%arg) = @_;
+    my %check = (
+        id       => $arg{id},
+        severity => $arg{severity},
+        weight   => $arg{weight} // 0,
+        title    => $arg{title},
+        message  => $arg{message},
+    );
+    $check{detail} = [ @{ $arg{detail} } ] if $arg{detail};
+    return \%check;
+}
+
+# ---------------------------------------------------------------------------
+# Section: SSH
+# ---------------------------------------------------------------------------
+
+# The effective configuration, one "keyword value" pair per line, as `sshd -T`
+# prints it.  Port may repeat, because sshd listens on every port it is given.
+sub parse_sshd_effective {
+    my ($out) = @_;
+    my %values;
+    my @ports;
+    for my $line (split /\n/, $out) {
+        my @fields = split ' ', $line, 2;
+        next unless @fields == 2;
+        my ($key, $value) = (lc $fields[0], _trim($fields[1]));
+        if ($key eq 'port') {
+            push @ports, $value + 0 if $value =~ /^\d+$/;
+        }
+        $values{$key} = $value unless exists $values{$key};
+    }
+    return (\%values, \@ports);
+}
+
+# The fallback: the configuration files, with Include expanded relative to
+# /etc/ssh, in the order OpenSSH reads them.  The first value of a keyword wins,
+# which is OpenSSH's own rule; Port and ListenAddress accumulate instead, since
+# sshd binds every one.  Match blocks are not resolved: reading stops at the
+# first Match line, because everything after it is conditional on a pattern
+# this parser cannot evaluate.
+sub read_sshd_config {
+    my ($path, $state, $depth) = @_;
+    return if $depth > 5;
+    return unless can_read_file($path);
+    for my $line (@{ read_lines($path) }) {
+        next unless length $line;
+        next if index($line, '#') == 0;
+        my @fields = split ' ', $line, 2;
+        next unless @fields >= 1;
+        my $key = lc $fields[0];
+        my $value = @fields == 2 ? _trim($fields[1]) : '';
+        if ($key eq 'include') {
+            for my $pattern (split ' ', $value) {
+                next unless length $pattern;
+                $pattern = "/etc/ssh/$pattern" unless index($pattern, '/') == 0;
+                for my $file (sort glob($pattern)) {
+                    read_sshd_config($file, $state, $depth + 1);
+                }
+            }
+            next;
+        }
+        if ($key eq 'match') {
+            # Everything after a Match line is conditional on a pattern this
+            # parser cannot evaluate, so the global reading of the file ends.
+            last;
+        }
+        if ($key eq 'port' || $key eq 'listenaddress') {
+            push @{ $state->{accum}{$key} }, $value if length $value;
+            next;
+        }
+        next if $state->{seen}{$key}++;
+        $state->{values}{$key} = $value;
+    }
+    return;
+}
+
+sub sshd_config_values {
+    my $state = { values => {}, seen => {}, accum => {} };
+    read_sshd_config('/etc/ssh/sshd_config', $state, 0);
+    my @ports = map { $_ + 0 } grep { /^\d+$/ } @{ $state->{accum}{port} // [] };
+    return ($state->{values}, \@ports);
+}
+
+sub collect_ssh {
+    my %ssh = (available => 0, source => '', values => {}, ports => []);
+
+    my $sshd = find_exe('sshd');
+    $sshd = find_exe('/usr/sbin/sshd') unless defined $sshd;
+    if (defined $sshd) {
+        my $p = run([$sshd, '-T'], 15);
+        if ($p->{rc} == 0 && length $p->{out}) {
+            my ($values, $ports) = parse_sshd_effective($p->{out});
+            %ssh = (available => 1, source => 'effective', values => $values, ports => $ports);
+            return \%ssh;
+        }
+    }
+
+    my ($values, $ports) = sshd_config_values();
+    if (%$values) {
+        %ssh = (available => 1, source => 'config', values => $values, ports => $ports);
+    }
+    return \%ssh;
+}
+
+sub effective_value {
+    my ($values, $key) = @_;
+    return exists $values->{$key} ? $values->{$key} : $SSHD_DEFAULTS{$key};
+}
+
+sub used_default {
+    my ($values, $key) = @_;
+    return !exists $values->{$key} && exists $SSHD_DEFAULTS{$key};
+}
+
+sub evaluate_ssh {
+    my ($ssh) = @_;
+    return () unless $ssh->{available};
+    my $values = $ssh->{values};
+    my @checks;
+
+    # sshd_config(5) calls its arguments case-sensitive, but sshd itself
+    # accepts and lowercases the Yes and No values these verdicts compare,
+    # as `sshd -T` prints them back, so the comparisons are lowercased.
+    my $root_login = lc effective_value($values, 'permitrootlogin');
+    my $defaulted = used_default($values, 'permitrootlogin') ? " (OpenSSH's default)" : '';
+    if ($root_login eq 'yes') {
+        push @checks, _check(
+            id => 'ssh.permit_root_login', severity => 'critical', weight => 4,
+            title => 'Root login',
+            message => "PermitRootLogin yes$defaulted: root is reachable by any authentication method",
+        );
+    }
+    elsif ($root_login eq 'no') {
+        push @checks, _check(
+            id => 'ssh.permit_root_login', severity => 'pass', weight => 4,
+            title => 'Root login', message => "PermitRootLogin no$defaulted",
+        );
+    }
+    elsif ($root_login eq 'forced-commands-only') {
+        push @checks, _check(
+            id => 'ssh.permit_root_login', severity => 'pass', weight => 4,
+            title => 'Root login', message => 'PermitRootLogin forced-commands-only',
+        );
+    }
+    else {   # prohibit-password
+        push @checks, _check(
+            id => 'ssh.permit_root_login', severity => 'pass', weight => 4,
+            title => 'Root login',
+            message => "PermitRootLogin $root_login$defaulted: keys only",
+        );
+    }
+
+    my $password = lc effective_value($values, 'passwordauthentication');
+    $defaulted = used_default($values, 'passwordauthentication')
+        ? " (OpenSSH's default)" : '';
+    if ($password eq 'no') {
+        push @checks, _check(
+            id => 'ssh.password_authentication', severity => 'pass', weight => 4,
+            title => 'Password auth', message => "PasswordAuthentication no$defaulted",
+        );
+    }
+    else {
+        push @checks, _check(
+            id => 'ssh.password_authentication', severity => 'warn', weight => 4,
+            title => 'Password auth',
+            message => "PasswordAuthentication $password$defaulted: keys are preferred on an exposed host",
+        );
+    }
+
+    my $empty = lc effective_value($values, 'permitemptypasswords');
+    $defaulted = used_default($values, 'permitemptypasswords') ? " (OpenSSH's default)" : '';
+    push @checks, _check(
+        id => 'ssh.permit_empty_passwords',
+        severity => $empty eq 'no' ? 'pass' : 'critical', weight => 2,
+        title => 'Empty passwords',
+        message => $empty eq 'no'
+            ? "PermitEmptyPasswords no$defaulted"
+            : "PermitEmptyPasswords $empty: an account without a password is reachable over SSH",
+    );
+
+    my $pubkey = lc effective_value($values, 'pubkeyauthentication');
+    push @checks, _check(
+        id => 'ssh.pubkey_authentication',
+        severity => $pubkey eq 'yes' ? 'pass' : 'warn', weight => 2,
+        title => 'Pubkey auth',
+        message => $pubkey eq 'yes'
+            ? 'PubkeyAuthentication yes'
+            : "PubkeyAuthentication $pubkey: authentication falls back to weaker methods",
+    );
+
+    my $x11 = lc effective_value($values, 'x11forwarding');
+    push @checks, _check(
+        id => 'ssh.x11forwarding',
+        severity => $x11 eq 'no' ? 'pass' : 'warn', weight => 2,
+        title => 'X11 forwarding',
+        message => $x11 eq 'no'
+            ? 'X11Forwarding no'
+            : "X11Forwarding $x11: an SSH client reaches the local display",
+    );
+
+    my $max_tries = effective_value($values, 'maxauthtries');
+    if ($max_tries =~ /^\d+$/ && $max_tries + 0 > 6) {
+        push @checks, _check(
+            id => 'ssh.max_auth_tries', severity => 'warn', weight => 2,
+            title => 'Max auth tries',
+            message => "MaxAuthTries $max_tries widens the brute force window",
+        );
+    }
+    else {
+        push @checks, _check(
+            id => 'ssh.max_auth_tries', severity => 'pass', weight => 2,
+            title => 'Max auth tries',
+            message => "MaxAuthTries $max_tries",
+        );
+    }
+
+    return @checks;
+}
+
+# ---------------------------------------------------------------------------
+# Section: Firewall
+# ---------------------------------------------------------------------------
+
+# The ports a firewalld service XML allows, read with a regular expression.
+# Attribute order in the <port> element varies, so the attributes are read
+# separately; a missing protocol falls back to tcp, which is what the schema
+# makes it.
+sub parse_service_xml {
+    my ($xml) = @_;
+    my @ports;
+    while ($xml =~ /<port\s+([^>]*?)\/?>/g) {
+        my $attrs = $1;
+        my ($port) = $attrs =~ /\bport="([^"]+)"/;
+        my ($proto) = $attrs =~ /\bprotocol="([^"]+)"/;
+        next unless defined $port && length $port;
+        $proto = 'tcp' unless defined $proto && length $proto;
+        push @ports, lc($port) . '/' . lc($proto);
+    }
+    return @ports;
+}
+
+# The service name to ports map.  /etc overrides /usr/lib, so the system tree is
+# read first and the administrator's tree overwrites it.
+sub load_service_map {
+    my %map;
+    for my $dir ('/usr/lib/firewalld/services', '/etc/firewalld/services') {
+        next unless -d $dir;
+        my @entries;
+        if (opendir(my $dh, $dir)) {
+            @entries = sort grep { /\.xml$/ && -f "$dir/$_" } readdir($dh);
+            closedir($dh);
+        }
+        for my $entry (@entries) {
+            my @ports = parse_service_xml(slurp("$dir/$entry"));
+            my $name = $entry;
+            $name =~ s/\.xml$//;
+            $map{$name} = \@ports if @ports;
+        }
+    }
+    return \%map;
+}
+
+# The zone names sit at column 0; the member lines are indented.  firewalld
+# decorates the name, as "FedoraWorkstation (default)", and the decoration is
+# not part of the name the next firewall-cmd call accepts.
+sub parse_active_zones {
+    my ($out) = @_;
+    my @zones;
+    for my $line (split /\n/, $out) {
+        next unless length _trim($line);
+        next if index($line, ' ') == 0 || index($line, "\t") == 0;
+        my $name = _trim($line);
+        $name =~ s/\s+\([^)]*\)$//;
+        push @zones, $name;
+    }
+    return @zones;
+}
+
+# One zone through --info-zone, which answers for the running firewall: the
+# first line carries the name, then "key: value" lines carry the target, the
+# services and the ports.
+sub parse_info_zone {
+    my ($out) = @_;
+    my %info = (name => '', target => '', services => [], ports => []);
+    my $have_name = 0;
+    for my $line (split /\n/, $out) {
+        if (!$have_name) {
+            next unless length _trim($line);
+            $info{name} = _trim($line);
+            $have_name = 1;
+            next;
+        }
+        my ($key, $value) = $line =~ /^\s*(\S+):\s*(.*)$/ or next;
+        if ($key eq 'target') {
+            $info{target} = lc _trim($value);
+        }
+        elsif ($key eq 'services') {
+            $info{services} = [split ' ', _trim($value)];
+        }
+        elsif ($key eq 'ports') {
+            $info{ports} = [split ' ', _trim($value)];
+        }
+    }
+    return \%info;
+}
+
+sub split_listener_address {
+    my ($local) = @_;
+    my ($addr, $port);
+    if ($local =~ /^(.*):(\d+)$/) {
+        ($addr, $port) = ($1, $2);
+    }
+    else {
+        return (undef, undef);
+    }
+    # ss writes the scope suffix outside the brackets:
+    # "[fe80::a7f4:eb68:1d07:aac3]%wlp193s0:3702".  The scope strip therefore
+    # runs before the bracket strips, or the closing bracket survives it.
+    $addr =~ s/%.*//;
+    $addr =~ s/^\[//;
+    $addr =~ s/\]$//;
+    return ($addr, $port + 0);
+}
+
+sub is_loopback_address {
+    my ($addr) = @_;
+    return 1 if $addr =~ /^127\./;
+    return 1 if $addr eq '::1';
+    return 1 if $addr eq '0:0:0:0:0:0:0:1';
+    return 0;
+}
+
+sub is_wildcard_address {
+    my ($addr) = @_;
+    return 1 if $addr eq '' || $addr eq '*' || $addr eq '0.0.0.0' || $addr eq '::';
+    return 0;
+}
+
+# The first process name inside users:(("sshd",pid=1,fd=3)).
+sub parse_process_field {
+    my ($field) = @_;
+    return '' unless defined $field;
+    my ($name) = $field =~ /users:\(\("([^"]+)"/;
+    return defined $name ? $name : '';
+}
+
+# Every listening socket, from `ss -tulnp`.  A line carries the protocol, the
+# state, two queues, the local address and the peer, and, as root, the process.
+sub parse_ss_listeners {
+    my ($out) = @_;
+    my @listeners;
+    for my $line (split /\n/, $out) {
+        my @fields = split ' ', $line;
+        next unless @fields >= 5;
+        next unless $fields[1] eq 'LISTEN' || $fields[1] eq 'UNCONN';
+        my $proto = lc $fields[0];
+        # tcp6 and udp6 belong to the same check as tcp and udp.
+        $proto =~ s/\d+$//;
+        next unless $proto eq 'tcp' || $proto eq 'udp';
+        my ($addr, $port) = split_listener_address($fields[4]);
+        next unless defined $port;
+        my $process = parse_process_field($fields[6]);
+        push @listeners, {
+            proto    => $proto,
+            address  => $addr,
+            port     => $port,
+            loopback => is_loopback_address($addr),
+            process  => $process,
+        };
+    }
+    return \@listeners;
+}
+
+# firewalld availability: the binary present is availability, and --state
+# answers "running" on stdout only for a live daemon; a daemon that is down
+# answers on stderr and nothing on stdout, which is "installed but not
+# running" rather than "not installed".
+sub classify_firewalld {
+    my ($present, $out) = @_;
+    return (0, 0) unless $present;
+    my $state = _trim($out);
+    return (1, $state eq 'running' ? 1 : 0);
+}
+
+sub collect_firewall {
+    my %fw = (
+        available => 0, active => 0, default_zone => '', zones => [],
+        listeners => undef, listeners_error => '',
+    );
+
+    my $present = defined find_exe('firewall-cmd') ? 1 : 0;
+    ($fw{available}, $fw{active})
+        = classify_firewalld($present, run(['firewall-cmd', '--state'], 5)->{out});
+
+    if ($fw{available} && $fw{active}) {
+        my $p = run(['firewall-cmd', '--get-default-zone'], 5);
+        $fw{default_zone} = _trim($p->{out}) if $p->{rc} == 0;
+
+        my @zone_names = parse_active_zones(run(['firewall-cmd', '--get-active-zones'], 5)->{out});
+        my $svc_map = load_service_map();
+        for my $zone (@zone_names) {
+            my $info = parse_info_zone(run(['firewall-cmd', '--info-zone=' . $zone], 10)->{out});
+            my %entry = (
+                name          => length $info->{name} ? $info->{name} : $zone,
+                ports         => $info->{ports},
+                services      => $info->{services},
+                service_ports => [],
+                target        => $info->{target},
+            );
+            for my $service (@{ $entry{services} }) {
+                push @{ $entry{service_ports} }, @{ $svc_map->{$service} // [] };
+            }
+            push @{ $fw{zones} }, \%entry;
+        }
+    }
+
+    if (defined find_exe('ss')) {
+        my $p = run(['ss', '-tulnp'], 15);
+        $fw{listeners} = parse_ss_listeners($p->{out}) if $p->{rc} == 0;
+        $fw{listeners_error} = 'ss failed' if $p->{rc} != 0;
+    }
+
+    return \%fw;
+}
+
+# Whether a zone's port list and its services allow a port.  A spec is
+# "port", "port/proto", or a range "6000-6009/tcp".
+sub port_allowed {
+    my ($allowed, $proto, $port) = @_;
+    my $specs = $allowed->{$proto} or return 0;
+    for my $spec (@$specs) {
+        if ($spec =~ /^(\d+)-(\d+)$/) { return 1 if $port >= $1 && $port <= $2 }
+        elsif ($spec =~ /^\d+$/)      { return 1 if $port == $spec }
+    }
+    return 0;
+}
+
+# The allowed set across every active zone, keyed by protocol.
+sub build_allowed {
+    my ($zones) = @_;
+    my %allowed;
+    for my $zone (@$zones) {
+        for my $spec (@{ $zone->{ports} // [] }, @{ $zone->{service_ports} // [] }) {
+            my ($range, $proto) = split m{/}, $spec, 2;
+            next unless defined $range && length $range;
+            $proto = 'tcp' unless defined $proto && length $proto;
+            push @{ $allowed{lc $proto} }, $range;
+        }
+    }
+    return \%allowed;
+}
+
+sub evaluate_firewall {
+    my ($fw) = @_;
+    my @checks;
+    my $listeners = $fw->{listeners};
+    my $known_listeners = defined $listeners ? 1 : 0;
+
+    # Exposure: behind a running firewalld a socket is exposed when a zone
+    # allows its port or a zone's target accepts everything; without a running
+    # firewall, every non-loopback socket is exposed.
+    my $any_accept = 0;
+    for my $zone (@{ $fw->{zones} // [] }) {
+        $any_accept = 1 if ($zone->{target} // '') eq 'accept';
+    }
+    my $allowed = build_allowed($fw->{zones} // []);
+    my @exposed;
+    my @filtered;
+    my @listening_ports;   # (proto, port) pairs, loopback included
+    if ($known_listeners) {
+        for my $l (@$listeners) {
+            push @listening_ports, "$l->{proto}:$l->{port}";
+            if ($l->{loopback}) {
+                $l->{exposed} = 0;
+                next;
+            }
+            my $is_allowed = port_allowed($allowed, $l->{proto}, $l->{port});
+            $l->{allowed} = $is_allowed;
+            if (!$fw->{active} || $is_allowed || $any_accept) {
+                $l->{exposed} = 1;
+                push @exposed, $l;
+            }
+            else {
+                $l->{exposed} = 0;
+                push @filtered, $l;
+            }
+        }
+    }
+
+    my $listener_line = sub {
+        my ($l) = @_;
+        my $label = $l->{loopback} ? 'local' : $l->{exposed} ? 'exposed' : 'filtered';
+        my $host = $l->{address} =~ /:/ ? "[$l->{address}]" : $l->{address};
+        my $proc = length $l->{process} ? " ($l->{process})" : '';
+        return "$l->{proto} $host:$l->{port} $label$proc";
+    };
+
+    if ($fw->{available} && $fw->{active}) {
+        push @checks, _check(
+            id => 'firewall.active', severity => 'pass', weight => 6,
+            title => 'Firewall active',
+            message => 'firewalld is running',
+        );
+    }
+    elsif ($fw->{available}) {
+        if ($known_listeners && @exposed) {
+            push @checks, _check(
+                id => 'firewall.active', severity => 'critical', weight => 6,
+                title => 'Firewall active',
+                message => 'firewalld is installed but not running, and '
+                    . scalar(@exposed) . ' socket(s) listen on public addresses',
+                detail => [map { $listener_line->($_) } @exposed],
+            );
+        }
+        elsif ($known_listeners) {
+            push @checks, _check(
+                id => 'firewall.active', severity => 'warn', weight => 6,
+                title => 'Firewall active',
+                message => 'firewalld is installed but not running; nothing listens on a public address',
+            );
+        }
+        else {
+            push @checks, _check(
+                id => 'firewall.active', severity => 'unknown', weight => 6,
+                title => 'Firewall active',
+                message => 'firewalld is not running and no listener inventory is available',
+            );
+        }
+    }
+    else {
+        if ($known_listeners && @exposed) {
+            push @checks, _check(
+                id => 'firewall.active', severity => 'critical', weight => 6,
+                title => 'Firewall active',
+                message => 'firewalld is not installed, and '
+                    . scalar(@exposed) . ' socket(s) listen on public addresses',
+                detail => [map { $listener_line->($_) } @exposed],
+            );
+        }
+        elsif ($known_listeners) {
+            push @checks, _check(
+                id => 'firewall.active', severity => 'warn', weight => 6,
+                title => 'Firewall active',
+                message => 'firewalld is not installed; nothing listens on a public address',
+            );
+        }
+        else {
+            push @checks, _check(
+                id => 'firewall.active', severity => 'unknown', weight => 6,
+                title => 'Firewall active',
+                message => 'no firewalld and no listener inventory is available',
+            );
+        }
+    }
+
+    # A zone whose target is ACCEPT allows every port, so the rules under it
+    # decide nothing: the exposure is the design of the zone.  No active zone at
+    # all while firewalld runs is its own answer: unzoned interfaces are not
+    # filtered by firewalld.
+    my @accept_zones = grep { ($_->{target} // '') eq 'accept' } @{ $fw->{zones} // [] };
+    if (!@{ $fw->{zones} // [] }) {
+        if ($fw->{active}) {
+            push @checks, _check(
+                id => 'firewall.zone_target', severity => 'unknown', weight => 4,
+                title => 'Zone targets',
+                message => 'firewalld is running but reports no active zone: '
+                    . 'unzoned interfaces are not filtered',
+            );
+        }
+    }
+    elsif (@accept_zones) {
+        push @checks, _check(
+            id => 'firewall.zone_target', severity => 'warn', weight => 4,
+            title => 'Zone targets',
+            message => 'zone target is ACCEPT, so every listening port is reachable: '
+                . join(', ', map { $_->{name} } @accept_zones),
+        );
+    }
+    else {
+        push @checks, _check(
+            id => 'firewall.zone_target', severity => 'pass', weight => 4,
+            title => 'Zone targets',
+            message => 'every active zone filters by default',
+        );
+    }
+
+    if ($known_listeners) {
+        push @checks, _check(
+            id => 'firewall.listeners', severity => 'info', weight => 0,
+            title => 'Listeners',
+            message => scalar(@$listeners) . ' listening socket(s): '
+                . scalar(@exposed) . ' exposed, '
+                . (scalar(@$listeners) - scalar(@exposed)) . ' local or filtered',
+            detail => [map { $listener_line->($_) } @$listeners],
+        );
+    }
+    else {
+        push @checks, _check(
+            id => 'firewall.listeners', severity => 'unknown', weight => 0,
+            title => 'Listeners',
+            message => 'no listener inventory: ss is not installed'
+                . (length $fw->{listeners_error} ? " ($fw->{listeners_error})" : ''),
+        );
+    }
+
+    # A port a zone allows with nothing behind it is surface in waiting.  A
+    # spec with not one listener anywhere in its span is the stale entry.
+    if ($fw->{active} && $known_listeners) {
+        my @stale;
+        for my $proto (sort keys %$allowed) {
+            for my $range (@{ $allowed->{$proto} }) {
+                my ($lo, $hi) = $range =~ /^(\d+)-(\d+)$/ ? ($1, $2) : ($range, $range);
+                next unless $lo =~ /^\d+$/ && $hi =~ /^\d+$/;
+                my $used = 0;
+                for my $key (@listening_ports) {
+                    my ($lproto, $lport) = split /:/, $key, 2;
+                    next unless $lproto eq $proto;
+                    if ($lport >= $lo && $lport <= $hi) { $used = 1; last }
+                }
+                push @stale, "$proto/$range" unless $used;
+            }
+        }
+        if (@stale) {
+            my @detail = sort @stale;
+            $#detail = 49 if $#detail > 49;
+            push @checks, _check(
+                id => 'firewall.allowed_no_listener', severity => 'warn', weight => 0,
+                title => 'Open without listener',
+                message => scalar(@stale) . ' allowed port(s) or range(s) with nothing listening',
+                detail => \@detail,
+            );
+        }
+        else {
+            push @checks, _check(
+                id => 'firewall.allowed_no_listener', severity => 'pass', weight => 0,
+                title => 'Open without listener',
+                message => 'every allowed port has a listener',
+            );
+        }
+    }
+
+    return @checks;
+}
+
+# ---------------------------------------------------------------------------
+# Section: SELinux
+# ---------------------------------------------------------------------------
+
+sub parse_selinux_config {
+    my ($text) = @_;
+    for my $line (split /\n/, $text) {
+        $line = _trim($line);
+        next unless length $line;
+        next if index($line, '#') == 0;
+        my ($key, $value) = split /=/, $line, 2;
+        next unless defined $key && defined $value;
+        return lc _trim($value) if _trim($key) eq 'SELINUX';
+    }
+    return '';
+}
+
+sub collect_selinux {
+    my %sel = (available => 0, runtime => '', configured => '');
+    my $out = _trim(run(['getenforce'], 5)->{out});
+    if (length $out) {
+        $sel{available} = 1;
+        $sel{runtime} = $out;
+    }
+    if (can_read_file('/etc/selinux/config')) {
+        $sel{configured} = parse_selinux_config(slurp('/etc/selinux/config'));
+    }
+    return \%sel;
+}
+
+sub evaluate_selinux {
+    my ($sel) = @_;
+    return () unless $sel->{available};
+    my @checks;
+    my $runtime = $sel->{runtime};
+
+    if ($runtime eq 'Enforcing') {
+        push @checks, _check(
+            id => 'selinux.runtime', severity => 'pass', weight => 6,
+            title => 'SELinux runtime', message => 'enforcing',
+        );
+    }
+    elsif ($runtime eq 'Permissive') {
+        push @checks, _check(
+            id => 'selinux.runtime', severity => 'warn', weight => 6,
+            title => 'SELinux runtime',
+            message => 'permissive: violations are logged, not blocked',
+        );
+    }
+    else {
+        push @checks, _check(
+            id => 'selinux.runtime', severity => 'critical', weight => 6,
+            title => 'SELinux runtime', message => 'disabled',
+        );
+    }
+
+    my $configured = $sel->{configured};
+    if (!length $configured) {
+        my $why = -e '/etc/selinux/config' ? 'is unreadable by this user' : 'does not exist';
+        push @checks, _check(
+            id => 'selinux.config', severity => 'unknown', weight => 2,
+            title => 'SELinux config',
+            message => "/etc/selinux/config $why",
+        );
+        return @checks;
+    }
+    my $runtime_lc = lc $runtime;
+    if ($configured eq $runtime_lc) {
+        push @checks, _check(
+            id => 'selinux.config', severity => 'pass', weight => 2,
+            title => 'SELinux config',
+            message => "the next boot keeps $configured",
+        );
+    }
+    elsif ($runtime_lc eq 'enforcing' && $configured ne 'enforcing') {
+        push @checks, _check(
+            id => 'selinux.config', severity => 'warn', weight => 2,
+            title => 'SELinux config',
+            message => "enforcing now, but /etc/selinux/config says $configured: the next boot downgrades",
+        );
+    }
+    elsif ($configured eq 'enforcing' && $runtime_lc eq 'permissive') {
+        push @checks, _check(
+            id => 'selinux.config', severity => 'info', weight => 2,
+            title => 'SELinux config',
+            message => 'permissive now; enforcing at the next boot',
+        );
+    }
+    else {
+        push @checks, _check(
+            id => 'selinux.config', severity => 'warn', weight => 2,
+            title => 'SELinux config',
+            message => "runtime $runtime_lc, configuration $configured",
+        );
+    }
+    return @checks;
+}
+
+# ---------------------------------------------------------------------------
+# Section: Updates
+# ---------------------------------------------------------------------------
+
+# An advisory line names an id, the word security, and a package; header and
+# progress lines do not.
+sub count_security_updates {
+    my ($out) = @_;
+    my $count = 0;
+    for my $line (split /\n/, $out) {
+        my @fields = split ' ', $line;
+        next unless @fields >= 3;
+        next unless $fields[0] =~ /[-:]/;
+        next unless $fields[1] =~ /^security(?:\/|$)/;
+        $count++;
+    }
+    return $count;
+}
+
+sub parse_automatic_conf {
+    my ($text) = @_;
+    for my $line (split /\n/, $text) {
+        $line = _trim($line);
+        next unless length $line;
+        next if index($line, '#') == 0;
+        next unless index($line, '=') >= 0;
+        my ($key, $value) = split /=/, $line, 2;
+        next unless _trim($key) eq 'apply_updates';
+        return lc _trim($value);
+    }
+    return '';
+}
+
+sub rpm_installed {
+    my ($name) = @_;
+    return run(['rpm', '-q', $name], 15)->{rc} == 0 ? 1 : 0;
+}
+
+# The first unit whose is-enabled answer names a real state.  "not-found" is
+# no answer, and "alias" reports the shape of the unit file rather than its
+# enablement: on a dnf5 host dnf-automatic.timer is an alias whose target,
+# dnf5-automatic.timer, carries the answer.
+sub pick_timer_unit {
+    my ($states) = @_;
+    for my $unit (qw(dnf5-automatic.timer dnf-automatic-install.timer dnf-automatic.timer)) {
+        my $state = $states->{$unit} // '';
+        return ($unit, $state) if grep { $state eq $_ }
+            qw(enabled enabled-runtime disabled static indirect);
+    }
+    return ('', '');
+}
+
+sub collect_updates {
+    my %up = (
+        security_pending => undef, pending_error => '',
+        timer => 'unknown', timer_name => '',
+        apply_updates => undef, apply_updates_defaulted => 0,
+        running_kernel => '', newest_kernel => '', reboot_required => undef,
+    );
+
+    if (defined find_exe('dnf')) {
+        my $p = run(['dnf', '-q', '--cacheonly', 'updateinfo', 'list', 'available', '--security'], 120);
+        if ($p->{rc} == 0) {
+            $up{security_pending} = count_security_updates($p->{out});
+        }
+        else {
+            my $err = _trim((split /\n/, $p->{err})[0] // '');
+            $up{pending_error} = length $err ? $err : 'dnf failed';
+        }
+    }
+
+    if (defined find_exe('systemctl')) {
+        my %states;
+        for my $unit ('dnf5-automatic.timer', 'dnf-automatic-install.timer', 'dnf-automatic.timer') {
+            my $p = run(['systemctl', 'is-enabled', $unit, '--no-pager'], 10);
+            # is-enabled answers "disabled" with exit status 1, so the word and
+            # not the status decides.
+            $states{$unit} = _trim($p->{out});
+        }
+        ($up{timer_name}, $up{timer}) = pick_timer_unit(\%states);
+        if (!length $up{timer_name}) {
+            $up{timer} = rpm_installed('dnf-automatic') || rpm_installed('dnf5-plugin-automatic')
+                ? 'disabled' : 'missing';
+        }
+    }
+
+    # dnf5 takes its defaults from /usr/share and applies the host overrides
+    # from /etc/dnf/automatic.conf on top; dnf4 ships /etc/dnf/automatic.conf
+    # with the key commented out.  An absent key therefore means the documented
+    # default: no, download only.
+    for my $conf ('/etc/dnf/automatic.conf', '/usr/share/dnf5/dnf5-plugins/automatic.conf') {
+        next unless can_read_file($conf);
+        my $value = parse_automatic_conf(slurp($conf));
+        $up{apply_updates} = length $value ? $value : 'no';
+        $up{apply_updates_defaulted} = length $value ? 0 : 1;
+        last;
+    }
+
+    my $running = _trim(run(['uname', '-r'], 5)->{out});
+    if (length $running && defined find_exe('rpm')) {
+        my $p = run(['rpm', '-q', '--qf', '%{VERSION}-%{RELEASE}\n', 'kernel'], 30);
+        if ($p->{rc} == 0) {
+            my @installed = grep { length } split /\n/, $p->{out};
+            my ($newest) = grep { rpmvercmp($_, $running) > 0 } @installed;
+            $up{running_kernel} = $running;
+            $up{reboot_required} = defined $newest ? 1 : 0;
+            if (defined $newest) {
+                for my $version (@installed) {
+                    $up{newest_kernel} = $version
+                        if rpmvercmp($version, $up{newest_kernel} || $version) >= 0;
+                }
+            }
+        }
+    }
+
+    return \%up;
+}
+
+sub evaluate_updates {
+    my ($up) = @_;
+    my @checks;
+
+    if (!defined $up->{security_pending}) {
+        push @checks, _check(
+            id => 'updates.security_pending', severity => 'unknown', weight => 6,
+            title => 'Security updates',
+            message => 'pending security updates could not be counted'
+                . (length $up->{pending_error} ? " ($up->{pending_error})" : '')
+                . ': the metadata must be in dnf\'s cache',
+        );
+    }
+    elsif ($up->{security_pending} == 0) {
+        push @checks, _check(
+            id => 'updates.security_pending', severity => 'pass', weight => 6,
+            title => 'Security updates',
+            message => 'none pending',
+        );
+    }
+    else {
+        push @checks, _check(
+            id => 'updates.security_pending', severity => 'warn', weight => 6,
+            title => 'Security updates',
+            message => "$up->{security_pending} pending",
+        );
+    }
+
+    my $timer = $up->{timer};
+    if ($timer eq 'unknown') {
+        push @checks, _check(
+            id => 'updates.automatic_timer', severity => 'unknown', weight => 4,
+            title => 'Automatic updates',
+            message => 'systemctl is not available',
+        );
+    }
+    elsif ($timer eq 'enabled' || $timer eq 'enabled-runtime') {
+        push @checks, _check(
+            id => 'updates.automatic_timer', severity => 'pass', weight => 4,
+            title => 'Automatic updates',
+            message => "$up->{timer_name} is $timer",
+        );
+    }
+    elsif ($timer eq 'missing') {
+        push @checks, _check(
+            id => 'updates.automatic_timer', severity => 'warn', weight => 4,
+            title => 'Automatic updates',
+            message => 'dnf-automatic is not installed: nothing applies updates unattended',
+        );
+    }
+    else {
+        push @checks, _check(
+            id => 'updates.automatic_timer', severity => 'warn', weight => 4,
+            title => 'Automatic updates',
+            message => $up->{timer_name} ? "$up->{timer_name} is $timer"
+                : $timer eq 'missing'
+                    ? 'dnf-automatic is not installed: nothing applies updates unattended'
+                    : 'no dnf-automatic timer is enabled',
+        );
+    }
+
+    my $apply = $up->{apply_updates};
+    if (!defined $apply) {
+        push @checks, _check(
+            id => 'updates.apply_updates', severity => 'unknown', weight => 2,
+            title => 'Apply updates',
+            message => 'no dnf-automatic configuration could be read',
+        );
+    }
+    elsif ($apply eq 'yes') {
+        push @checks, _check(
+            id => 'updates.apply_updates', severity => 'pass', weight => 2,
+            title => 'Apply updates',
+            message => 'apply_updates = yes',
+        );
+    }
+    else {
+        push @checks, _check(
+            id => 'updates.apply_updates', severity => 'warn', weight => 2,
+            title => 'Apply updates',
+            message => 'apply_updates = ' . $apply
+                . ($up->{apply_updates_defaulted} ? ' (the default)' : '')
+                . ': downloads without installing',
+        );
+    }
+
+    my $reboot = $up->{reboot_required};
+    if (!defined $reboot) {
+        push @checks, _check(
+            id => 'updates.reboot_required', severity => 'unknown', weight => 2,
+            title => 'Reboot required',
+            message => 'the installed kernels could not be compared with the running one',
+        );
+    }
+    elsif ($reboot) {
+        push @checks, _check(
+            id => 'updates.reboot_required', severity => 'warn', weight => 2,
+            title => 'Reboot required',
+            message => "running $up->{running_kernel}"
+                . (length $up->{newest_kernel} ? ", installed $up->{newest_kernel}" : '')
+                . ': the fixes are on disk, not in memory',
+        );
+    }
+    else {
+        push @checks, _check(
+            id => 'updates.reboot_required', severity => 'pass', weight => 2,
+            title => 'Reboot required',
+            message => "running kernel $up->{running_kernel} is the newest installed",
+        );
+    }
+
+    return @checks;
+}
+
+# ---------------------------------------------------------------------------
+# Section: Accounts
+# ---------------------------------------------------------------------------
+
+# A passwd line: name:passwd:uid:gid:gecos:home:shell.
+sub parse_passwd {
+    my ($lines) = @_;
+    my @users;
+    for my $line (@$lines) {
+        next unless length $line;
+        my @fields = split /:/, $line, 7;
+        next unless @fields == 7;
+        next unless $fields[2] =~ /^\d+$/;
+        push @users, {
+            name  => $fields[0],
+            uid   => $fields[2] + 0,
+            shell => $fields[6],
+        };
+    }
+    return \@users;
+}
+
+# A shadow line: name:hash:and the ageing fields.  The hash is the second field
+# only; an empty hash is an account that accepts no password and any password
+# at once, while a leading ! or a * locks the account.
+sub empty_password_users {
+    my ($lines) = @_;
+    my @names;
+    for my $line (@$lines) {
+        next unless length $line;
+        my @fields = split /:/, $line, 3;
+        next unless @fields >= 2;
+        push @names, $fields[0] if $fields[1] eq '';
+    }
+    return \@names;
+}
+
+# The principals a sudoers tree grants NOPASSWD to.  Comment lines are skipped,
+# which also skips the #includedir directive; the directory is read explicitly.
+sub parse_sudoers_text {
+    my ($text) = @_;
+    my @principals;
+    for my $line (split /\n/, $text) {
+        $line = _trim($line);
+        next unless length $line;
+        next if index($line, '#') == 0;
+        next unless $line =~ /NOPASSWD\s*:/;
+        my ($principal) = split ' ', $line, 2;
+        push @principals, $principal if length $principal;
+    }
+    return @principals;
+}
+
+sub collect_accounts {
+    my %acc = (
+        uid_zero => undef, empty_passwords => undef, nopasswd => undef,
+        human_users => [], root_authorized_keys => undef,
+    );
+
+    if (can_read_file('/etc/passwd')) {
+        my $users = parse_passwd(read_lines('/etc/passwd'));
+        my @root_like = map { $_->{name} } grep { $_->{uid} == 0 } @$users;
+        $acc{uid_zero} = \@root_like;
+        $acc{human_users} = [
+            map { "$_->{name} ($_->{uid})" }
+            grep { $_->{uid} >= 1000 && $_->{shell} !~ /(?:nologin|false)$/ }
+            @$users
+        ];
+    }
+
+    if (can_read_file('/etc/shadow')) {
+        $acc{empty_passwords} = empty_password_users(read_lines('/etc/shadow'));
+    }
+
+    if (can_read_file('/etc/sudoers')) {
+        my %principals;
+        for my $principal (parse_sudoers_text(slurp('/etc/sudoers'))) {
+            $principals{$principal} = 1;
+        }
+        if (opendir(my $dh, '/etc/sudoers.d')) {
+            for my $entry (sort grep { !/^[.]/ && -f "/etc/sudoers.d/$_" } readdir($dh)) {
+                for my $principal (parse_sudoers_text(slurp("/etc/sudoers.d/$entry"))) {
+                    $principals{$principal} = 1;
+                }
+            }
+            closedir($dh);
+        }
+        $acc{nopasswd} = [sort keys %principals];
+    }
+
+    if (can_read_file('/root/.ssh/authorized_keys')) {
+        my @keys = grep { length && index($_, '#') != 0 } @{ read_lines('/root/.ssh/authorized_keys') };
+        $acc{root_authorized_keys} = scalar @keys;
+    }
+
+    return \%acc;
+}
+
+sub evaluate_accounts {
+    my ($acc) = @_;
+    my @checks;
+
+    if (!defined $acc->{uid_zero}) {
+        push @checks, _check(
+            id => 'accounts.uid_zero', severity => 'unknown', weight => 4,
+            title => 'UID 0 accounts', message => '/etc/passwd is unreadable',
+        );
+    }
+    elsif (@{ $acc->{uid_zero} } > 1) {
+        push @checks, _check(
+            id => 'accounts.uid_zero', severity => 'critical', weight => 4,
+            title => 'UID 0 accounts',
+            message => 'more than one account holds UID 0: ' . join(', ', @{ $acc->{uid_zero} }),
+        );
+    }
+    else {
+        push @checks, _check(
+            id => 'accounts.uid_zero', severity => 'pass', weight => 4,
+            title => 'UID 0 accounts',
+            message => 'root is the only account with UID 0',
+        );
+    }
+
+    if (!defined $acc->{empty_passwords}) {
+        push @checks, _check(
+            id => 'accounts.empty_passwords', severity => 'unknown', weight => 4,
+            title => 'Empty passwords',
+            message => '/etc/shadow is readable by root only',
+        );
+    }
+    elsif (@{ $acc->{empty_passwords} }) {
+        push @checks, _check(
+            id => 'accounts.empty_passwords', severity => 'critical', weight => 4,
+            title => 'Empty passwords',
+            message => 'accounts with an empty password field: '
+                . join(', ', @{ $acc->{empty_passwords} }),
+        );
+    }
+    else {
+        push @checks, _check(
+            id => 'accounts.empty_passwords', severity => 'pass', weight => 4,
+            title => 'Empty passwords',
+            message => 'no account has an empty password field',
+        );
+    }
+
+    if (!defined $acc->{nopasswd}) {
+        push @checks, _check(
+            id => 'accounts.nopasswd_sudo', severity => 'unknown', weight => 2,
+            title => 'NOPASSWD sudo',
+            message => 'the sudoers files are readable by root only',
+        );
+    }
+    elsif (@{ $acc->{nopasswd} }) {
+        push @checks, _check(
+            id => 'accounts.nopasswd_sudo', severity => 'warn', weight => 2,
+            title => 'NOPASSWD sudo',
+            message => 'NOPASSWD granted to: ' . join(', ', @{ $acc->{nopasswd} }),
+        );
+    }
+    else {
+        push @checks, _check(
+            id => 'accounts.nopasswd_sudo', severity => 'pass', weight => 2,
+            title => 'NOPASSWD sudo',
+            message => 'every sudo grant asks for a password',
+        );
+    }
+
+    my $humans = $acc->{human_users} // [];
+    my @keys = ($acc->{root_authorized_keys});
+    my @parts;
+    push @parts, 'human users: ' . (@$humans ? join(', ', @$humans) : 'none');
+    push @parts, defined $keys[0] ? "$keys[0] root authorised key(s)"
+        : 'root authorised keys unreadable';
+    push @checks, _check(
+        id => 'accounts.human_users', severity => 'info', weight => 0,
+        title => 'Human users', message => join('; ', @parts),
+    );
+
+    return @checks;
+}
+
+# ---------------------------------------------------------------------------
+# Section: Services
+# ---------------------------------------------------------------------------
+
+# One line of `systemctl --failed --no-legend --plain`: the unit name, the
+# load state, the active state, the sub state and the description.  The state
+# the report names is the active one, which is the failed one here.
+sub parse_failed_units {
+    my ($out) = @_;
+    my @units;
+    for my $line (split /\n/, _trim($out)) {
+        next unless length $line;
+        my @fields = split ' ', $line, 5;
+        next if @fields < 3;
+        push @units, { unit => $fields[0], state => $fields[2] };
+    }
+    return \@units;
+}
+
+sub collect_services {
+    return undef unless defined find_exe('systemctl');
+    # --plain keeps the bullet prefix out of the field layout.
+    my $p = run(['systemctl', '--failed', '--no-legend', '--no-pager', '--plain'], 10);
+    return undef if $p->{rc} != 0 && !length _trim($p->{out});
+    return parse_failed_units($p->{out});
+}
+
+sub evaluate_services {
+    my ($units) = @_;
+    if (!defined $units) {
+        return _check(
+            id => 'services.failed_units', severity => 'unknown', weight => 4,
+            title => 'Failed units', message => 'systemctl is not available',
+        );
+    }
+    return _check(
+        id => 'services.failed_units', severity => 'pass', weight => 4,
+        title => 'Failed units', message => 'none',
+    ) unless @$units;
+    return _check(
+        id => 'services.failed_units', severity => 'warn', weight => 4,
+        title => 'Failed units',
+        message => scalar(@$units) . ' unit(s) in a failed state',
+        detail => [map { "$_->{unit} ($_->{state})" } @$units],
+    );
+}
+
+# ---------------------------------------------------------------------------
+# Section: Kernel hardening
+# ---------------------------------------------------------------------------
+
+# Each entry: the check id, the title, the sysctl path under /proc/sys, and the
+# verdict as a function of the value.
+my @SYSCTL_CHECKS = (
+    {
+        id    => 'kernel.kptr_restrict',
+        title => 'Kernel pointers',
+        path  => '/proc/sys/kernel/kptr_restrict',
+        ok    => sub { $_[0] >= 1 },
+        weak  => 'kernel pointers are visible to unprivileged users',
+    },
+    {
+        id    => 'kernel.dmesg_restrict',
+        title => 'dmesg restriction',
+        path  => '/proc/sys/kernel/dmesg_restrict',
+        ok    => sub { $_[0] >= 1 },
+        weak  => 'the kernel ring buffer is readable unprivileged',
+    },
+    {
+        id    => 'kernel.unprivileged_bpf_disabled',
+        title => 'Unprivileged BPF',
+        path  => '/proc/sys/kernel/unprivileged_bpf_disabled',
+        ok    => sub { $_[0] >= 1 },
+        weak  => 'unprivileged code may load BPF programs',
+    },
+    {
+        id    => 'kernel.yama_ptrace_scope',
+        title => 'ptrace scope',
+        path  => '/proc/sys/kernel/yama/ptrace_scope',
+        ok    => sub { $_[0] >= 1 },
+        weak  => 'any process may ptrace its peers',
+    },
+    {
+        id    => 'kernel.fs_protected',
+        title => 'Protected links',
+        path  => '/proc/sys/fs/protected_symlinks',
+        paths => [qw(
+            /proc/sys/fs/protected_symlinks
+            /proc/sys/fs/protected_hardlinks
+            /proc/sys/fs/protected_fifos
+            /proc/sys/fs/protected_regular
+        )],
+        ok    => sub { $_[0] >= 1 },
+        weak  => 'sticky directory races are not fully protected against',
+    },
+    {
+        id    => 'kernel.tcp_syncookies',
+        title => 'TCP syncookies',
+        path  => '/proc/sys/net/ipv4/tcp_syncookies',
+        ok    => sub { $_[0] == 1 },
+        weak  => 'syn flood protection is off',
+    },
+    {
+        id    => 'kernel.randomize_va_space',
+        title => 'Address space layout',
+        path  => '/proc/sys/kernel/randomize_va_space',
+        ok    => sub { $_[0] >= 2 },
+        weak  => 'address space randomisation is reduced',
+    },
+);
+
+sub collect_kernel {
+    my %values;
+    my %seen_path;
+    for my $entry (@SYSCTL_CHECKS) {
+        my @paths = $entry->{paths} ? @{ $entry->{paths} } : ($entry->{path});
+        for my $path (@paths) {
+            next if $seen_path{$path}++;
+            my $value = read_file($path);
+            $values{$path} = $value if length $value;
+        }
+    }
+    return \%values;
+}
+
+sub evaluate_kernel {
+    my ($values) = @_;
+    my @checks;
+    for my $entry (@SYSCTL_CHECKS) {
+        my @paths = $entry->{paths} ? @{ $entry->{paths} } : ($entry->{path});
+        my @readings;
+        for my $path (@paths) {
+            push @readings, $values->{$path} if exists $values->{$path};
+        }
+        if (!@readings) {
+            push @checks, _check(
+                id => $entry->{id}, severity => 'unknown', weight => 2,
+                title => $entry->{title},
+                message => 'the sysctl is not exposed by this kernel',
+            );
+            next;
+        }
+        my @bad = grep { $_ !~ /^\d+$/ || !$entry->{ok}->($_ + 0) } @readings;
+        if (@bad) {
+            push @checks, _check(
+                id => $entry->{id}, severity => 'warn', weight => 2,
+                title => $entry->{title},
+                message => join(', ', map { _trim($_) } @readings) . ": $entry->{weak}",
+            );
+        }
+        else {
+            push @checks, _check(
+                id => $entry->{id}, severity => 'pass', weight => 2,
+                title => $entry->{title},
+                message => join(', ', map { _trim($_) } @readings),
+            );
+        }
+    }
+    return @checks;
+}
+
+# ---------------------------------------------------------------------------
+# Section: File system scan, opt-in through --deep
+# ---------------------------------------------------------------------------
+
+# Directories anyone can write into, where a planted SUID binary waits for a
+# victim.  /dev is a separate mount, so -xdev leaves /dev/shm out already.
+my $STAGING_RE = qr{^/(?:tmp|var/tmp|home|root|srv)/};
+
+# A slot holds a list only when its scan completed: a find that failed or was
+# interrupted leaves undef behind, which evaluates to unknown rather than to a
+# clean pass.
+sub collect_files {
+    my %files = (
+        suid => undef, world_writable_files => undef,
+        world_writable_dirs => undef, unowned => undef,
+    );
+    return \%files unless defined find_exe('find');
+
+    my @scans = (
+        ['suid',                 ['/', '-xdev', '-type', 'f', '-perm', '-4000']],
+        ['world_writable_files', ['/', '-xdev', '-type', 'f', '-perm', '-0002']],
+        ['world_writable_dirs',  ['/', '-xdev', '-type', 'd', '-perm', '-0002', '!', '-perm', '-1000']],
+        ['unowned',              ['/', '-xdev', '(', '-nouser', '-o', '-nogroup', ')', '-print']],
+    );
+    for my $scan (@scans) {
+        my ($key, $args) = @$scan;
+        my $p = run(['find', @$args], 300);
+        next unless $p->{rc} == 0;
+        $files{$key} = [grep { length } split /\n/, _trim($p->{out})];
+    }
+    return \%files;
+}
+
+sub evaluate_files {
+    my ($files) = @_;
+    my @checks;
+    my $why = defined find_exe('find')
+        ? 'the scan did not complete' : 'find is not installed';
+
+    if (!defined $files->{suid}) {
+        push @checks, _check(
+            id => 'files.suid_staging', severity => 'unknown', weight => 4,
+            title => 'SUID staging', message => $why,
+        );
+    }
+    else {
+        my @staging = grep { $_ =~ $STAGING_RE } @{ $files->{suid} };
+        if (@staging) {
+            push @checks, _check(
+                id => 'files.suid_staging', severity => 'critical', weight => 4,
+                title => 'SUID staging',
+                message => 'SUID binaries under user writable or temporary directories',
+                detail => [map { "$_ (SUID)" } @{ $files->{suid} }],
+            );
+        }
+        else {
+            my @inventory = map { "$_ (SUID)" } @{ $files->{suid} };
+            $#inventory = 49 if $#inventory > 49;
+            push @checks, _check(
+                id => 'files.suid_staging', severity => 'pass', weight => 4,
+                title => 'SUID staging',
+                message => 'none of the ' . scalar(@{ $files->{suid} })
+                    . ' SUID binaries sits in a staging directory',
+                detail => \@inventory,
+            );
+        }
+    }
+
+    if (!defined $files->{world_writable_files} || !defined $files->{world_writable_dirs}) {
+        push @checks, _check(
+            id => 'files.world_writable', severity => 'unknown', weight => 4,
+            title => 'World writable', message => $why,
+        );
+    }
+    elsif (scalar @{ $files->{world_writable_files} } || scalar @{ $files->{world_writable_dirs} }) {
+        my @parts;
+        push @parts, scalar(@{ $files->{world_writable_files} }) . ' world writable file(s)'
+            if @{ $files->{world_writable_files} };
+        push @parts, scalar(@{ $files->{world_writable_dirs} })
+            . ' world writable directory(ies) without the sticky bit'
+            if @{ $files->{world_writable_dirs} };
+        push @checks, _check(
+            id => 'files.world_writable', severity => 'warn', weight => 4,
+            title => 'World writable',
+            message => join(', ', @parts),
+            detail => [
+                (map { "$_ (file)" } @{ $files->{world_writable_files} }),
+                (map { "$_ (directory)" } @{ $files->{world_writable_dirs} }),
+            ],
+        );
+    }
+    else {
+        push @checks, _check(
+            id => 'files.world_writable', severity => 'pass', weight => 4,
+            title => 'World writable',
+            message => 'no world writable files, no stickyless directories',
+        );
+    }
+
+    if (!defined $files->{unowned}) {
+        push @checks, _check(
+            id => 'files.unowned', severity => 'unknown', weight => 2,
+            title => 'Unowned files', message => $why,
+        );
+    }
+    elsif (@{ $files->{unowned} }) {
+        push @checks, _check(
+            id => 'files.unowned', severity => 'warn', weight => 2,
+            title => 'Unowned files',
+            message => scalar(@{ $files->{unowned} })
+                . ' file(s) with no owning user or group, the residue of a deleted account',
+            detail => [ @{ $files->{unowned} } ],
+        );
+    }
+    else {
+        push @checks, _check(
+            id => 'files.unowned', severity => 'pass', weight => 2,
+            title => 'Unowned files',
+            message => 'every file has an owning user and group',
+        );
+    }
+
+    return @checks;
+}
+
+# ---------------------------------------------------------------------------
+# Grade
+# ---------------------------------------------------------------------------
+
+# Every weighted check counts its weight in full on a pass, half on a warning
+# and nothing on a critical.  An unknown check leaves the pool, and the score is
+# renormalised against the weights that remain, so missing tooling never reads
+# as a security failure.  All weights are even, so half is a whole number.
+sub compute_grade {
+    my ($checks) = @_;
+    my ($earned, $possible) = (0, 0);
+    my (%breakdown, %maxima, %sections, %skipped);
+
+    for my $id (sort keys %$checks) {
+        my $check = $checks->{$id};
+        my $weight = $check->{weight} // 0;
+        next unless $weight > 0;
+        my $severity = $check->{severity};
+        if ($severity eq 'unknown') {
+            $skipped{$id} = 1;
+            next;
+        }
+        my $points = $severity eq 'pass' ? $weight
+                   : $severity eq 'warn' ? $weight / 2
+                   : 0;
+        $breakdown{$id} = $points;
+        $maxima{$id} = $weight;
+        my $section = $check->{section};
+        $sections{$section}{earned} += $points;
+        $sections{$section}{possible} += $weight;
+        $earned += $points;
+        $possible += $weight;
+    }
+
+    if ($possible <= 0) {
+        return {
+            score => undef, max_score => 100, grade => 'N/A',
+            breakdown => \%breakdown, maxima => \%maxima,
+            sections => \%sections, 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,
+        sections => \%sections, skipped => \%skipped,
+    };
+}
+
+sub findings_of {
+    my ($checks) = @_;
+    my @order = (critical => 0, warn => 1);
+    my %rank = @order;
+    my @findings = grep { $_->{severity} eq 'critical' || $_->{severity} eq 'warn' }
+        values %$checks;
+    return [
+        sort {
+            ($rank{ $a->{severity} } // 9) <=> ($rank{ $b->{severity} } // 9)
+                || $a->{id} cmp $b->{id}
+        } @findings
+    ];
+}
+
+# ---------------------------------------------------------------------------
+# Human-readable report
+# ---------------------------------------------------------------------------
+
+my %SEVERITY_MARKS = (
+    pass     => ['✓', $GREEN],
+    warn     => ['!', $YELLOW],
+    critical => ['✗', $RED],
+    unknown  => ['·', $DIM],
+    info     => ['·', $DIM],
+);
+
+sub section_header {
+    my ($title) = @_;
+    print "\n${BOLD}── $title ──$RESET\n";
+    return;
+}
+
+sub kv {
+    my ($label, $value) = @_;
+    printf "  %-22s %s\n", $label, $value;
+    return;
+}
+
+sub print_check {
+    my ($check) = @_;
+    my $mark = $SEVERITY_MARKS{ $check->{severity} } // ['·', ''];
+    my ($glyph, $colour) = @$mark;
+    printf "  %s%s%s %s%-24s%s %s\n",
+        $colour, $glyph, $RESET, $BOLD, $check->{title}, $RESET, $check->{message};
+    for my $line (@{ $check->{detail} // [] }) {
+        my $display = length($line) > 100 ? substr($line, 0, 100) . "…" : $line;
+        print "        ${DIM}$display$RESET\n";
+    }
+    return;
+}
+
+sub print_report {
+    my ($data, $strict) = @_;
+    my $grade = $data->{grade} // {};
+    my $letter = $grade->{grade} // '?';
+    my $grade_colour = $GRADE_COLOURS{$letter} // $RESET;
+    my $score_text = !defined $grade->{score} ? 'not assessed'
+        : '(' . $grade->{score} . '/' . $grade->{max_score} . ')';
+
+    my @present = grep { exists $data->{sections}{$_} } @ALL_SECTIONS;
+    my %position;
+    $position{ $present[$_] } = $_ for 0 .. $#present;
+
+    my $bar = '═' x $WIDTH;
+
+    print "\n";
+    print "${BOLD}$bar$RESET\n";
+    print "  ${BOLD}Security Audit  v$VERSION$RESET\n";
+    print "${BOLD}$bar$RESET\n";
+    kv('Hostname', $data->{hostname} // 'unknown');
+    my @now = localtime(time());
+    printf "  %-22s %04d-%02d-%02d %02d:%02d:%02d\n", 'Date',
+        $now[5] + 1900, $now[4] + 1, $now[3], $now[2], $now[1], $now[0];
+    kv('Mode', ($data->{root} ? 'root' : 'unprivileged')
+        . ($data->{deep} ? ', deep scan' : ''));
+    kv('Grade', "$grade_colour$BOLD$letter$RESET  $score_text");
+
+    for my $section (@present) {
+        section_header(($position{$section} + 1) . '. ' . ($SECTION_TITLES{$section} // $section));
+        my $section_data = $data->{sections}{$section};
+        if ($section eq 'ssh' && $section_data->{available}) {
+            kv('Source', $section_data->{source} eq 'effective'
+                ? 'sshd -T (the running daemon)'
+                : 'the configuration files (run as root for sshd -T)');
+        }
+        for my $check (@{ $data->{order} // [] }) {
+            next unless $check->{section} eq $section;
+            print_check($check);
+        }
+
+        my $agg = $grade->{sections}{$section};
+        if ($agg && $agg->{possible} > 0) {
+            my $cells = $agg->{earned};
+            my $row = ('█' x $cells) . ('░' x ($agg->{possible} - $cells));
+            printf "  ${DIM}%-22s %s %d/%d$RESET\n",
+                'section score', $row, $agg->{earned}, $agg->{possible};
+        }
+    }
+
+    my $findings = $data->{findings} // [];
+    section_header((scalar(@present) + 1) . '. Findings');
+    if (!@$findings) {
+        print "  ${GREEN}Nothing to act on; every check passed.$RESET\n";
+    }
+    for my $check (@$findings) {
+        my $is_critical = $check->{severity} eq 'critical';
+        printf "  %s%s%s %-9s %s: %s\n",
+            $is_critical ? $RED : $YELLOW, $is_critical ? '✗' : '!', $RESET,
+            uc($check->{severity}), $check->{id}, $check->{message};
+    }
+
+    section_header((scalar(@present) + 2) . '. Score');
+    my @skipped = sort keys %{ $grade->{skipped} // {} };
+    if (!defined $grade->{score}) {
+        print "  ${DIM}Nothing was assessable on this machine, so no score is given.$RESET\n";
+    }
+    else {
+        for my $section (@present) {
+            my $agg = $grade->{sections}{$section};
+            next unless $agg && $agg->{possible} > 0;
+            my $cells = $agg->{earned};
+            my $row = ('█' x $cells) . ('░' x ($agg->{possible} - $cells));
+            printf "  %-22s %s %d/%d\n",
+                ($SECTION_TITLES{$section} // $section), $row,
+                $agg->{earned}, $agg->{possible};
+        }
+    }
+    if (@skipped) {
+        print "  ${DIM}Not assessed (the source did not answer, the score renormalised):$RESET\n";
+        print "  ${DIM}" . join(', ', @skipped) . "$RESET\n";
+    }
+
+    my $criticals = scalar grep { $_->{severity} eq 'critical' } @$findings;
+    my $warnings = scalar @$findings - $criticals;
+    print "\n";
+    print "${BOLD}$bar$RESET\n";
+    if ($criticals) {
+        print "  ${BOLD}Result: ${RED}FAILED$RESET  ${BOLD}$criticals critical finding(s)"
+            . ($warnings ? ", $warnings warning(s)" : '') . "$RESET\n";
+    }
+    elsif ($warnings && $strict) {
+        print "  ${BOLD}Result: ${YELLOW}FAILED (strict)$RESET  ${BOLD}"
+            . "$warnings warning(s), and --strict fails on warnings$RESET\n";
+    }
+    else {
+        print "  ${BOLD}Result: ${GREEN}PASSED$RESET  ${BOLD}"
+            . ($warnings ? "$warnings warning(s)" : 'no findings')
+            . ($warnings ? ' (use --strict to fail on warnings)' : '') . "$RESET\n";
+    }
+    print "${BOLD}$bar$RESET\n";
+    print "\n";
+    return;
+}
+
+# ---------------------------------------------------------------------------
+# Collection
+# ---------------------------------------------------------------------------
+
+# The sections are read one after another: each is a handful of cheap commands,
+# and the only slow one, the deep file scan, is opt-in.
+sub collect_all {
+    my ($sections, $deep) = @_;
+    my %data = (
+        version   => $VERSION,
+        timestamp => timestamp_fields(time()),
+        hostname  => hostname_of(),
+        root      => is_root(),
+        deep      => $deep ? 1 : 0,
+        sections  => {},
+    );
+    my (@checks, @sections_order);
+
+    my %gather = (
+        ssh => sub {
+            my $data = collect_ssh();
+            return ($data, [evaluate_ssh($data)]);
+        },
+        firewall => sub {
+            my $data = collect_firewall();
+            return ($data, [evaluate_firewall($data)]);
+        },
+        selinux => sub {
+            my $data = collect_selinux();
+            return ($data, [evaluate_selinux($data)]);
+        },
+        updates => sub {
+            my $data = collect_updates();
+            return ($data, [evaluate_updates($data)]);
+        },
+        accounts => sub {
+            my $data = collect_accounts();
+            return ($data, [evaluate_accounts($data)]);
+        },
+        services => sub {
+            my $units = collect_services();
+            return ({ failed_units => $units }, [evaluate_services($units)]);
+        },
+        kernel => sub {
+            my $values = collect_kernel();
+            return ({ values => $values }, [evaluate_kernel($values)]);
+        },
+        files => sub {
+            my $files = collect_files();
+            return ({ scan => $files }, [evaluate_files($files)]);
+        },
+    );
+
+    for my $section (@$sections) {
+        _status('Auditing ' . ($SECTION_TITLES{$section} // $section));
+        my ($section_data, $checks) = $gather{$section}->();
+        for my $check (@$checks) {
+            $check->{section} = $section;
+            push @checks, $check;
+        }
+        if ($section eq 'services') {
+            $data{sections}{$section} = { failed_units => $section_data->{failed_units} };
+        }
+        elsif ($section eq 'kernel') {
+            $data{sections}{$section} = { values => $section_data->{values} };
+        }
+        else {
+            $data{sections}{$section} = $section_data;
+        }
+        push @sections_order, $section;
+        _status_done();
+    }
+
+    my %by_id = map { $_->{id} => $_ } @checks;
+    $data{sections} = { map { $_ => $data{sections}{$_} } @sections_order };
+    $data{order} = \@checks;
+    $data{checks} = \%by_id;
+    $data{grade} = compute_grade(\%by_id);
+    $data{findings} = findings_of(\%by_id);
+    return \%data;
+}
+
+# ---------------------------------------------------------------------------
+# Command line
+# ---------------------------------------------------------------------------
+
+# The section list to run: unknown names and files without --deep are usage
+# errors, and a repeated name runs once.
+sub resolve_sections {
+    my ($list, $deep) = @_;
+    if (length $list) {
+        my @requested = map { lc _trim($_) } split /,/, $list;
+        my @unknown = grep {
+            my $name = $_;
+            !grep { $_ eq $name } @ALL_SECTIONS;
+        } @requested;
+        return (undef, 'unknown section(s): ' . join(', ', @unknown)) if @unknown;
+        my %seen;
+        my @sections = grep { !$seen{$_}++ } @requested;
+        return (undef, 'section files requires --deep')
+            if !$deep && grep { $_ eq 'files' } @sections;
+        push @sections, 'files' if $deep && !grep { $_ eq 'files' } @sections;
+        return (\@sections, undef);
+    }
+    # The default run is the fast one: the deep scan joins only with --deep.
+    my @sections = grep { $_ ne 'files' } @ALL_SECTIONS;
+    push @sections, 'files' if $deep;
+    return (\@sections, undef);
+}
+
+sub usage {
+    my $name = $0;
+    $name =~ s{.*/}{};
+    return <<"USAGE";
+Usage: $name [options]
+
+Security audit: SSH, firewall, SELinux, updates, accounts, services, kernel
+hardening, and an opt-in file system scan, graded A to F
+
+Options:
+  --section LIST   Comma-separated sections to run. Available: @{[ join(', ', @ALL_SECTIONS) ]}  [default: all]
+  --deep           Also scan the file system: SUID binaries, world writable files
+                   and directories, unowned files. Covers the root file system only
+  --json           Output machine-readable JSON to stdout
+  --strict         Exit non-zero on warnings as well as on critical findings
+  --version        Show the version and exit
+  -h, --help       Show this help and exit
+
+Exit status: 0 with nothing to act on, 1 when a critical finding (or a warning
+under --strict) demands attention, 2 for a usage error.
+USAGE
+}
+
+sub parse_args {
+    my %opt = (section => '', deep => 0, json => 0, strict => 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 '--deep') { $opt{deep} = 1; next }
+        if ($arg eq '--json') { $opt{json} = 1; next }
+        if ($arg eq '--strict') { $opt{strict} = 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: security-audit.pl currently supports Linux only "
+            . "(detected platform: $^O).$RESET\n";
+        exit 1;
+    }
+
+    my ($sections_ref, $error) = resolve_sections($opt{section}, $opt{deep});
+    if (defined $error) {
+        # A usage error exits 2, as the usage text promises.
+        print STDERR "${RED}Error: $error$RESET\n";
+        print STDERR 'Available: ' . join(', ', @ALL_SECTIONS) . "\n"
+            if $error =~ /^unknown section/;
+        exit 2;
+    }
+    my @sections = @$sections_ref;
+
+    my $data = collect_all(\@sections, $opt{deep});
+
+    if ($opt{json}) {
+        # The report's order array and the checks hash are the same objects; the
+        # JSON carries the hash, whose keys are sorted by the encoder.
+        delete $data->{order};
+        print json_encode($data);
+    }
+    else {
+        print_report($data, $opt{strict});
+    }
+
+    my $findings = $data->{findings} // [];
+    my $criticals = scalar grep { $_->{severity} eq 'critical' } @$findings;
+    my $warnings = scalar grep { $_->{severity} eq 'warn' } @$findings;
+    return ($criticals || ($opt{strict} && $warnings)) ? 1 : 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;
diff --git a/server-setup.pl b/server-setup.pl
new file mode 100644
index 0000000..c27b22f
--- /dev/null
+++ b/server-setup.pl
@@ -0,0 +1,1861 @@
+#!/usr/bin/env perl
+# Copyright (c) 2026 Petr Balvín <opensource@petrbalvin.org> (https://petrbalvin.org)
+# SPDX-License-Identifier: MIT
+
+# Idempotent server setup for Fedora Server, CentOS Stream and openEuler.
+#
+# Covers the system update, base packages, the EPEL repository on CentOS, the
+# firewall, SELinux, Podman and automatic updates.  Every operation checks the
+# current state before acting, so running it again produces the same result with no
+# errors and no repeated work.
+#
+# Perl builtins only: no module has to be installed.  Two pieces of work Perl does
+# not carry as builtins are therefore written out here:
+#
+#   * the command runner, which forks and keeps stdout and stderr apart in the
+#     scratch directory, because the messages quote stderr while the parsers read
+#     stdout;
+#   * the atomic file replacement, which is rename(2) over a temporary file.  The
+#     durability barrier goes through sync(1), because builtins expose no fsync;
+#     the atomicity comes from the rename either way, so a crash mid-write cannot
+#     leave a boot-critical config truncated.
+#
+# External binaries used: dnf, rpm, systemctl, usermod, getenforce, setenforce,
+# firewall-offline-cmd, firewall-cmd, podman and sync.
+#
+# The firewall is configured through the offline client before the service is
+# enabled, and SSH is verified in the permanent configuration first, so a
+# misconfiguration can never lock a remote administrator out.
+#
+# Usage:
+#     server-setup.pl                       # full setup
+#     server-setup.pl --dry-run             # preview without changes
+#     server-setup.pl --skip-update         # skip system update
+#     server-setup.pl --skip-packages       # skip package installation
+#     server-setup.pl --skip-epel           # skip EPEL setup on CentOS
+#     server-setup.pl --skip-firewall       # skip firewall setup
+#     server-setup.pl --skip-selinux        # skip SELinux
+#     server-setup.pl --skip-podman         # skip Podman
+#     server-setup.pl --skip-auto-updates   # skip automatic updates
+#     server-setup.pl --version
+#
+# Exit status is 0 when every enabled section succeeds, 1 otherwise.
+
+use strict;
+use warnings;
+
+my $VERSION = '2.0.0';
+
+my $BOLD   = "\033[1m";
+my $RED    = "\033[31m";
+my $GREEN  = "\033[32m";
+my $YELLOW = "\033[33m";
+my $DIM    = "\033[2m";
+my $RESET  = "\033[0m";
+
+# Timeout in seconds for dnf operations: metadata downloads and package
+# transactions on a fresh or slow system routinely exceed the 60 s used for cheap
+# probes.
+my $DNF_TIMEOUT = 1800;
+
+# Supported systems, in the order the messages list them.
+my @SUPPORTED_ORDER = ('fedora', 'centos', 'openeuler');
+my %SUPPORTED_OS = (
+    fedora    => 'Fedora',
+    centos    => 'CentOS Stream',
+    openeuler => 'openEuler',
+);
+
+# Base packages installed on Fedora, CentOS Stream and openEuler alike.
+my @BASE_PACKAGES = qw(
+    nano curl wget htop tmux rsync nginx openssl jq fastfetch
+);
+
+# Services to open in firewalld by default.  ssh is mandatory: losing it means
+# locking out remote administration.
+my @FIREWALL_SERVICES = ('ssh');
+
+# Opened in firewalld only when nginx is installed, which it is by default.
+my @NGINX_FIREWALL_SERVICES = ('http', 'https');
+
+# dnf-automatic configuration file.  dnf 4 ships it with defaults; dnf 5 reads host
+# overrides from this path (its own defaults live in /usr/share/dnf5).
+my $DNF_AUTOMATIC_CONF = '/etc/dnf/automatic.conf';
+
+# Timer units to probe, in order of preference: dnf 4 ships the -install variant,
+# dnf 5 (Fedora 41 and newer) only the single dnf5-automatic.timer.
+my @AUTO_UPDATE_TIMER_CANDIDATES = (
+    'dnf-automatic-install.timer',
+    'dnf5-automatic.timer',
+    'dnf-automatic.timer',
+);
+
+# The optional clock, loaded once and guarded where it is used.
+my $HAVE_HIRES = eval { require Time::HiRes; 1 } ? 1 : 0;
+
+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 helpers, all 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;
+}
+
+sub _info {
+    my ($msg) = @_;
+    print STDERR "  ${DIM}$msg$RESET\n";
+    return;
+}
+
+sub _warn {
+    my ($msg) = @_;
+    print STDERR "  ${YELLOW}⚠ $msg$RESET\n";
+    return;
+}
+
+sub _ok {
+    my ($msg) = @_;
+    print STDERR "  ${GREEN}✓ $msg$RESET\n";
+    return;
+}
+
+sub _fail {
+    my ($msg) = @_;
+    print STDERR "  ${RED}✗ $msg$RESET\n";
+    return;
+}
+
+# ---------------------------------------------------------------------------
+# The clock, path lookup, scratch files and the command runner
+# ---------------------------------------------------------------------------
+
+sub now {
+    return $HAVE_HIRES ? Time::HiRes::time() : time();
+}
+
+# A hand-rolled which(1), so that the lookup itself needs no external binary.
+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;
+}
+
+# The same walk, but accepting a file that exists without being executable, so a
+# permission problem can be told from a missing binary.
+sub find_existing {
+    my ($name) = @_;
+    return undef unless defined $name && length $name;
+    if (index($name, '/') >= 0) {
+        return -f $name ? $name : undef;
+    }
+    for my $dir (split /:/, ($ENV{PATH} // '')) {
+        next unless length $dir;
+        my $path = "$dir/$name";
+        return $path if -f $path;
+    }
+    return undef;
+}
+
+# mkdir is atomic and refuses to follow a symlink, so a hostile entry in a shared
+# /tmp cannot redirect where the runner writes.
+sub scratch_dir {
+    return $TMP_DIR if defined $TMP_DIR;
+    my $base = $ENV{TMPDIR} // '/tmp';
+    for my $attempt (0 .. 9) {
+        my $dir = "$base/server-setup.$$" . ($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 runner forks, 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 : '';
+}
+
+# The wait status packs the exit code into bits 8-15 and the killing signal into
+# bits 0-6.  A child that died from a signal (the OOM killer sends SIGKILL)
+# leaves the exit code at 0, so the signal has to be folded in explicitly or a
+# killed command would be mistaken for a successful one.
+sub wait_status_rc {
+    my ($status) = @_;
+    my $signal = $status & 127;
+    return $signal ? 128 + $signal : $status >> 8;
+}
+
+# Run a command and return { rc, out, err }.
+#
+# The locale is forced to C so that tool output is parsed in English.  A missing
+# binary, an unexecutable one and an expired timeout are reported and returned as
+# rc 127, 126 and 124 instead of raising, so a caller always has a result to
+# inspect.  Nothing else is swallowed: the two streams are kept apart because the
+# messages quote stderr while the parsers read stdout.
+sub run {
+    my ($cmd, $timeout) = @_;
+    $timeout = 60 unless defined $timeout;
+
+    my $exe = find_exe($cmd->[0]);
+    if (!defined $exe) {
+        if (defined find_existing($cmd->[0])) {
+            _fail("Command failed: $cmd->[0]: not executable");
+            return { rc => 126, out => '', err => "$cmd->[0] is not executable" };
+        }
+        _fail("Command not found: $cmd->[0]");
+        return { rc => 127, out => '', err => "command not found: $cmd->[0]" };
+    }
+
+    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;   # reached only when the redirection or the exec failed
+    }
+
+    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;
+        _fail("Command timed out after ${timeout}s: " . join(' ', @$cmd));
+    }
+    else {
+        $rc = wait_status_rc($?);
+    }
+
+    my $out = slurp($out_file);
+    my $err = slurp($err_file);
+    unlink($out_file, $err_file);
+    return {
+        rc  => $rc,
+        out => $out,
+        err => $timed_out ? "timed out after ${timeout}s" : $err,
+    };
+}
+
+# ---------------------------------------------------------------------------
+# Files written atomically
+# ---------------------------------------------------------------------------
+
+# Durability barrier for a file that has been written and closed.  Builtins expose
+# no fsync, so sync(1) is the transport; where it is absent the write is still
+# atomic, only not durable against a power loss in the instant after the rename.
+sub fsync_path {
+    my ($path) = @_;
+    my $sync = find_exe('sync');
+    return unless defined $sync;
+    # The rc is deliberately not inspected: this is a barrier, not a check.
+    system { $sync } $sync, $path;
+    return;
+}
+
+# The errno, the reason and the path, so a failure message names all three rather
+# than only the reason.  $! must
+# be read straight after the failed operation, before anything else can change it.
+sub os_error_text {
+    my ($path) = @_;
+    return "[Errno " . (0 + $!) . "] $!: '$path'";
+}
+
+# Replace a file with new content, preserving its mode and owner.
+#
+# Boot-critical configuration, meaning SELinux, dnf-automatic and unit files, must
+# never be left truncated by a crash mid-write: the content goes into a temporary
+# file beside the target, which is then renamed over it.  The rename is the atomic
+# step, and it either happened or it did not.
+sub atomic_write {
+    my ($path, $content) = @_;
+    my ($mode, $uid, $gid) = (0644, 0, 0);
+    my @st = stat($path);
+    if (@st) {
+        $mode = $st[2] & 07777;
+        $uid  = $st[4];
+        $gid  = $st[5];
+    }
+    my $tmp = "$path.$$.tmp";
+    my $ok = eval {
+        open(my $fh, '>', $tmp) or die os_error_text($tmp) . "\n";
+        print {$fh} $content or die os_error_text($tmp) . "\n";
+        close($fh) or die os_error_text($tmp) . "\n";
+        fsync_path($tmp);
+        chmod($mode, $tmp) or die os_error_text($tmp) . "\n";
+        chown($uid, $gid, $tmp) or die os_error_text($tmp) . "\n";
+        rename($tmp, $path) or die "[Errno " . (0 + $!) . "] $!: '$tmp' -> '$path'\n";
+        # The replacement itself has to reach the disk too: the file content was
+        # synced above, but the directory entry that rename(2) rewrote needs the
+        # containing directory synced, or a power loss in the instant after
+        # could still revert the replacement.
+        (my $parent = $path) =~ s{/[^/]+$}{};
+        $parent = '/' unless length $parent;
+        fsync_path($parent);
+        1;
+    };
+    if (!$ok) {
+        my $error = $@ || 'unknown error';
+        unlink($tmp);
+        die $error;
+    }
+    return;
+}
+
+# ---------------------------------------------------------------------------
+# OS detection and the root check
+# ---------------------------------------------------------------------------
+
+sub parse_os_release {
+    my %release;
+    open(my $fh, '<', '/etc/os-release') or return \%release;
+    while (my $line = <$fh>) {
+        $line =~ s/^\s+//;
+        $line =~ s/\s+$//;
+        next unless length $line;
+        next if index($line, '#') == 0;
+        next unless index($line, '=') >= 0;
+        my ($key, $value) = split /=/, $line, 2;
+        $value = '' unless defined $value;
+        for my $quote ('"', "'") {
+            $value =~ s/^\Q$quote\E+//;
+            $value =~ s/\Q$quote\E+$//;
+        }
+        $release{$key} = $value;
+    }
+    close($fh);
+    return \%release;
+}
+
+sub detect_os {
+    my $release = parse_os_release();
+    my $os_id = lc($release->{ID} // '');
+    my $version_id = $release->{VERSION_ID} // 'unknown';
+
+    if (!exists $SUPPORTED_OS{$os_id}) {
+        print STDERR "${RED}${BOLD}Error:$RESET Unsupported operating system: "
+            . "'" . ($release->{ID} // 'unknown') . "' (detected from /etc/os-release).\n";
+        print STDERR "  Supported systems: "
+            . join(', ', map { $SUPPORTED_OS{$_} } @SUPPORTED_ORDER) . "\n";
+        exit 1;
+    }
+    return ($os_id, $SUPPORTED_OS{$os_id}, $version_id);
+}
+
+sub check_root {
+    return if $> == 0;
+    print STDERR "${RED}${BOLD}Error:$RESET This script must be run as root (UID 0).\n";
+    print STDERR "  Current UID: $>. Try: sudo perl server-setup.pl\n";
+    exit 1;
+}
+
+# ---------------------------------------------------------------------------
+# Section helpers
+# ---------------------------------------------------------------------------
+
+sub rpm_installed {
+    my ($pkg) = @_;
+    return run(['rpm', '-q', $pkg])->{rc} == 0;
+}
+
+sub dnf_install {
+    my ($packages) = @_;
+    return 1 unless @$packages;
+    return run(['dnf', 'install', '-y', @$packages], $DNF_TIMEOUT)->{rc} == 0;
+}
+
+# ---------------------------------------------------------------------------
+# 1. System update
+# ---------------------------------------------------------------------------
+
+sub system_update {
+    my ($dry_run) = @_;
+    my %info = (
+        updated         => 0,
+        skipped         => 0,
+        failed          => 0,
+        reboot_required => 0,
+    );
+
+    _status('Checking for system updates');
+    my $check = run(['dnf', 'check-update'], $DNF_TIMEOUT);
+    # dnf check-update: 0 means no updates, 100 means updates are available, and 1
+    # is an error.
+    if ($check->{rc} == 0) {
+        _status_done('already up to date');
+        $info{skipped} = 1;
+        return \%info;
+    }
+    if ($check->{rc} != 100) {
+        _status_done('check failed');
+        _fail('dnf check-update failed, cannot determine update state');
+        $info{failed} = 1;
+        return \%info;
+    }
+
+    _status_done('updates available');
+
+    if ($dry_run) {
+        _info('Would run: dnf update -y');
+        return \%info;
+    }
+
+    _status('Applying system updates');
+    my $update = run(['dnf', 'update', '-y'], $DNF_TIMEOUT);
+    if ($update->{rc} != 0) {
+        _status_done('failed');
+        _fail('System update returned non-zero exit code');
+        $info{failed} = 1;
+        return \%info;
+    }
+    _status_done();
+    $info{updated} = 1;
+
+    # dnf needs-restarting -r: rc 1 together with the message means a reboot is
+    # required.  The plugin (dnf-utils) may be absent, and anything unrecognised is
+    # treated as unknown rather than as a false positive.
+    my $reboot_check = run(['dnf', 'needs-restarting', '-r']);
+    if ($reboot_check->{rc} == 1 && index($reboot_check->{out}, 'Reboot is required') >= 0) {
+        $info{reboot_required} = 1;
+        _warn('Reboot required to fully apply updates');
+    }
+
+    return \%info;
+}
+
+sub ensure_epel {
+    my ($dry_run) = @_;
+    my %info = (
+        installed       => 0,
+        already_enabled => 0,
+        failed          => 0,
+    );
+
+    _status('Checking EPEL repository');
+
+    # Quick check: is epel-release installed and its repository enabled?
+    my $repo_check = run(['dnf', 'repolist', '--enabled'], 60);
+    if (index(lc($repo_check->{out}), 'epel') >= 0) {
+        _status_done('already enabled');
+        $info{already_enabled} = 1;
+        return \%info;
+    }
+
+    my $epel_installed = rpm_installed('epel-release');
+    _status_done($epel_installed ? 'package installed but repo disabled' : 'not installed');
+
+    if ($dry_run) {
+        _info('Would enable CRB repository');
+        _info($epel_installed ? 'Would enable EPEL repository' : 'Would install: epel-release');
+        $info{installed} = 1;
+        return \%info;
+    }
+
+    # Enable CodeReady Linux Builder (CRB), because some EPEL packages depend on it.
+    # The repository ships with CentOS but is disabled by default.  Non-fatal when
+    # it is already enabled or unavailable here.
+    _status('Enabling CRB repository');
+    my $crb = run(['dnf', 'config-manager', '--set-enabled', 'crb'], 60);
+    if ($crb->{rc} == 0) {
+        _status_done();
+    }
+    else {
+        _status_done('not available (non-fatal)');
+    }
+
+    if ($epel_installed) {
+        # The package is present while its repository is switched off: installing
+        # it again would be a successful no-op, so the repository itself is
+        # enabled instead.
+        _status('Enabling EPEL repository');
+        if (run(['dnf', 'config-manager', '--set-enabled', 'epel'], 60)->{rc} != 0) {
+            _status_done('failed');
+            _fail('Failed to enable the EPEL repository');
+            $info{failed} = 1;
+            return \%info;
+        }
+        _status_done();
+    }
+    else {
+        _status('Installing epel-release');
+        if (!dnf_install(['epel-release'])) {
+            _status_done('failed');
+            _fail('Failed to install epel-release');
+            $info{failed} = 1;
+            return \%info;
+        }
+        _status_done();
+    }
+
+    # The verdict comes from the enabled repositories themselves, so a silent
+    # no-op cannot be reported as success.
+    my $verify = run(['dnf', 'repolist', '--enabled'], 60);
+    if (index(lc($verify->{out}), 'epel') < 0) {
+        _fail('EPEL repository is still not enabled');
+        $info{failed} = 1;
+        return \%info;
+    }
+    _ok('EPEL repository enabled');
+    $info{installed} = 1;
+
+    return \%info;
+}
+
+# ---------------------------------------------------------------------------
+# 2. Base packages
+# ---------------------------------------------------------------------------
+
+sub install_packages {
+    my ($dry_run) = @_;
+    my (@installed, @skipped, @failed, @to_install);
+
+    _status('Checking base packages');
+    for my $pkg (@BASE_PACKAGES) {
+        if (rpm_installed($pkg)) { push @skipped, $pkg }
+        else                     { push @to_install, $pkg }
+    }
+
+    my $already = scalar @skipped;
+    my $missing = scalar @to_install;
+    my $total = scalar @BASE_PACKAGES;
+    _status_done("$already/$total already installed");
+
+    if (!@to_install) {
+        _ok('All base packages already present');
+        return { installed => \@installed, skipped => \@skipped, failed => \@failed };
+    }
+
+    _info('Installing ' . $missing . ' package(s): ' . join(' ', @to_install));
+
+    if ($dry_run) {
+        for my $pkg (@to_install) {
+            _info("  Would install: $pkg");
+            push @installed, $pkg;
+        }
+        return { installed => \@installed, skipped => \@skipped, failed => \@failed };
+    }
+
+    # One transaction first, which is faster and atomic.  When it fails, for
+    # instance because one package is unavailable on this distribution, the rest
+    # are installed one by one so that they still succeed.
+    _status("Installing $missing package(s) in one transaction");
+    if (dnf_install(\@to_install)) {
+        _status_done();
+        push @installed, @to_install;
+        return { installed => \@installed, skipped => \@skipped, failed => \@failed };
+    }
+
+    _status_done('transaction failed, falling back to per-package');
+    for my $pkg (@to_install) {
+        _status("Installing $pkg");
+        if (dnf_install([$pkg])) {
+            _status_done();
+            push @installed, $pkg;
+        }
+        else {
+            _status_done('failed');
+            _fail("Failed to install $pkg");
+            push @failed, $pkg;
+        }
+    }
+
+    return { installed => \@installed, skipped => \@skipped, failed => \@failed };
+}
+
+# ---------------------------------------------------------------------------
+# 3. Firewall
+# ---------------------------------------------------------------------------
+
+sub setup_firewall {
+    my ($dry_run) = @_;
+    my %info = (
+        installed        => 0,
+        enabled          => 0,
+        zone_set         => 0,
+        services_added   => [],
+        services_skipped => [],
+        failed           => 0,
+    );
+
+    # --- Install firewalld when it is missing ---
+    _status('Checking firewalld');
+    my $firewalld_present = rpm_installed('firewalld');
+    if (!$firewalld_present) {
+        _status_done('not installed');
+        if ($dry_run) {
+            _info('Would install: firewalld');
+            $info{installed} = 1;
+        }
+        else {
+            if (dnf_install(['firewalld'])) {
+                _ok('Installed firewalld');
+                $info{installed} = 1;
+                $firewalld_present = 1;
+            }
+            else {
+                _fail('Failed to install firewalld');
+                $info{failed} = 1;
+                return \%info;
+            }
+        }
+    }
+    else {
+        _status_done('installed');
+        $info{installed} = 1;
+    }
+
+    # ssh is mandatory; http and https only when nginx is present.
+    my @services = @FIREWALL_SERVICES;
+    push @services, @NGINX_FIREWALL_SERVICES if rpm_installed('nginx');
+
+    # --- Permanent rules first, through the offline client, which needs no daemon
+    my $permanent_changed = 0;
+    for my $service (@services) {
+        _status("Checking firewall service '$service'");
+        if (!$firewalld_present) {
+            # A dry run on a host without firewalld has nothing to query yet.
+            _status_done('would add');
+            push @{ $info{services_added} }, $service;
+            $permanent_changed = 1;
+            next;
+        }
+        my $query = run(['firewall-offline-cmd', '--zone=public', "--query-service=$service"]);
+        if ($query->{rc} == 0) {
+            _status_done('already present');
+            push @{ $info{services_skipped} }, $service;
+            next;
+        }
+        if ($dry_run) {
+            _status_done('would add');
+            push @{ $info{services_added} }, $service;
+            $permanent_changed = 1;
+            next;
+        }
+        my $add = run(['firewall-offline-cmd', '--zone=public', "--add-service=$service"]);
+        if ($add->{rc} != 0) {
+            _status_done('failed');
+            _fail("Failed to add service '$service' to zone 'public'");
+            $info{failed} = 1;
+            if ($service eq 'ssh') {
+                _warn('Aborting before firewalld is enabled to prevent lockout');
+                return \%info;
+            }
+            next;
+        }
+        _status_done('added');
+        push @{ $info{services_added} }, $service;
+        $permanent_changed = 1;
+    }
+
+    # --- Default zone before the service starts: this is the zone the daemon
+    # filters with the moment it comes up.  It is set through the offline client,
+    # while firewalld is still stopped, so the lockout gate below verifies the state
+    # that will actually apply to traffic.
+    _status('Checking default zone');
+    my $zone_result = run(['firewall-offline-cmd', '--get-default-zone']);
+    my $current_zone = $zone_result->{out};
+    $current_zone =~ s/^\s+//;
+    $current_zone =~ s/\s+$//;
+    if ($current_zone ne 'public') {
+        if ($dry_run) {
+            my $shown = length $current_zone ? $current_zone : '?';
+            _status_done("would change from '$shown' to 'public'");
+            $info{zone_set} = 1;
+        }
+        else {
+            my $set_zone = run(['firewall-offline-cmd', '--set-default-zone=public']);
+            if ($set_zone->{rc} != 0) {
+                _status_done('failed');
+                _fail("Failed to set the default zone to 'public'");
+                _warn('Aborting firewall setup BEFORE enabling firewalld');
+                $info{failed} = 1;
+                return \%info;
+            }
+            _status_done("changed to 'public' (was '$current_zone')");
+            $info{zone_set} = 1;
+        }
+    }
+    else {
+        _status_done("already 'public'");
+    }
+
+    # --- Lockout gate: never enable firewalld without confirmed SSH access ---
+    if (!$dry_run) {
+        my $verify = run(['firewall-offline-cmd', '--zone=public', '--query-service=ssh']);
+        if ($verify->{rc} != 0) {
+            _fail("Cannot confirm that SSH is allowed in zone 'public'");
+            _warn('Aborting firewall setup BEFORE enabling firewalld, '
+                . 'remote access would be at risk');
+            $info{failed} = 1;
+            return \%info;
+        }
+    }
+
+    # --- Enable and start, reached only with SSH confirmed ---
+    my $was_active = run(['systemctl', 'is-active', 'firewalld.service'])->{rc} == 0;
+
+    _status('Enabling firewalld service');
+    my $enabled = run(['systemctl', 'is-enabled', 'firewalld.service']);
+    if ($enabled->{rc} != 0) {
+        if ($dry_run) {
+            _status_done('would enable');
+            $info{enabled} = 1;
+        }
+        else {
+            my $enable = run(['systemctl', 'enable', 'firewalld.service']);
+            if ($enable->{rc} != 0) {
+                _status_done('failed');
+                _fail('Failed to enable firewalld.service');
+                $info{failed} = 1;
+                return \%info;
+            }
+            _status_done('enabled');
+            $info{enabled} = 1;
+        }
+    }
+    else {
+        _status_done('already enabled');
+        $info{enabled} = 1;
+    }
+
+    _status('Starting firewalld service');
+    if (!$was_active) {
+        if ($dry_run) {
+            _status_done('would start');
+        }
+        else {
+            my $start = run(['systemctl', 'start', 'firewalld.service']);
+            if ($start->{rc} != 0) {
+                _status_done('failed');
+                _fail('Failed to start firewalld.service');
+                $info{failed} = 1;
+                return \%info;
+            }
+            _status_done('started');
+        }
+    }
+    else {
+        _status_done('already running');
+    }
+
+    # --- Runtime default zone: a daemon already running under another zone keeps it
+    # until it is switched at runtime. ---
+    if ($was_active && !$dry_run) {
+        my $runtime_zone = run(['firewall-cmd', '--get-default-zone']);
+        my $runtime_name = $runtime_zone->{out};
+        $runtime_name =~ s/^\s+//;
+        $runtime_name =~ s/\s+$//;
+        if ($runtime_zone->{rc} != 0) {
+            my $err = $runtime_zone->{err};
+            $err =~ s/^\s+//;
+            $err =~ s/\s+$//;
+            _warn("Cannot read the runtime default zone: $err");
+        }
+        elsif ($runtime_name ne 'public') {
+            _status("Switching runtime default zone to 'public'");
+            my $set_runtime = run(['firewall-cmd', '--set-default-zone=public']);
+            if ($set_runtime->{rc} != 0) {
+                _status_done('failed');
+                _fail("Failed to switch the runtime default zone to 'public'");
+                $info{failed} = 1;
+                return \%info;
+            }
+            _status_done("switched to 'public' (was '$runtime_name')");
+            $info{zone_set} = 1;
+        }
+    }
+
+    # --- Reload only when a running daemon has drifted from the permanent config ---
+    if ($permanent_changed && $was_active) {
+        if ($dry_run) {
+            _info('Would run: firewall-cmd --reload');
+        }
+        else {
+            _status('Reloading firewall');
+            my $reload = run(['firewall-cmd', '--reload']);
+            if ($reload->{rc} != 0) {
+                _status_done('failed');
+                _fail('Failed to reload firewalld');
+                $info{failed} = 1;
+                return \%info;
+            }
+            _status_done();
+        }
+    }
+
+    return \%info;
+}
+
+# ---------------------------------------------------------------------------
+# 4. SELinux
+# ---------------------------------------------------------------------------
+
+sub setup_selinux {
+    my ($dry_run) = @_;
+    my %info = (
+        mode_changed    => 0,
+        config_changed  => 0,
+        utils_installed => 0,
+        current_mode    => 'unknown',
+        reboot_required => 0,
+        failed          => 0,
+    );
+
+    # --- Current mode ---
+    _status('Checking SELinux mode');
+    my $mode_result = run(['getenforce']);
+    if ($mode_result->{rc} != 0) {
+        _status_done('failed');
+        _fail('Cannot determine SELinux mode (getenforce failed or is missing)');
+        _info('On systems without SELinux, re-run with --skip-selinux');
+        $info{failed} = 1;
+        return \%info;
+    }
+    my $current_mode = $mode_result->{out};
+    $current_mode =~ s/^\s+//;
+    $current_mode =~ s/\s+$//;
+    $info{current_mode} = $current_mode;
+    _status_done($current_mode);
+
+    if ($current_mode eq 'Permissive') {
+        if ($dry_run) {
+            _info('Would set SELinux to enforcing mode');
+            $info{mode_changed} = 1;
+        }
+        else {
+            _status('Setting SELinux to enforcing');
+            my $enforce = run(['setenforce', '1']);
+            if ($enforce->{rc} != 0) {
+                _status_done('failed');
+                _fail('setenforce 1 failed');
+                $info{failed} = 1;
+            }
+            else {
+                _status_done();
+                $info{mode_changed} = 1;
+            }
+        }
+    }
+    elsif ($current_mode eq 'Disabled') {
+        # setenforce cannot work here, so the configuration and the relabel below
+        # carry the change instead.
+        $info{reboot_required} = 1;
+    }
+
+    # --- Ensure SELINUX=enforcing in the configuration ---
+    _status('Checking /etc/selinux/config');
+    my $config_changed = 0;
+    my $config_content;
+    my $config_read = open(my $config_fh, '<', '/etc/selinux/config');
+    my $config_error = $config_read ? '' : os_error_text('/etc/selinux/config');
+    if ($config_read) {
+        $config_content = do { local $/ = undef; <$config_fh> };
+        close($config_fh);
+    }
+    if (!$config_read || !defined $config_content) {
+        _status_done('error');
+        _fail("Cannot read/write /etc/selinux/config: $config_error");
+        $info{failed} = 1;
+    }
+    else {
+        my @lines = split /\n/, $config_content, -1;
+        pop @lines if @lines && $lines[-1] eq '';   # a trailing newline is not a line
+        my $has_enforcing = 0;
+        for my $line (@lines) {
+            my $stripped = $line;
+            $stripped =~ s/^\s+//;
+            $stripped =~ s/\s+$//;
+            if (index($stripped, 'SELINUX=') == 0 && index($stripped, '#') != 0) {
+                my (undef, $value) = split /=/, $stripped, 2;
+                $value = '' unless defined $value;
+                $value =~ s/^\s+//;
+                $value =~ s/\s+$//;
+                $has_enforcing = 1 if lc($value) eq 'enforcing';
+                last;
+            }
+        }
+
+        if (!$has_enforcing) {
+            if ($dry_run) {
+                _status_done('would update to SELINUX=enforcing');
+            }
+            else {
+                my @new_lines;
+                my $found = 0;
+                for my $line (@lines) {
+                    my $stripped = $line;
+                    $stripped =~ s/^\s+//;
+                    $stripped =~ s/\s+$//;
+                    if (index($stripped, 'SELINUX=') == 0 && index($stripped, '#') != 0) {
+                        push @new_lines, 'SELINUX=enforcing';
+                        $found = 1;
+                    }
+                    else {
+                        push @new_lines, $line;
+                    }
+                }
+                push @new_lines, 'SELINUX=enforcing' unless $found;
+                my $ok = eval { atomic_write('/etc/selinux/config', join("\n", @new_lines) . "\n"); 1 };
+                if ($ok) {
+                    _status_done('updated to enforcing');
+                }
+                else {
+                    my $error = $@ || 'unknown error';
+                    $error =~ s/\s+\z//;
+                    _status_done('error');
+                    _fail("Cannot read/write /etc/selinux/config: $error");
+                    $info{failed} = 1;
+                }
+            }
+            $config_changed = 1;
+        }
+        else {
+            _status_done('already enforcing');
+        }
+    }
+
+    $info{config_changed} = $config_changed;
+
+    # --- Disabled to enforcing needs a reboot with a filesystem relabel ---
+    if ($current_mode eq 'Disabled') {
+        if ($dry_run) {
+            _info('Would create /.autorelabel (relabel on next boot)');
+        }
+        else {
+            _status('Scheduling filesystem relabel on next boot');
+            my $ok = eval {
+                if (!-e '/.autorelabel') {
+                    open(my $fh, '>', '/.autorelabel') or die os_error_text('/.autorelabel') . "\n";
+                    close($fh);
+                }
+                1;
+            };
+            if ($ok) {
+                _status_done('/.autorelabel created');
+            }
+            else {
+                my $error = $@ || 'unknown error';
+                $error =~ s/\s+\z//;
+                _status_done('failed');
+                _fail("Cannot create /.autorelabel: $error");
+                $info{failed} = 1;
+            }
+        }
+        _warn('SELinux is Disabled, enforcing mode requires a REBOOT; '
+            . 'the filesystem will be relabelled on next boot');
+    }
+
+    # --- Install policycoreutils-python-utils ---
+    _status('Checking policycoreutils-python-utils');
+    if (!rpm_installed('policycoreutils-python-utils')) {
+        _status_done('not installed');
+        if ($dry_run) {
+            _info('Would install: policycoreutils-python-utils');
+            $info{utils_installed} = 1;
+        }
+        else {
+            if (dnf_install(['policycoreutils-python-utils'])) {
+                _ok('Installed policycoreutils-python-utils');
+                $info{utils_installed} = 1;
+            }
+            else {
+                _fail('Failed to install policycoreutils-python-utils');
+                $info{failed} = 1;
+            }
+        }
+    }
+    else {
+        _status_done('already installed');
+    }
+
+    return \%info;
+}
+
+# ---------------------------------------------------------------------------
+# 5. Podman
+# ---------------------------------------------------------------------------
+
+sub subid_entry_exists {
+    my ($path, $user) = @_;
+    open(my $fh, '<', $path) or return 0;
+    while (my $line = <$fh>) {
+        my ($name) = split /:/, $line, 2;
+        if (defined $name && $name eq $user) {
+            close($fh);
+            return 1;
+        }
+    }
+    close($fh);
+    return 0;
+}
+
+sub ensure_rootless_subids {
+    my ($dry_run) = @_;
+    my $user = $ENV{SUDO_USER} // '';
+    if (!length $user || $user eq 'root') {
+        _info('No non-root invoking user, skipping rootless subuid/subgid setup');
+        return;
+    }
+    my $uid = getpwnam($user);
+    if (!defined $uid) {
+        _warn("Cannot look up user '$user', skipping subuid/subgid setup");
+        return;
+    }
+
+    # The range is derived from the user's UID so that a re-run is stable, and an
+    # existing entry is never modified.
+    my $offset = $uid - 1000;
+    $offset = 0 if $offset < 0;
+    my $start = 100000 + $offset * 65536;
+    my $id_range = "$start-" . ($start + 65535);
+
+    for my $item (['/etc/subuid', '--add-subuids'], ['/etc/subgid', '--add-subgids']) {
+        my ($path, $flag) = @$item;
+        if (subid_entry_exists($path, $user)) {
+            _info("$path: entry for '$user' already present");
+            next;
+        }
+        if ($dry_run) {
+            _info("Would run: usermod $flag $id_range $user");
+            next;
+        }
+        _status("Allocating subordinate IDs for '$user' in $path");
+        my $result = run(['usermod', $flag, $id_range, $user]);
+        if ($result->{rc} == 0) {
+            _status_done($id_range);
+        }
+        else {
+            _status_done('failed');
+            _warn("usermod $flag failed, rootless Podman may not work for '$user'");
+        }
+    }
+    return;
+}
+
+sub setup_podman {
+    my ($dry_run) = @_;
+    my %info = (installed => 0, version => '', failed => 0);
+
+    _status('Checking Podman');
+    my $already = rpm_installed('podman');
+
+    if ($already) {
+        # Verify that it actually works.
+        my $ver = run(['podman', '--version']);
+        if ($ver->{rc} == 0) {
+            my $version = $ver->{out};
+            $version =~ s/^\s+//;
+            $version =~ s/\s+$//;
+            $info{version} = $version;
+            _status_done($info{version});
+        }
+        else {
+            _status_done('installed but not working');
+            _warn("podman package is installed but 'podman --version' failed");
+        }
+        $info{installed} = 1;
+        ensure_rootless_subids($dry_run);
+        return \%info;
+    }
+
+    _status_done('not installed');
+
+    if ($dry_run) {
+        _info('Would install: podman');
+        ensure_rootless_subids($dry_run);
+        return \%info;
+    }
+
+    _status('Installing Podman');
+    if (dnf_install(['podman'])) {
+        my $ver = run(['podman', '--version']);
+        my $version = $ver->{out};
+        $version =~ s/^\s+//;
+        $version =~ s/\s+$//;
+        $info{version} = $version;
+        _status_done($info{version});
+        $info{installed} = 1;
+    }
+    else {
+        _status_done('failed');
+        _fail('Failed to install Podman');
+        $info{failed} = 1;
+        return \%info;
+    }
+
+    ensure_rootless_subids($dry_run);
+    return \%info;
+}
+
+# ---------------------------------------------------------------------------
+# 6. Automatic updates
+# ---------------------------------------------------------------------------
+
+# Apply the desired keys to the [commands] section of automatic.conf lines.
+#
+# Returns the new lines and whether anything changed.  An existing key is rewritten
+# only when its value differs; a missing key is appended at the end of the
+# [commands] section; a missing [commands] section is created.  Keys in other
+# sections and comment lines are left untouched.  The keys are applied in the
+# order given.
+sub render_dnf_automatic_conf {
+    my ($lines, $desired_order, $desired) = @_;
+
+    # A hand-edited config can lack the final newline, so it is normalised first:
+    # an appended key must never glue onto an unterminated last line.
+    my @lines = map { /\n\z/ ? $_ : "$_\n" } @$lines;
+    my @new_lines;
+    my %seen;
+    my ($in_commands, $found_commands, $changed) = (0, 0, 0);
+
+    # A key with no value in the desired set is not written at all: an empty
+    # assignment would be a configuration line that means nothing.
+    my $flush_missing = sub {
+        for my $key (@$desired_order) {
+            next if $seen{$key};
+            next unless defined $desired->{$key};
+            push @new_lines, "$key = $desired->{$key}\n";
+            $changed = 1;
+        }
+    };
+
+    for my $line (@lines) {
+        my $stripped = $line;
+        $stripped =~ s/^\s+//;
+        $stripped =~ s/\s+$//;
+        if ($stripped =~ /^\[.*\]$/) {
+            if ($in_commands) {
+                $flush_missing->();
+                %seen = ();
+            }
+            $in_commands = lc($stripped) eq '[commands]' ? 1 : 0;
+            $found_commands = 1 if $in_commands;
+            push @new_lines, $line;
+            next;
+        }
+        if ($in_commands && index($stripped, '=') >= 0 && index($stripped, '#') != 0) {
+            my ($key, $raw_value) = split /=/, $stripped, 2;
+            $key =~ s/^\s+//;
+            $key =~ s/\s+$//;
+            if (exists $desired->{$key}) {
+                $seen{$key} = 1;
+                $raw_value = '' unless defined $raw_value;
+                $raw_value =~ s/^\s+//;
+                $raw_value =~ s/\s+$//;
+                if (lc($raw_value) ne lc($desired->{$key})) {
+                    push @new_lines, "$key = $desired->{$key}\n";
+                    $changed = 1;
+                    next;
+                }
+            }
+        }
+        push @new_lines, $line;
+    }
+
+    $flush_missing->() if $in_commands;
+    if (!$found_commands) {
+        push @new_lines, "\n" if @new_lines && $new_lines[-1] =~ /\S/;
+        push @new_lines, "[commands]\n";
+        $flush_missing->();
+    }
+
+    return (\@new_lines, $changed);
+}
+
+sub setup_auto_updates {
+    my ($os_id, $dry_run) = @_;
+    my %info = (
+        installed     => 0,
+        configured    => 0,
+        timer_enabled => 0,
+        method        => $os_id,
+        failed        => 0,
+    );
+
+    if ($os_id eq 'fedora' || $os_id eq 'centos') {
+        # --- dnf-automatic, which dnf 5 provides under a virtual name ---
+        _status('Checking dnf-automatic (Fedora / CentOS Stream)');
+        my $pkg_present = rpm_installed('dnf-automatic') || rpm_installed('dnf5-plugin-automatic');
+        if (!$pkg_present) {
+            _status_done('not installed');
+            if ($dry_run) {
+                _info('Would install: dnf-automatic');
+                $info{installed} = 1;
+            }
+            else {
+                if (dnf_install(['dnf-automatic']) || dnf_install(['dnf5-plugin-automatic'])) {
+                    _ok('Installed dnf-automatic');
+                    $info{installed} = 1;
+                    $pkg_present = 1;
+                }
+                else {
+                    _fail('Failed to install dnf-automatic');
+                    $info{failed} = 1;
+                    return \%info;
+                }
+            }
+        }
+        else {
+            _status_done('installed');
+            $info{installed} = 1;
+        }
+
+        # --- Configure the file ---
+        _status("Configuring $DNF_AUTOMATIC_CONF");
+        my @desired_order = ('apply_updates', 'download_updates', 'upgrade_type');
+        my %desired = (
+            apply_updates    => 'yes',
+            download_updates => 'yes',
+            upgrade_type     => 'security',
+        );
+        my @config_lines;
+        my $open_ok = open(my $fh, '<', $DNF_AUTOMATIC_CONF);
+        my $open_error = $open_ok ? '' : os_error_text($DNF_AUTOMATIC_CONF);
+        if ($open_ok) {
+            my $content = do { local $/ = undef; <$fh> };
+            close($fh);
+            if (defined $content) {
+                @config_lines = map { "$_\n" } split /\n/, $content, -1;
+                pop @config_lines if @config_lines && $config_lines[-1] eq "\n";
+            }
+        }
+        elsif (-e $DNF_AUTOMATIC_CONF) {
+            # dnf 5 ships no file here and the host override is created from
+            # scratch, so only a file that exists and cannot be read is fatal.
+            _status_done('cannot read config');
+            _fail("Cannot read $DNF_AUTOMATIC_CONF: $open_error");
+            $info{failed} = 1;
+            return \%info;
+        }
+
+        my ($rendered, $changed) = render_dnf_automatic_conf(\@config_lines, \@desired_order, \%desired);
+        if (!$changed) {
+            _status_done('already configured');
+            $info{configured} = 1;
+        }
+        elsif ($dry_run) {
+            _status_done('would update');
+            $info{configured} = 1;
+        }
+        else {
+            my $ok = eval { atomic_write($DNF_AUTOMATIC_CONF, join('', @$rendered)); 1 };
+            if (!$ok) {
+                my $error = $@ || 'unknown error';
+                $error =~ s/\s+\z//;
+                _status_done('failed');
+                _fail("Cannot write $DNF_AUTOMATIC_CONF: $error");
+                $info{failed} = 1;
+                return \%info;
+            }
+            _status_done('updated');
+            $info{configured} = 1;
+        }
+
+        # --- Pick the timer unit that exists, since the names differ by generation
+        _status('Detecting automatic update timer');
+        my $timer_name = '';
+        if ($pkg_present) {
+            for my $candidate (@AUTO_UPDATE_TIMER_CANDIDATES) {
+                if (run(['systemctl', 'cat', $candidate])->{rc} == 0) {
+                    $timer_name = $candidate;
+                    last;
+                }
+            }
+        }
+        if (!length $timer_name) {
+            if ($dry_run && !$pkg_present) {
+                _status_done('would detect after installation');
+                _info('Would enable and start the automatic update timer');
+                $info{timer_enabled} = 1;
+                return \%info;
+            }
+            _status_done('none found');
+            _fail('No automatic update timer found (tried: '
+                . join(', ', @AUTO_UPDATE_TIMER_CANDIDATES) . ')');
+            $info{failed} = 1;
+            return \%info;
+        }
+        _status_done($timer_name);
+
+        _status("Checking $timer_name");
+        my $timer_enabled = run(['systemctl', 'is-enabled', $timer_name]);
+        if ($timer_enabled->{rc} != 0) {
+            if ($dry_run) {
+                _status_done('would enable');
+                $info{timer_enabled} = 1;
+            }
+            else {
+                my $enable = run(['systemctl', 'enable', $timer_name]);
+                if ($enable->{rc} != 0) {
+                    _status_done('failed');
+                    _fail("Failed to enable $timer_name");
+                    $info{failed} = 1;
+                    return \%info;
+                }
+                _status_done('enabled');
+                $info{timer_enabled} = 1;
+            }
+        }
+        else {
+            _status_done('already enabled');
+            $info{timer_enabled} = 1;
+        }
+
+        _status("Starting $timer_name");
+        my $timer_active = run(['systemctl', 'is-active', $timer_name]);
+        if ($timer_active->{rc} != 0) {
+            if ($dry_run) {
+                _status_done('would start');
+            }
+            else {
+                my $start = run(['systemctl', 'start', $timer_name]);
+                if ($start->{rc} != 0) {
+                    _status_done('failed');
+                    _fail("Failed to start $timer_name");
+                    $info{failed} = 1;
+                    return \%info;
+                }
+                _status_done('started');
+            }
+        }
+        else {
+            _status_done('already running');
+        }
+    }
+    elsif ($os_id eq 'openeuler') {
+        # --- dnf-hotpatch-plugin ---
+        _status('Checking dnf-hotpatch-plugin (openEuler)');
+        if (!rpm_installed('dnf-hotpatch-plugin')) {
+            _status_done('not installed');
+            if ($dry_run) {
+                _info('Would install: dnf-hotpatch-plugin');
+                $info{installed} = 1;
+            }
+            else {
+                if (dnf_install(['dnf-hotpatch-plugin'])) {
+                    _ok('Installed dnf-hotpatch-plugin');
+                    $info{installed} = 1;
+                }
+                else {
+                    _fail('Failed to install dnf-hotpatch-plugin');
+                    $info{failed} = 1;
+                    return \%info;
+                }
+            }
+        }
+        else {
+            _status_done('installed');
+            $info{installed} = 1;
+        }
+
+        # --- Create or refresh the unit files ---
+        # Policy: openEuler applies all available updates, where the Fedora
+        # counterpart applies security updates only through dnf-automatic.
+        my $service_path = '/etc/systemd/system/auto-update.service';
+        my $service_content = <<'SERVICE';
+[Unit]
+Description=Automatic system updates
+After=network-online.target
+Wants=network-online.target
+
+[Service]
+Type=oneshot
+# Apply all updates, then activate any kernel hot patches. The leading
+# '-' keeps the unit successful when no hot patches are available.
+ExecStart=/usr/bin/dnf update -y
+ExecStart=-/usr/bin/dnf hotupgrade -y
+SERVICE
+        my $timer_path = '/etc/systemd/system/auto-update.timer';
+        my $timer_content = <<'TIMER';
+[Unit]
+Description=Automatic system updates timer
+
+[Timer]
+OnCalendar=daily
+RandomizedDelaySec=3600
+Persistent=true
+
+[Install]
+WantedBy=timers.target
+TIMER
+
+        my $needs_reload = 0;
+        for my $unit ([$service_path, $service_content], [$timer_path, $timer_content]) {
+            my ($unit_path, $unit_content) = @$unit;
+            my $unit_name = $unit_path;
+            $unit_name =~ s{.*/}{};
+            _status("Checking $unit_name (openEuler)");
+            my $existing;
+            if (open(my $fh, '<', $unit_path)) {
+                $existing = do { local $/ = undef; <$fh> };
+                close($fh);
+            }
+            if (defined $existing && $existing eq $unit_content) {
+                _status_done('up to date');
+                next;
+            }
+            if ($dry_run) {
+                _status_done(!defined $existing ? 'would create' : 'would update (drift)');
+                next;
+            }
+            my $ok = eval { atomic_write($unit_path, $unit_content); 1 };
+            if (!$ok) {
+                my $error = $@ || 'unknown error';
+                $error =~ s/\s+\z//;
+                _status_done('failed');
+                _fail("Cannot write $unit_path: $error");
+                $info{failed} = 1;
+                next;
+            }
+            _status_done(!defined $existing ? 'created' : 'updated (content drift)');
+            $needs_reload = 1;
+        }
+        $info{configured} = 1;
+
+        # --- Reload systemd when unit files were created or refreshed ---
+        if ($needs_reload && !$dry_run) {
+            _status('Reloading systemd daemon');
+            my $daemon_reload = run(['systemctl', 'daemon-reload']);
+            if ($daemon_reload->{rc} != 0) {
+                _status_done('failed');
+                _fail('systemctl daemon-reload failed');
+                $info{failed} = 1;
+                return \%info;
+            }
+            _status_done('reloaded');
+        }
+
+        # --- Enable the timer ---
+        _status('Checking auto-update.timer (openEuler)');
+        my $timer_enabled = run(['systemctl', 'is-enabled', 'auto-update.timer']);
+        if ($timer_enabled->{rc} != 0) {
+            if ($dry_run) {
+                _status_done('would enable');
+                $info{timer_enabled} = 1;
+            }
+            else {
+                my $enable = run(['systemctl', 'enable', 'auto-update.timer']);
+                if ($enable->{rc} != 0) {
+                    _status_done('failed');
+                    _fail('Failed to enable auto-update.timer');
+                    $info{failed} = 1;
+                    return \%info;
+                }
+                _status_done('enabled');
+                $info{timer_enabled} = 1;
+            }
+        }
+        else {
+            _status_done('already enabled');
+            $info{timer_enabled} = 1;
+        }
+
+        # --- Start the timer ---
+        _status('Starting auto-update.timer');
+        my $timer_active = run(['systemctl', 'is-active', 'auto-update.timer']);
+        if ($timer_active->{rc} != 0) {
+            if ($dry_run) {
+                _status_done('would start');
+            }
+            else {
+                my $start = run(['systemctl', 'start', 'auto-update.timer']);
+                if ($start->{rc} != 0) {
+                    _status_done('failed');
+                    _fail('Failed to start auto-update.timer');
+                    $info{failed} = 1;
+                    return \%info;
+                }
+                _status_done('started');
+            }
+        }
+        else {
+            _status_done('already running');
+        }
+
+        # --- Verify the hotpatch plugin, tri-state with undef meaning unchecked ---
+        $info{hotpatch_verified} = undef;
+        _status('Verifying dnf hotpatch plugin (openEuler)');
+        if ($dry_run) {
+            _status_done('skipped (dry run)');
+        }
+        else {
+            my $hotpatch = run(['dnf', 'hot-updateinfo', 'list', 'cves', '--installed'], $DNF_TIMEOUT);
+            if ($hotpatch->{rc} == 0) {
+                _status_done('verified');
+                $info{hotpatch_verified} = 1;
+            }
+            else {
+                _status_done('failed');
+                _warn('dnf hot-updateinfo returned non-zero, hotpatch may not be functional');
+                $info{hotpatch_verified} = 0;
+            }
+        }
+    }
+
+    return \%info;
+}
+
+# ---------------------------------------------------------------------------
+# Summary
+# ---------------------------------------------------------------------------
+
+sub print_summary {
+    my ($os_display, $version_id, $results, $warnings, $failures, $elapsed) = @_;
+    my $bar = "═" x 60;
+
+    print STDERR "\n${BOLD}── Setup Summary ──$RESET\n";
+    print STDERR "  OS: $os_display $version_id\n";
+
+    # System update
+    my $update = $results->{update} // {};
+    if ($update->{failed}) {
+        _fail('System update failed');
+    }
+    elsif ($update->{updated}) {
+        _ok('System updated');
+    }
+    elsif ($update->{skipped}) {
+        _info('System already up to date');
+    }
+    else {
+        _info('System update skipped');
+    }
+    _warn('Reboot required to fully apply updates') if $update->{reboot_required};
+
+    # Packages
+    my $packages = $results->{packages} // {};
+    my $installed = scalar @{ $packages->{installed} // [] };
+    my $skipped = scalar @{ $packages->{skipped} // [] };
+    my $failed_pkgs = scalar @{ $packages->{failed} // [] };
+    _ok("Packages: $skipped already present, $installed installed");
+    _fail("$failed_pkgs package(s) failed to install") if $failed_pkgs;
+
+    # Firewall
+    my $firewall = $results->{firewall} // {};
+    if ($firewall->{failed}) {
+        _fail('Firewall setup failed');
+    }
+    elsif (%$firewall) {
+        my $services = scalar @{ $firewall->{services_added} // [] };
+        my $services_skipped = scalar @{ $firewall->{services_skipped} // [] };
+        _ok("Firewall: $services service(s) added, $services_skipped already present");
+    }
+
+    # SELinux
+    my $selinux = $results->{selinux} // {};
+    if ($selinux->{failed}) {
+        _fail('SELinux setup failed');
+    }
+    elsif (%$selinux) {
+        _ok('SELinux: mode=' . ($selinux->{current_mode} // '?'));
+    }
+    if ($selinux->{reboot_required}) {
+        _warn('SELinux: reboot required, filesystem relabel scheduled (/.autorelabel)');
+    }
+
+    # Podman
+    my $podman = $results->{podman} // {};
+    if ($podman->{failed}) {
+        _fail('Podman installation failed');
+    }
+    else {
+        my $podman_version = $podman->{version} // '';
+        if (length $podman_version) {
+            _ok("Podman: $podman_version");
+        }
+        else {
+            _info('Podman: not installed');
+        }
+    }
+
+    # Automatic updates
+    my $auto = $results->{auto_updates} // {};
+    if ($auto->{failed}) {
+        _fail('Auto-updates setup failed');
+    }
+    elsif (%$auto) {
+        my $timer = $auto->{timer_enabled} ? 'enabled' : 'not enabled';
+        _ok("Auto-updates: timer $timer");
+        if (defined $auto->{hotpatch_verified}) {
+            my $hotpatch = $auto->{hotpatch_verified} ? 'verified' : 'not verified';
+            _info("  dnf hotpatch: $hotpatch");
+        }
+    }
+
+    if (@$warnings) {
+        print STDERR "\n";
+        _warn($_) for @$warnings;
+    }
+
+    print STDERR "\n${BOLD}${bar}$RESET\n";
+    if (@$failures) {
+        _fail('Completed with failures in: ' . join(', ', @$failures));
+    }
+    else {
+        _ok('All sections completed successfully');
+    }
+    printf STDERR "  %sTotal time: %.1fs%s\n", $BOLD, $elapsed, $RESET;
+    print STDERR "${BOLD}${bar}$RESET\n\n";
+    return;
+}
+
+# ---------------------------------------------------------------------------
+# Command line
+# ---------------------------------------------------------------------------
+
+sub usage {
+    my $name = $0;
+    $name =~ s{.*/}{};
+    return <<"USAGE";
+Usage: $name [options]
+
+Idempotent server setup for Fedora Server, CentOS Stream and openEuler
+
+Options:
+  --dry-run             Print what would be done without making changes
+  --skip-update         Skip system update
+  --skip-packages       Skip base package installation
+  --skip-epel           Skip EPEL repository setup on CentOS
+  --skip-firewall       Skip firewall setup
+  --skip-selinux        Skip SELinux configuration
+  --skip-podman         Skip Podman installation
+  --skip-auto-updates   Skip automatic updates configuration
+  --version             Show the version and exit
+  -h, --help            Show this help and exit
+USAGE
+}
+
+sub parse_args {
+    my %opt = (
+        dry_run           => 0,
+        skip_update       => 0,
+        skip_packages     => 0,
+        skip_epel         => 0,
+        skip_firewall     => 0,
+        skip_selinux      => 0,
+        skip_podman       => 0,
+        skip_auto_updates => 0,
+    );
+    my %flag_for = (
+        '--dry-run'           => 'dry_run',
+        '--skip-update'       => 'skip_update',
+        '--skip-packages'     => 'skip_packages',
+        '--skip-epel'         => 'skip_epel',
+        '--skip-firewall'     => 'skip_firewall',
+        '--skip-selinux'      => 'skip_selinux',
+        '--skip-podman'       => 'skip_podman',
+        '--skip-auto-updates' => 'skip_auto_updates',
+    );
+    my @argv = @ARGV;
+    while (defined(my $arg = shift @argv)) {
+        if (exists $flag_for{$arg}) { $opt{ $flag_for{$arg} } = 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 $start_time = now();
+    my @warnings;
+    my %results;
+
+    # Arguments first, so that --help and --version work for any user on any
+    # system.
+    my %opt = parse_args();
+
+    check_root();
+    my ($os_id, $os_display, $version_id) = detect_os();
+
+    my $bar = "═" x 60;
+    print STDERR "\n${BOLD}${bar}$RESET\n";
+    print STDERR "${BOLD}  Server Setup  v$VERSION  ($os_display $version_id)$RESET\n";
+    print STDERR "${BOLD}${bar}$RESET\n";
+    if ($opt{dry_run}) {
+        print STDERR "\n  ${YELLOW}${BOLD}DRY RUN: no changes will be made$RESET\n";
+    }
+    print STDERR "\n";
+
+    # 1. System update
+    print STDERR "\n${BOLD}── System Update ──$RESET\n";
+    if (!$opt{skip_update}) {
+        $results{update} = system_update($opt{dry_run});
+        if ($results{update}{reboot_required}) {
+            push @warnings, 'System updates require a reboot to take full effect';
+        }
+    }
+    else {
+        _info('System update: skipped (--skip-update)');
+    }
+
+    # 2. EPEL repository, on CentOS Stream only
+    if ($os_id eq 'centos') {
+        print STDERR "\n${BOLD}── EPEL Repository ──$RESET\n";
+        if (!$opt{skip_epel}) {
+            $results{epel} = ensure_epel($opt{dry_run});
+            if ($results{epel}{failed}) {
+                push @warnings, 'EPEL repository setup failed, some packages may be unavailable';
+            }
+        }
+        else {
+            _info('EPEL repository: skipped (--skip-epel)');
+        }
+    }
+
+    # 3. Base packages
+    print STDERR "\n${BOLD}── Base Packages ──$RESET\n";
+    if (!$opt{skip_packages}) {
+        $results{packages} = install_packages($opt{dry_run});
+        if (@{ $results{packages}{failed} }) {
+            push @warnings, 'Some packages failed to install: '
+                . join(', ', @{ $results{packages}{failed} });
+        }
+    }
+    else {
+        _info('Base packages: skipped (--skip-packages)');
+    }
+
+    # 4. Firewall
+    print STDERR "\n${BOLD}── Firewall ──$RESET\n";
+    if (!$opt{skip_firewall}) {
+        $results{firewall} = setup_firewall($opt{dry_run});
+    }
+    else {
+        _info('Firewall: skipped (--skip-firewall)');
+    }
+
+    # 5. SELinux
+    print STDERR "\n${BOLD}── SELinux ──$RESET\n";
+    if (!$opt{skip_selinux}) {
+        $results{selinux} = setup_selinux($opt{dry_run});
+    }
+    else {
+        _info('SELinux: skipped (--skip-selinux)');
+    }
+
+    # 6. Podman
+    print STDERR "\n${BOLD}── Podman ──$RESET\n";
+    if (!$opt{skip_podman}) {
+        $results{podman} = setup_podman($opt{dry_run});
+    }
+    else {
+        _info('Podman: skipped (--skip-podman)');
+    }
+
+    # 7. Automatic updates
+    print STDERR "\n${BOLD}── Automatic Updates ──$RESET\n";
+    if (!$opt{skip_auto_updates}) {
+        $results{auto_updates} = setup_auto_updates($os_id, $opt{dry_run});
+    }
+    else {
+        _info('Auto-updates: skipped (--skip-auto-updates)');
+    }
+
+    # Any truthy "failed" value counts: a flag, or a non-empty package list.  An
+    # empty list is a list that is true in Perl, so it is counted by its length.
+    # The sections are named in the order they ran, so the failure list reads in
+    # that order too.
+    my @section_order = qw(update epel packages firewall selinux podman auto_updates);
+    my @failures;
+    for my $name (@section_order) {
+        next unless exists $results{$name};
+        my $failed = $results{$name}{failed};
+        next unless defined $failed;
+        my $is_failed = ref $failed eq 'ARRAY' ? scalar(@$failed) > 0 : ($failed ? 1 : 0);
+        push @failures, $name if $is_failed;
+    }
+
+    my $elapsed = now() - $start_time;
+    print_summary($os_display, $version_id, \%results, \@warnings, \@failures, $elapsed);
+
+    exit 1 if @failures;
+    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;
diff --git a/sglang-deploy.pl b/sglang-deploy.pl
new file mode 100644
index 0000000..1355d57
--- /dev/null
+++ b/sglang-deploy.pl
@@ -0,0 +1,2604 @@
+#!/usr/bin/env perl
+# Copyright (c) 2026 Petr Balvín <opensource@petrbalvin.org> (https://petrbalvin.org)
+# SPDX-License-Identifier: MIT
+
+# Idempotent SGLang deployment for AMD ROCm GPUs.
+#
+# SGLang behind nginx with self-signed TLS on Fedora, CentOS Stream or openEuler.
+# The engine binds to ::1 (IPv4 loopback fallback) on port 8000, internal only;
+# nginx proxies :443 to the loopback upstream with streaming (SSE) support.  The
+# endpoint requires an API key, delivered to the service through a 0600
+# EnvironmentFile; nginx to engine proxying is allowed through SELinux on enforcing
+# systems.
+#
+# Why the engine runs in a container rather than straight on the host:
+#
+# SGLang publishes no ROCm wheel at all: the AMD install paths are the project's own
+# container
+# images and a source build against a full ROCm toolchain (llvm, hipcc, cmake, maturin,
+# Rust), which Fedora carries only partly and which CentOS Stream and openEuler, where
+# ROCm itself is unsupported by AMD, cannot carry at all.  Both AMD and SGLang document
+# the container as the way to run SGLang on ROCm, so the container is what this script
+# deploys: podman runs the official image, and the host keeps nginx, TLS, the API key,
+# the firewall and the SELinux boolean.  The host needs no ROCm userland, only the
+# amdgpu kernel driver and its device nodes, /dev/kfd and /dev/dri.
+#
+# Radeon cards: the project publishes no stable image for gfx1151 (Strix Halo, the
+# Radeon 8060S and 8050S), so AMD's dated development builds are resolved instead, the
+# newest per release.  A rerun therefore takes a newer build once AMD publishes one and
+# restarts the service onto it; --image pins one build.  Every other Radeon card has no
+# published image at all and is refused with the build recipe.
+#
+# Model cache: the container's /root/.cache/modelscope is bound to
+# <state-dir>/modelscope and relabelled with :Z, so model weights survive
+# redeployment and an SELinux-enforcing host can still read them.
+#
+# Equivalent launch arguments: this script keeps the familiar --tensor-parallel,
+# --max-model-len and --gpu-memory-utilization names and writes them to the engine
+# as SGLang's --tp-size, --context-length and --mem-fraction-static.
+#
+# Perl builtins only: no module has to be installed.  One piece of work Perl does
+# not carry as a builtin is written out here, the command runner, which forks and
+# keeps stdout and stderr apart in the scratch directory.
+#
+# External binaries used: dnf, rpm, curl, podman, lspci, openssl, systemctl,
+# getenforce, getsebool, setsebool, firewall-cmd and nginx.
+#
+# Usage:
+#     sglang-deploy.pl                                          # interactive model selection
+#     sglang-deploy.pl --model ZhipuAI/GLM-5.3                   # deploy a specific model
+#     sglang-deploy.pl --model ZhipuAI/GLM-5.3 --dry-run         # preview
+#     sglang-deploy.pl --uninstall                               # tear down
+#     sglang-deploy.pl --image lmsysorg/sglang:v0.5.19-rocm720-mi30x
+#     sglang-deploy.pl --version
+
+use strict;
+use warnings;
+
+my $VERSION = '2.0.0';
+
+my $BOLD   = "\033[1m";
+my $RED    = "\033[31m";
+my $GREEN  = "\033[32m";
+my $YELLOW = "\033[33m";
+my $DIM    = "\033[2m";
+my $RESET  = "\033[0m";
+
+# Package installation and an image pull of tens of gigabytes both outlive a
+# generic timeout by a wide margin.
+my $DNF_TIMEOUT  = 600;
+my $PULL_TIMEOUT = 3600;
+
+# Supported systems, in the order the messages list them.
+my @SUPPORTED_ORDER = ('fedora', 'centos', 'openeuler');
+my %SUPPORTED_OS = (
+    fedora    => 'Fedora',
+    centos    => 'CentOS Stream',
+    openeuler => 'openEuler',
+);
+
+# Tools this script itself needs.  podman is the engine's runtime: SGLang ships no
+# ROCm wheel, so the server runs from the project's own ROCm image.
+my @DNF_PACKAGES = qw(pciutils curl openssl podman);
+
+# Packages the engine expects from server-setup.pl (warning only, not installed here).
+my @REQUIRED_SERVER_PACKAGES = (['nginx', 'reverse proxy']);
+
+# Default models for interactive selection when --model is omitted, keyed by
+# display name.  Every ID is a ModelScope repository, which is where the engine
+# downloads weights from (SGLANG_USE_MODELSCOPE), and all five were verified to
+# exist there as of 2026-09.  Two display names hide technical release names,
+# deliberately: Qwen 3.8 Max ships its weights as Qwen3.8-2.4T-A95B and
+# Qwen 3.8 Flash as Qwen3.8-Flash-Next, while the shorter names belong to the
+# QwenCloud API.  The GLM repositories sit under ZhipuAI on ModelScope, which is
+# not the zai-org namespace Hugging Face uses.
+my %DEFAULT_MODELS = (
+    'GLM 5.3'             => 'ZhipuAI/GLM-5.3',
+    'GLM 5.3 Flash'       => 'ZhipuAI/GLM-5.3-Flash',
+    'Qwen 3.8 Max'        => 'Qwen/Qwen3.8-2.4T-A95B',
+    'Qwen 3.8 Flash'      => 'Qwen/Qwen3.8-Flash-Next',
+    'DeepSeek V4.1 Flash' => 'deepseek-ai/DeepSeek-V4.1-Flash',
+);
+# The menu order, which is the order the models are listed in above: selection 1 has
+# to stay GLM 5.3, so this list is written out rather than taken from the hash.
+my @DEFAULT_MODEL_ORDER = (
+    'GLM 5.3', 'GLM 5.3 Flash', 'Qwen 3.8 Max', 'Qwen 3.8 Flash',
+    'DeepSeek V4.1 Flash',
+);
+
+# Reverse lookup: ModelScope model ID to display name.
+my %MODEL_NAMES = map { $DEFAULT_MODELS{$_} => $_ } keys %DEFAULT_MODELS;
+
+# Test-visible accessors: the catalogue is lexical to this file, so the checks
+# under tests/ read the menu through these rather than through the variables.
+sub default_model_order { return @DEFAULT_MODEL_ORDER; }
+sub default_model_repo  { my ($name) = @_; return $DEFAULT_MODELS{$name}; }
+
+# Release resolution, per the SGLang AMD documentation: the images are tagged with
+# the release branch (v0.5.19), a ROCm flavour and the GPU family.  The newest
+# release tag is read from the GitHub API; the constant below is the fallback.
+my $RELEASES_API           = 'https://api.github.com/repos/sgl-project/sglang/releases/latest';
+my $FALLBACK_ENGINE_VERSION = 'v0.5.19';
+
+# Fully qualified on purpose: podman refuses a short name without a terminal, and a
+# systemd unit has no terminal.
+my $IMAGE_REPO     = 'docker.io/lmsysorg/sglang';
+my $IMAGE_HUB_REPO = 'lmsysorg/sglang';    # the same repository on Docker Hub
+
+# A Radeon card has no stable tag in the project's repository.  AMD publishes dated
+# development builds of the same release under its own image instead, and that is what
+# this script resolves for a Strix Halo card (gfx1151, the Radeon 8060S and 8050S).
+# Only the rocm724 flavour is published for it.
+my $RADEON_DEV_REPO     = 'docker.io/rocm/sgl-dev';
+my $RADEON_DEV_HUB_REPO = 'rocm/sgl-dev';
+my $RADEON_DEV_FLAVOUR  = 'rocm724';
+
+# GPU family, as the image tags name it.  The descriptions come from lspci, so the
+# marketing name in the device description decides, never a device-ID table.
+my $STRIX_HALO_RE = qr/\bStrix Halo\b|\bRadeon 80[56]0S\b/i;
+my @ARCH_VARIANTS = (
+    [qr/\bMI3(?:00|25)/i => 'mi30x'],    # gfx942: MI300A, MI300X, MI325X
+    [qr/\bMI3(?:50|55)/i => 'mi35x'],    # gfx950: MI350X, MI355X
+    [$STRIX_HALO_RE      => 'gfx1151'],  # gfx1151: Strix Halo, Radeon 8060S, 8050S
+);
+# The repository each family is published under.
+my %IMAGE_REPO_FOR = (
+    mi30x   => $IMAGE_REPO,
+    mi35x   => $IMAGE_REPO,
+    gfx1151 => $RADEON_DEV_REPO,
+);
+
+# ROCm flavours the images are published in, newest first, with the userland version
+# each one carries.  The container's ROCm userland must not be newer than the host's
+# kernel driver, so the newest flavour that does not exceed the host ROCm is chosen.
+my @ROCM_FLAVOURS = (
+    ['rocm10',  '10.0.0'],
+    ['rocm724', '7.2.4'],
+    ['rocm720', '7.2.0'],
+    ['rocm700', '7.0.0'],
+);
+my $NEWEST_ROCM_FLAVOUR = 'rocm10';
+
+# The AMD ROCm documentation for SGLang on Radeon cards requires AITER off and the
+# fused decode MLA kernel unset: both are on by default and some workloads fail with
+# them.  The engine reads them from the environment, so they go into the unit file.
+my @RADEON_ENV = (
+    'SGLANG_USE_AITER=false',
+    'SGLANG_ROCM_FUSED_DECODE_MLA=false',
+);
+
+# Deployment layout.
+my $CONTAINER_NAME   = 'sglang';
+my $DEFAULT_STATE_DIR = '/opt/sglang';
+my $CACHE_SUBDIR     = 'modelscope';
+my $CACHE_MOUNT      = '/root/.cache/modelscope';
+my $DEFAULT_CERT_DIR = '/etc/ssl/sglang';
+my $DEFAULT_SERVICE  = 'sglang';
+my $INTERNAL_PORT    = 8000;
+
+# ModelScope model IDs look like "org/name", the same shape Hugging Face uses.
+# The strict pattern also keeps systemd specifier characters (%) and whitespace
+# out of unit files.
+my $MODEL_ID_RE = qr{^[A-Za-z0-9._-]+/[A-Za-z0-9._-]+$};
+
+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;
+}
+
+sub _info {
+    my ($msg) = @_;
+    print STDERR "  ${DIM}$msg$RESET\n";
+    return;
+}
+
+sub _warn {
+    my ($msg) = @_;
+    print STDERR "  ${YELLOW}⚠ $msg$RESET\n";
+    return;
+}
+
+sub _ok {
+    my ($msg) = @_;
+    print STDERR "  ${GREEN}✓ $msg$RESET\n";
+    return;
+}
+
+sub _fail {
+    my ($msg) = @_;
+    print STDERR "  ${RED}✗ $msg$RESET\n";
+    return;
+}
+
+# ---------------------------------------------------------------------------
+# Commands, files and small helpers
+# ---------------------------------------------------------------------------
+
+# A hand-rolled which(1), so that the lookup itself needs no external binary.
+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/sglang-deploy.$$" . ($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;
+    # Only the process that created the directory may remove it: a forked child
+    # inherits the END block.
+    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 : '';
+}
+
+sub write_file {
+    my ($path, $content) = @_;
+    open(my $fh, '>', $path) or return 0;
+    # The flush of a buffered handle surfaces at close, so close is checked too:
+    # a full disk must not report a truncated unit file or nginx configuration
+    # as written.
+    my $ok = print {$fh} $content;
+    $ok = 0 unless close($fh);
+    return $ok ? 1 : 0;
+}
+
+# Run a command and return { rc, out, err }.
+#
+# The locale is forced to C for English output parsing.  A timeout, a missing binary
+# and a failed exec become rc 124, 127 and 126 rather than exceptions, so callers
+# always have a result to inspect.
+sub run {
+    my ($cmd, %opt) = @_;
+    my $timeout = $opt{timeout} // 60;
+
+    my $exe = find_exe($cmd->[0]);
+    return { rc => 127, out => '', err => "command not found: $cmd->[0]" } 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 {
+        # A child killed by a signal must not look like success: $? >> 8 is 0
+        # for a signalled exit, so the signal becomes a shell-style 128+n code.
+        my $signal = $? & 127;
+        $rc = $signal ? 128 + $signal : ($? >> 8);
+    }
+
+    my $out = slurp($out_file);
+    my $err = slurp($err_file);
+    unlink($out_file, $err_file);
+    return {
+        rc  => $rc,
+        out => $out,
+        err => $timed_out ? "timed out after ${timeout}s" : $err,
+    };
+}
+
+# The errno, the reason and the path, so a failure message names all three.
+sub os_error_text {
+    my ($path) = @_;
+    return "[Errno " . (0 + $!) . "] $!: '$path'";
+}
+
+# ---------------------------------------------------------------------------
+# System detection
+# ---------------------------------------------------------------------------
+
+sub parse_os_release {
+    my %release;
+    open(my $fh, '<', '/etc/os-release') or return %release;
+    while (my $line = <$fh>) {
+        $line =~ s/^\s+//;
+        $line =~ s/\s+$//;
+        next if $line eq '' || $line =~ /^#/;
+        my ($key, $value) = split /=/, $line, 2;
+        next unless defined $value;
+        $value =~ s/^\s+//;
+        $value =~ s/\s+$//;
+        $value =~ s/^"//;
+        $value =~ s/"$//;
+        $value =~ s/^'//;
+        $value =~ s/'$//;
+        $release{$key} = $value;
+    }
+    close($fh);
+    return %release;
+}
+
+sub detect_os {
+    my %release = parse_os_release();
+    my $os_id = lc($release{ID} // '');
+    my $version_id = $release{VERSION_ID} // 'unknown';
+
+    if (!exists $SUPPORTED_OS{$os_id}) {
+        print STDERR "${RED}${BOLD}Error:${RESET} Unsupported operating system: ",
+            "'", ($release{ID} // 'unknown'), "' (detected from /etc/os-release).\n";
+        print STDERR "  Supported systems: ", join(', ', map { $SUPPORTED_OS{$_} } @SUPPORTED_ORDER), "\n";
+        exit 1;
+    }
+
+    return ($os_id, $SUPPORTED_OS{$os_id}, $version_id);
+}
+
+sub check_root {
+    my $uid = $>;
+    if ($uid != 0) {
+        print STDERR "${RED}${BOLD}Error:${RESET} This script must be run as root (UID 0).\n";
+        print STDERR "  Current UID: $uid. Try: sudo perl sglang-deploy.pl --model ...\n";
+        exit 1;
+    }
+    return;
+}
+
+# ---------------------------------------------------------------------------
+# Idempotency helpers
+# ---------------------------------------------------------------------------
+
+sub systemctl_is_active {
+    my ($service) = @_;
+    return run(['systemctl', 'is-active', '--quiet', $service], timeout => 15)->{rc} == 0;
+}
+
+sub systemctl_is_enabled {
+    my ($service) = @_;
+    return run(['systemctl', 'is-enabled', '--quiet', $service], timeout => 15)->{rc} == 0;
+}
+
+sub rpm_installed {
+    my ($pkg) = @_;
+    return run(['rpm', '-q', $pkg], timeout => 30)->{rc} == 0;
+}
+
+sub podman_container_exists {
+    my ($name) = @_;
+    return run(['podman', 'container', 'exists', $name], timeout => 30)->{rc} == 0;
+}
+
+sub podman_image_exists {
+    my ($image) = @_;
+    return run(['podman', 'image', 'exists', $image], timeout => 30)->{rc} == 0;
+}
+
+# ---------------------------------------------------------------------------
+# GPU, ROCm and image resolution helpers
+# ---------------------------------------------------------------------------
+
+# Return AMD/ATI GPU descriptions from lspci -nn (empty list when none).
+#
+# Only VGA/3D/Display controller class lines with the AMD/ATI vendor ID (1002) match,
+# so the AMD chipset, audio and USB lines found on AMD-CPU systems are ignored.
+sub detect_amd_gpus {
+    my $lspci = find_exe('lspci');
+    if (!defined $lspci) {
+        _fail("lspci not found: pciutils should have been installed in the dependencies step");
+        exit 1;
+    }
+    my $result = run([$lspci, '-nn'], timeout => 30);
+    if ($result->{rc} != 0) {
+        my $err = $result->{err};
+        $err =~ s/\s+$//;
+        _fail("lspci -nn failed: $err");
+        exit 1;
+    }
+
+    my @gpu_classes = ('VGA compatible controller', '3D controller', 'Display controller');
+    my @gpus;
+    for my $line (split /\n/, $result->{out}) {
+        next unless index($line, '[1002:') >= 0;
+        my $is_gpu = 0;
+        for my $cls (@gpu_classes) {
+            if (index($line, $cls) >= 0) { $is_gpu = 1; last; }
+        }
+        next unless $is_gpu;
+        if (index($line, ': ') >= 0) {
+            $line =~ s/^.*?: //;
+        }
+        $line =~ s/^\s+//;
+        $line =~ s/\s+$//;
+        push @gpus, $line;
+    }
+    return @gpus;
+}
+
+# Map a GPU description to the image's GPU family, or undef when no published image
+# matches.  Radeon cards are deliberately unmapped: the project publishes no stable
+# Radeon tag, only dated development builds under AMD's own repository.
+sub arch_variant {
+    my ($gpus) = @_;
+    for my $gpu (@$gpus) {
+        for my $entry (@ARCH_VARIANTS) {
+            my ($pattern, $variant) = @$entry;
+            return $variant if $gpu =~ $pattern;
+        }
+    }
+    return undef;
+}
+
+sub radeon_present {
+    my ($gpus) = @_;
+    for my $gpu (@$gpus) {
+        next if $gpu =~ /\bMI3/;
+        next if $gpu =~ $STRIX_HALO_RE;    # AMD publishes gfx1151 builds
+        return 1 if $gpu =~ /\bRadeon\b/i;
+    }
+    return 0;
+}
+
+# A card no published family matches is fatal only when the image would be
+# resolved from that family: --image is the documented escape for exactly those
+# cards, so with it the family is informational and never fatal.
+sub family_is_fatal {
+    my ($variant, $image_opt) = @_;
+    return 0 if defined $variant;
+    return $image_opt ? 0 : 1;
+}
+
+# The Radeon defaults apply to the family the deployed image targets: gfx1151,
+# or a custom image on a host no published family matches.  A Radeon that only
+# drives the display next to an Instinct does not switch the Instinct off its
+# optimisations.
+sub radeon_env_for {
+    my ($variant, $is_radeon) = @_;
+    my $targets_radeon = defined $variant ? $variant eq 'gfx1151' : $is_radeon;
+    return $targets_radeon ? [@RADEON_ENV] : [];
+}
+
+# The installed ROCm userland version (e.g. '7.2.4'), or undef when the host has none.
+# A host running only the container needs no ROCm at all, which is why this is
+# informational: it selects the image flavour and is reported, never required.
+sub detect_rocm_version {
+    if (-f '/opt/rocm/.info/version') {
+        my $text = slurp('/opt/rocm/.info/version');
+        $text =~ s/^\s+//;
+        $text =~ s/\s+$//;
+        my ($version) = split /-/, $text;
+        return $version if defined $version && length $version;
+    }
+    # Fedora's native packages install into /usr (no /opt/rocm).
+    my $rpm = run(['rpm', '-q', '--qf', '%{VERSION}', 'rocm-runtime'], timeout => 30);
+    if ($rpm->{rc} == 0 && $rpm->{out} =~ /\S/) {
+        my $version = $rpm->{out};
+        $version =~ s/^\s+//;
+        $version =~ s/\s+$//;
+        return $version;
+    }
+    my $smi = find_exe('rocm-smi');
+    if (defined $smi) {
+        my $result = run([$smi, '--version'], timeout => 30);
+        my $banner = $result->{out} . $result->{err};
+        if ($banner =~ /(\d+\.\d+(?:\.\d+)?)/) {
+            return $1;
+        }
+    }
+    return undef;
+}
+
+# Compare two dotted numeric versions: -1, 0 or 1.
+sub version_cmp {
+    my ($left, $right) = @_;
+    my @a = split /\./, $left;
+    my @b = split /\./, $right;
+    my $len = @a > @b ? scalar @a : scalar @b;
+    for my $i (0 .. $len - 1) {
+        my $x = $i < @a ? $a[$i] : 0;
+        my $y = $i < @b ? $b[$i] : 0;
+        $x = 0 unless $x =~ /^\d+$/;
+        $y = 0 unless $y =~ /^\d+$/;
+        return $x <=> $y if $x != $y;
+    }
+    return 0;
+}
+
+# The newest published flavour whose userland is not newer than the host's ROCm, or
+# undef when the host ROCm predates every published image.
+sub select_rocm_flavour {
+    my ($rocm_version) = @_;
+    for my $entry (@ROCM_FLAVOURS) {
+        my ($flavour, $version) = @$entry;
+        return $flavour if version_cmp($version, $rocm_version) <= 0;
+    }
+    return undef;
+}
+
+# Fetch a URL as text via curl -fsSL; the empty string on failure (with a warning).
+sub fetch_text {
+    my ($url, $timeout) = @_;
+    $timeout //= 30;
+    my $curl = find_exe('curl');
+    if (!defined $curl) {
+        _warn("curl not found: cannot fetch remote version information");
+        return '';
+    }
+    my $result = run([$curl, '-fsSL', '-A', "sglang-deploy/$VERSION", $url], timeout => $timeout);
+    if ($result->{rc} != 0) {
+        _warn("Failed to fetch $url (curl exit $result->{rc})");
+        return '';
+    }
+    return $result->{out};
+}
+
+# Resolve the newest SGLang release tag ('v0.5.19'), from the GitHub API with the
+# tag list and then a constant as fallbacks.  The charset bound on both patterns
+# keeps whatever the API answers out of the image reference and the unit file,
+# where whitespace and % are refused.
+sub resolve_engine_version {
+    my $listing = fetch_text($RELEASES_API);
+    if ($listing =~ /"tag_name"\s*:\s*"(v\d+\.\d+\.\d+[A-Za-z0-9._-]*)"/) {
+        return $1;
+    }
+    my $tags = fetch_text('https://api.github.com/repos/sgl-project/sglang/tags?per_page=20');
+    if ($tags =~ /"name"\s*:\s*"(v\d+\.\d+\.\d+[A-Za-z0-9._-]*)"/) {
+        return $1;
+    }
+    _warn("Could not resolve the newest SGLang release: using the fallback pin "
+        . "$FALLBACK_ENGINE_VERSION");
+    return $FALLBACK_ENGINE_VERSION;
+}
+
+# Does the tag exist on Docker Hub?  1 yes, 0 no, undef when it cannot be told.
+sub image_tag_published {
+    my ($hub_repo, $tag) = @_;
+    my $curl = find_exe('curl');
+    return undef unless defined $curl;
+    my $url = "https://hub.docker.com/v2/repositories/$hub_repo/tags/$tag";
+    # Only a definitive 404 says the tag is unpublished.  Rate limiting (429)
+    # and server errors answer with other codes, and with curl -f they would
+    # be indistinguishable from a missing tag, so the code is read instead.
+    my $result = run(
+        [$curl, '-sS', '-o', '/dev/null', '-w', '%{http_code}', $url],
+        timeout => 30,
+    );
+    return undef if $result->{rc} != 0;
+    my $code = $result->{out};
+    $code =~ s/^\s+//;
+    $code =~ s/\s+$//;
+    return 1    if $code =~ /^2/;
+    return 0    if $code eq '404';
+    return undef;
+}
+
+sub resolve_image {
+    my ($repo, $engine_version, $variant, $flavour) = @_;
+    return "$repo:$engine_version-$flavour-$variant";
+}
+
+# The newest dated development build AMD published for a Strix Halo card, or the empty
+# string when the index cannot be read.  The tags carry the release, the flavour, the
+# family and the build date (v0.5.19-rocm724-gfx1151-20260916).  The ordering is
+# passed explicitly so the first answer is the newest build without relying on the
+# endpoint's default.
+sub resolve_radeon_dev_tag {
+    my ($engine_version) = @_;
+    my $prefix = "$engine_version-$RADEON_DEV_FLAVOUR-gfx1151";
+    my $url = "https://hub.docker.com/v2/repositories/$RADEON_DEV_HUB_REPO/tags"
+        . "?page_size=5&name=$prefix&ordering=last_updated";
+    my $listing = fetch_text($url);
+    if ($listing =~ /"name"\s*:\s*"(\Q$prefix\E-\d{8})"/) {
+        return $1;
+    }
+    return '';
+}
+
+# Probe ModelScope for the model: 'ok', 'missing', or 'unknown'.
+#
+# Only a definitive 404 ('missing') is fatal; network problems yield 'unknown' so
+# offline environments are not blocked.  The API answer carries no gated signal,
+# so a repository that needs a token surfaces at the first start instead, which
+# MODELSCOPE_TOKEN in the unit's environment solves.
+sub ms_model_status {
+    my ($model) = @_;
+    my $curl = find_exe('curl');
+    return 'unknown' unless defined $curl;
+    my $url = "https://modelscope.cn/api/v1/models/$model";
+    my $result = run(
+        [$curl, '-sS', '-A', "sglang-deploy/$VERSION", '-o', '-',
+            '-w', "\n__HTTP__%{http_code}\n", $url],
+        timeout => 15,
+    );
+    return 'unknown' if $result->{rc} != 0;
+    my $body = $result->{out};
+    my $code = '';
+    if ($body =~ s/\n__HTTP__(\d{3})\n\s*$//) {
+        $code = $1;
+    }
+    return 'missing' if $code eq '404';
+    return 'unknown' if $code !~ /^2/;
+    # An existing repository answers with its document, whose Name field names it;
+    # a hit without a name is treated as no answer at all.
+    return 'ok' if $body =~ /"Name"\s*:\s*"[^"]+"/;
+    return 'unknown';
+}
+
+# Return (bind_host, nginx_upstream_host): IPv6 ::1 first.
+#
+# Falls back to 127.0.0.1 on kernels with IPv6 disabled
+# (net.ipv6.conf.all.disable_ipv6=1), where binding ::1 would fail.
+sub detect_loopback {
+    if (-e '/proc/net/if_inet6') {
+        return ('::1', '[::1]');
+    }
+    return ('127.0.0.1', '127.0.0.1');
+}
+
+# The host's fully qualified name, or the short name when the resolver has no
+# FQDN for this host.  The hostname(1) binary is only an accelerator: the
+# kernel's own name is read when it is missing, so a minimal installation works.
+sub host_fqdn {
+    my $hostname = find_exe('hostname');
+    if (defined $hostname) {
+        my $result = run([$hostname, '-f'], timeout => 15);
+        my $fqdn = $result->{out};
+        $fqdn =~ s/^\s+//;
+        $fqdn =~ s/\s+$//;
+        return $fqdn if length $fqdn;
+    }
+    return host_name();
+}
+
+sub host_name {
+    my $name = slurp('/proc/sys/kernel/hostname');
+    $name =~ s/\s+$//;
+    return $name if length $name;
+    my $hostname = find_exe('hostname');
+    return '' unless defined $hostname;
+    my $result = run([$hostname], timeout => 15);
+    $name = $result->{out};
+    $name =~ s/^\s+//;
+    $name =~ s/\s+$//;
+    return $name;
+}
+
+# Build a subjectAltName value from the host FQDN and primary IPv4 (if resolvable).
+#
+# openssl rejects an extension whose value is empty, so an entry is only added when it
+# carries something, and localhost is the last resort for a host that cannot name
+# itself at all.
+sub cert_san {
+    my $fqdn = host_fqdn();
+    my $hostname = host_name();
+
+    my @entries;
+    push @entries, "DNS:$fqdn" if length $fqdn;
+    push @entries, "DNS:$hostname" if length $hostname && $hostname ne $fqdn;
+    if (length $fqdn) {
+        my $addr = gethostbyname($fqdn);
+        if (defined $addr) {
+            my $dotted = join('.', unpack('C4', $addr));
+            if ($dotted !~ /^127\./) {
+                push @entries, "IP:$dotted";
+            }
+        }
+    }
+    push @entries, 'DNS:localhost' unless @entries;
+    return join(',', @entries);
+}
+
+# ---------------------------------------------------------------------------
+# 1. System dependencies
+# ---------------------------------------------------------------------------
+
+sub install_system_deps {
+    my ($dry_run) = @_;
+    my %results = (installed => [], skipped => [], failed => []);
+
+    my @missing;
+    for my $pkg (@DNF_PACKAGES) {
+        if (rpm_installed($pkg)) {
+            push @{ $results{skipped} }, $pkg;
+        }
+        else {
+            push @missing, $pkg;
+        }
+    }
+
+    if (!@missing) {
+        _info("All " . scalar(@DNF_PACKAGES) . " packages already installed");
+    }
+    else {
+        _status("Installing " . scalar(@missing) . " package(s): " . join(', ', @missing));
+        if ($dry_run) {
+            _status_done('dry run');
+            $results{installed} = [@missing];
+        }
+        else {
+            my $result = run(['dnf', 'install', '-y', @missing], timeout => $DNF_TIMEOUT);
+            if ($result->{rc} == 0) {
+                $results{installed} = [@missing];
+                _status_done('ok');
+            }
+            else {
+                _status_done('failed');
+                $results{failed} = [@missing];
+                my $err = $result->{err};
+                $err =~ s/\s+$//;
+                _info("dnf stderr: $err") if length $err;
+            }
+        }
+    }
+
+    # The engine's runtime.  A missing podman is not fatal here: the pull step reports
+    # it, and the container simply cannot start without it.
+    _status('Checking podman');
+    my $podman = find_exe('podman');
+    if (defined $podman) {
+        my $result = run([$podman, '--version'], timeout => 30);
+        my $version = $result->{out};
+        $version =~ s/^\s+//;
+        $version =~ s/\s+$//;
+        _status_done($version ne '' ? $version : 'installed');
+        $results{podman} = $version ne '' ? $version : 'installed';
+    }
+    elsif ($dry_run) {
+        _status_done('would install');
+        $results{podman} = 'dry run';
+    }
+    else {
+        _status_done('not found');
+        $results{podman} = undef;
+        _fail('podman is not installed: the engine runs as a container and cannot start');
+    }
+
+    # Packages expected from server-setup.pl (warning only, not installed here).
+    for my $entry (@REQUIRED_SERVER_PACKAGES) {
+        my ($pkg, $purpose) = @$entry;
+        if (!rpm_installed($pkg)) {
+            _warn("$pkg ($purpose) is not installed: run server-setup.pl first");
+        }
+    }
+
+    return \%results;
+}
+
+# ---------------------------------------------------------------------------
+# 2. Pre-flight checks
+# ---------------------------------------------------------------------------
+
+sub preflight_checks {
+    my ($os_id, $version_id, $argv) = @_;
+    my %results;
+
+    # Root (idempotent no-op: main() already checked; keeps the status line).
+    _status('Checking root privileges');
+    check_root();
+    _status_done('root');
+
+    # OS (already detected by main for the header).
+    _status('Detecting operating system');
+    _status_done("$SUPPORTED_OS{$os_id} $version_id");
+    $results{os_id} = $os_id;
+    $results{os_display} = $SUPPORTED_OS{$os_id};
+    $results{version_id} = $version_id;
+
+    # AMD GPU hardware, class and vendor filtered, so AMD chipsets never match.
+    _status('Checking GPU hardware');
+    my @gpus = detect_amd_gpus();
+    if (!@gpus) {
+        _status_done('not found');
+        print STDERR "\n  ${RED}${BOLD}Error:${RESET} No AMD GPU detected in this system. ",
+            "SGLang on ROCm requires an AMD GPU.\n";
+        exit 1;
+    }
+    if (@gpus == 1) {
+        _status_done($gpus[0]);
+    }
+    else {
+        _status_done("$gpus[0] (+" . (scalar(@gpus) - 1) . " more)");
+    }
+    $results{gpu_models} = [@gpus];
+    $results{gpu_count} = scalar @gpus;
+
+    # Kernel driver and its device nodes: the engine is a container, so the host
+    # carries the driver, never the ROCm userland.  The nodes are the material fact,
+    # and the driver creates them; the module directory is only a hint about why they
+    # are missing, since a container's /sys may not show it.
+    _status('Checking the amdgpu kernel driver');
+    my @missing_nodes = grep { !-e $_ } ('/dev/kfd', '/dev/dri');
+    if (@missing_nodes) {
+        _status_done('not ready');
+        print STDERR "\n  ${RED}${BOLD}Error:${RESET} The amdgpu kernel driver is not ready: ",
+            "missing device node(s): ", join(', ', @missing_nodes), ".\n";
+        if (!-d '/sys/module/amdgpu') {
+            print STDERR "  The amdgpu kernel module is not loaded either.\n";
+        }
+        print STDERR "  The container reaches the GPU through /dev/kfd and /dev/dri, which the\n";
+        print STDERR "  driver creates. Install the AMD GPU driver for this distribution, load it\n";
+        print STDERR "  and re-run.\n";
+        exit 1;
+    }
+    _status_done('present (/dev/kfd, /dev/dri)');
+
+    # ROCm userland, when the host happens to have one: it selects the image flavour.
+    _status('Checking ROCm installation');
+    my $rocm_version = detect_rocm_version();
+    if (defined $rocm_version) {
+        _status_done("present ($rocm_version)");
+        $results{rocm} = 1;
+    }
+    else {
+        _status_done('not installed (not needed, the image carries it)');
+        $results{rocm} = 0;
+    }
+    $results{rocm_version} = $rocm_version;
+
+    # GPU family from the lspci description, for the image tag.  A card with no
+    # published family is fatal only when the image is resolved from the family:
+    # --image is the documented escape for such cards.
+    my $variant = arch_variant(\@gpus);
+    my $is_radeon = radeon_present(\@gpus);
+    my $custom_image = defined $argv->{image} && length $argv->{image};
+    if (family_is_fatal($variant, $custom_image)) {
+        if ($is_radeon) {
+            print STDERR "\n  ${RED}${BOLD}Error:${RESET} Radeon card detected, and neither ",
+                "SGLang nor AMD\n  publishes a stable image for this one:\n";
+            print STDERR "    $gpus[0]\n";
+            print STDERR "  Build an image for it and pass it directly:\n";
+            print STDERR "    podman build -t sglang-rocm -f docker/rocm.Dockerfile .\n";
+            print STDERR "  then re-run with --image sglang-rocm:latest.\n";
+        }
+        else {
+            print STDERR "\n  ${RED}${BOLD}Error:${RESET} No published SGLang image matches this GPU:\n";
+            print STDERR "    $gpus[0]\n";
+            print STDERR "  Published families are mi30x (MI300, MI325) and mi35x (MI350, MI355).\n";
+            print STDERR "  Build an image for this card or pass one with --image <tag>.\n";
+        }
+        exit 1;
+    }
+    $results{arch_variant} = $variant;
+
+    # ROCm flavour: the newest published one whose userland is not newer than the
+    # host's, or the newest available when the host carries no ROCm to compare
+    # with.  The flavour only selects the image tag, so with --image there is
+    # nothing to select and no host ROCm can be too old for it.
+    my $flavour;
+    if ($custom_image) {
+        _status('Checking ROCm flavour');
+        _status_done('skipped (the image comes from --image)');
+        $flavour = 'from --image';
+    }
+    elsif ($variant eq 'gfx1151') {
+        $flavour = $RADEON_DEV_FLAVOUR;
+        _status('Checking ROCm flavour');
+        _status_done("$flavour (the only flavour published for gfx1151)");
+    }
+    elsif (defined $argv->{rocm_flavour} && length $argv->{rocm_flavour}) {
+        $flavour = $argv->{rocm_flavour};
+        _status('Checking ROCm flavour');
+        _status_done("$flavour (from --rocm-flavour)");
+    }
+    elsif (defined $rocm_version) {
+        $flavour = select_rocm_flavour($rocm_version);
+        _status('Checking ROCm flavour');
+        if (defined $flavour) {
+            _status_done("$flavour (host ROCm $rocm_version)");
+        }
+        else {
+            _status_done('none published');
+            print STDERR "\n  ${RED}${BOLD}Error:${RESET} No published image targets ROCm ",
+                "$rocm_version or older.\n";
+            print STDERR "  Published flavours: ",
+                join(', ', map { "$_->[0] (ROCm $_->[1])" } @ROCM_FLAVOURS), "\n";
+            print STDERR "  Upgrade the ROCm driver, or pass --image with an image built for ",
+                "this stack.\n";
+            exit 1;
+        }
+    }
+    else {
+        $flavour = $NEWEST_ROCM_FLAVOUR;
+        _status('Checking ROCm flavour');
+        _status_done("$flavour (no host ROCm to compare with)");
+        _warn("No ROCm userland found on the host, so the newest flavour ($flavour) is assumed. "
+            . "The container's ROCm must not be newer than the amdgpu kernel driver, or it "
+            . "cannot open the GPU: if this host's driver predates ROCm "
+            . "$ROCM_FLAVOURS[0][1], pass --rocm-flavour with an older one.");
+    }
+    $results{rocm_flavour} = $flavour;
+
+    # The image itself: --image wins, otherwise it is resolved from the release, the
+    # flavour and the GPU family and checked against Docker Hub.
+    my $image;
+    if (defined $argv->{image} && length $argv->{image}) {
+        $image = $argv->{image};
+        _status('Using the requested image');
+        _status_done($image);
+        $results{engine_version} = 'from --image';
+    }
+    else {
+        _status('Resolving the newest SGLang release');
+        my $engine_version = resolve_engine_version();
+        _status_done($engine_version);
+        $results{engine_version} = $engine_version;
+
+        if ($variant eq 'gfx1151') {
+            _status('Resolving the newest AMD development build for gfx1151');
+            my $tag = resolve_radeon_dev_tag($engine_version);
+            if (!length $tag) {
+                _status_done('not found');
+                print STDERR "\n  ${RED}${BOLD}Error:${RESET} No AMD development build found ",
+                    "for $engine_version-gfx1151.\n";
+                print STDERR "  Build an image for this card (docker/rocm-gfx1151.Dockerfile) and\n";
+                print STDERR "  pass it with --image <tag>.\n";
+                exit 1;
+            }
+            $image = "$RADEON_DEV_REPO:$tag";
+            $results{radeon_dev} = 1;
+            _status_done($tag);
+        }
+        else {
+            $image = resolve_image($IMAGE_REPO_FOR{$variant}, $engine_version, $variant, $flavour);
+            _status('Checking the image tag is published');
+            my $published = image_tag_published($IMAGE_HUB_REPO,
+                "$engine_version-$flavour-$variant");
+            if (defined $published && !$published) {
+                _status_done('not found');
+                print STDERR "\n  ${RED}${BOLD}Error:${RESET} The resolved image tag does not ",
+                    "exist: $image\n";
+                print STDERR "  Pass the image to deploy with --image <tag>.\n";
+                exit 1;
+            }
+            _status_done(defined $published ? 'ok' : 'could not verify (offline?)');
+        }
+    }
+    $results{engine_image} = $image;
+
+    # Radeon needs AITER and the fused decode MLA kernel off; the values are recorded
+    # here so the unit file carries them only where they are required, which the
+    # resolved family decides, not the mere presence of a Radeon in the system.
+    $results{radeon_env} = radeon_env_for($variant, $is_radeon);
+
+    return \%results;
+}
+
+# ---------------------------------------------------------------------------
+# 3. State directory (model cache)
+# ---------------------------------------------------------------------------
+
+sub setup_state_dir {
+    my ($state_dir, $dry_run) = @_;
+    my %results;
+    my $cache_dir = "$state_dir/$CACHE_SUBDIR";
+
+    _status("Ensuring $state_dir directory");
+    if (-d $cache_dir) {
+        _status_done('exists');
+        $results{state_dir_exists} = 1;
+        return \%results;
+    }
+    if ($dry_run) {
+        _status_done('dry run');
+        $results{state_dir_created} = 'dry run';
+        return \%results;
+    }
+    my $ok = 1;
+    for my $dir ($state_dir, $cache_dir) {
+        next if -d $dir;
+        if (!mkdir($dir, 0755)) {
+            _status_done('failed');
+            _fail("Could not create $dir: " . os_error_text($dir));
+            $results{state_dir_created} = 0;
+            $ok = 0;
+            last;
+        }
+    }
+    if ($ok) {
+        _status_done('created');
+        $results{state_dir_created} = 1;
+    }
+    return \%results;
+}
+
+# ---------------------------------------------------------------------------
+# 4. Engine image
+# ---------------------------------------------------------------------------
+
+sub fetch_engine_image {
+    my ($image, $dry_run) = @_;
+    my %results;
+    $results{image} = $image;
+
+    _status('Checking the engine image');
+    if (podman_image_exists($image)) {
+        _status_done('already present');
+        $results{image_present} = 1;
+        return \%results;
+    }
+
+    if ($dry_run) {
+        _status_done('dry run');
+        _info("Would run: podman pull $image");
+        $results{image_pulled} = 'dry run';
+        return \%results;
+    }
+
+    if (!defined find_exe('podman')) {
+        _status_done('podman not found');
+        _fail('podman is not installed: cannot pull the engine image');
+        $results{image_pulled} = 0;
+        return \%results;
+    }
+
+    _status("Pulling $image (tens of gigabytes, this takes a while)");
+    my $result = run(['podman', 'pull', $image], timeout => $PULL_TIMEOUT);
+    if ($result->{rc} == 0) {
+        _status_done('ok');
+        $results{image_pulled} = 1;
+    }
+    else {
+        _status_done('failed');
+        my $err = $result->{err};
+        $err =~ s/\s+$//;
+        my $tail = length($err) > 500 ? substr($err, -500) : $err;
+        _fail("Image pull failed: $tail");
+        $results{image_pulled} = 0;
+    }
+    return \%results;
+}
+
+# ---------------------------------------------------------------------------
+# 5. TLS certificate (self-signed)
+# ---------------------------------------------------------------------------
+
+sub setup_tls {
+    my ($cert_dir, $dry_run) = @_;
+    my %results;
+    my $key_path = "$cert_dir/$CONTAINER_NAME.key";
+    my $crt_path = "$cert_dir/$CONTAINER_NAME.crt";
+
+    _status('Checking TLS certificate');
+    if (-f $crt_path && -f $key_path) {
+        _status_done('already exists');
+        $results{cert_exists} = 1;
+        return \%results;
+    }
+
+    if ($dry_run) {
+        _status_done('would generate');
+        $results{cert_created} = 'dry run';
+        return \%results;
+    }
+
+    my $openssl = find_exe('openssl');
+    if (!defined $openssl) {
+        _status_done('openssl not found');
+        _fail('openssl is not installed: cannot generate a certificate');
+        $results{cert_created} = 0;
+        return \%results;
+    }
+
+    if (!-d $cert_dir) {
+        mkdir($cert_dir, 0755) or do {
+            _status_done('cannot create the directory');
+            _fail("Could not create $cert_dir: " . os_error_text($cert_dir));
+            $results{cert_created} = 0;
+            return \%results;
+        };
+    }
+
+    _status('Generating self-signed certificate');
+    # A restrictive umask while openssl runs: the key must never touch the disk
+    # world-readable, not even for the instant before the chmod below.
+    my $old_umask = umask(0077);
+    my $result = run([
+        $openssl, 'req', '-x509', '-nodes', '-days', '365',
+        '-newkey', 'rsa:2048',
+        '-keyout', $key_path,
+        '-out',    $crt_path,
+        '-subj',   '/CN=' . host_fqdn(),
+        '-addext', 'subjectAltName=' . cert_san(),
+    ], timeout => 30);
+    umask($old_umask);
+
+    if ($result->{rc} == 0) {
+        chmod 0600, $key_path;
+        chmod 0644, $crt_path;
+        _status_done('generated');
+        $results{cert_created} = 1;
+    }
+    else {
+        _status_done('failed');
+        my $err = $result->{err};
+        $err =~ s/\s+$//;
+        _fail("openssl failed: $err");
+        $results{cert_created} = 0;
+    }
+
+    return \%results;
+}
+
+# ---------------------------------------------------------------------------
+# 6. API key (EnvironmentFile for the systemd unit)
+# ---------------------------------------------------------------------------
+
+sub setup_api_key {
+    my ($service_name, $api_key, $dry_run) = @_;
+    my %results;
+    my $env_path = "/etc/sysconfig/$service_name";
+
+    my $current = -f $env_path ? slurp($env_path) : '';
+
+    _status('Checking API key environment file');
+    if (!defined $api_key && index($current, 'SGLANG_API_KEY=') >= 0) {
+        # A file written by something else may carry looser permissions than
+        # this script's own; the key stays root-only either way.
+        chmod 0600, $env_path;
+        _status_done('already present, reusing the existing key');
+        $results{env_file} = 'exists';
+        return \%results;
+    }
+
+    my $desired = defined $api_key ? "SGLANG_API_KEY=$api_key\n" : '';
+    if (defined $api_key && $current eq $desired) {
+        _status_done('already configured');
+        $results{env_file} = 'exists';
+        return \%results;
+    }
+
+    if ($dry_run) {
+        _status_done(length $current ? 'would update' : 'would create');
+        $results{env_file} = 'dry run';
+        return \%results;
+    }
+
+    my $key = defined $api_key ? $api_key : generate_api_key();
+    # 0600 from the start: the secret must never exist world-readable, not even
+    # between the write and a later chmod.
+    my $old_umask = umask(0077);
+    my $written = write_file($env_path, "SGLANG_API_KEY=$key\n");
+    umask($old_umask);
+    if (!$written) {
+        _status_done('failed');
+        _fail("Could not write $env_path: " . os_error_text($env_path));
+        $results{env_file} = 'failed';
+        return \%results;
+    }
+    chmod 0600, $env_path;
+    _status_done(length $current ? 'updated' : 'created');
+    $results{env_file} = length $current ? 'updated' : 'created';
+    $results{generated_key} = $key unless defined $api_key;
+    return \%results;
+}
+
+# A URL-safe key: 32 random bytes, base64 without padding, '-' and '_' for
+# '+' and '/'.
+sub generate_api_key {
+    my $bytes = '';
+    my $fh;
+    if (open(my $rand, '<', '/dev/urandom')) {
+        $fh = $rand;
+        my $raw = '';
+        my $got = read($fh, $raw, 32);
+        $bytes = $got == 32 ? $raw : '';
+        close($fh);
+    }
+    if (length($bytes) != 32) {
+        # Fall back to hashing the process state: weaker, and said out loud.
+        _warn('/dev/urandom is unavailable: deriving the key from process state instead');
+        $bytes = '';
+        for my $i (1 .. 8) {
+            $bytes .= pack('N', ($$ * $i * 2654435761) % 4294967296);
+        }
+        $bytes = substr($bytes, 0, 32);
+    }
+    my $b64 = encode_base64url($bytes);
+    return $b64;
+}
+
+sub encode_base64url {
+    my ($data) = @_;
+    my $alphabet = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_';
+    my $out = '';
+    my $bits = 0;
+    my $buffer = 0;
+    for my $byte (unpack('C*', $data)) {
+        $buffer = ($buffer << 8) | $byte;
+        $bits += 8;
+        while ($bits >= 6) {
+            $bits -= 6;
+            $out .= substr($alphabet, ($buffer >> $bits) & 0x3F, 1);
+        }
+    }
+    if ($bits > 0) {
+        $out .= substr($alphabet, ($buffer << (6 - $bits)) & 0x3F, 1);
+    }
+    return $out;
+}
+
+# ---------------------------------------------------------------------------
+# 7. SELinux
+# ---------------------------------------------------------------------------
+
+# Allow nginx to reach the engine's port on SELinux-enforcing systems.
+#
+# http_port_t covers 80/81/443/488/8008/8009/8443/9000 but not the engine's port, so
+# on enforcing systems nginx needs httpd_can_network_connect.
+sub setup_selinux {
+    my ($dry_run) = @_;
+    my %results;
+
+    _status('Checking SELinux status');
+    my $getenforce = find_exe('getenforce');
+    if (!defined $getenforce) {
+        _status_done('not installed (skipping)');
+        $results{selinux} = 'absent';
+        return \%results;
+    }
+    my $mode_result = run([$getenforce], timeout => 10);
+    my $mode = $mode_result->{out};
+    $mode =~ s/^\s+//;
+    $mode =~ s/\s+$//;
+    $mode = lc $mode;
+    if ($mode ne 'enforcing') {
+        _status_done("$mode (skipping)");
+        $results{selinux} = $mode;
+        return \%results;
+    }
+    _status_done('enforcing');
+
+    _status('Checking httpd_can_network_connect boolean');
+    my $getsebool = find_exe('getsebool');
+    my $setsebool = find_exe('setsebool');
+    if (!defined $getsebool || !defined $setsebool) {
+        _status_done('tools missing');
+        _warn('getsebool/setsebool not found: nginx proxying may be blocked (502)');
+        $results{selinux} = 'failed';
+        return \%results;
+    }
+
+    my $current = run([$getsebool, 'httpd_can_network_connect'], timeout => 10);
+    if ($current->{rc} == 0 && index($current->{out}, '--> on') >= 0) {
+        _status_done('already on');
+        $results{selinux} = 'on';
+        return \%results;
+    }
+
+    if ($dry_run) {
+        _status_done('would set on');
+        $results{selinux} = 'dry run';
+        return \%results;
+    }
+
+    # -P persists across reboots; the policy rebuild can take a while.
+    my $set_result = run([$setsebool, '-P', 'httpd_can_network_connect=1'], timeout => 180);
+    if ($set_result->{rc} == 0) {
+        _status_done('set on');
+        $results{selinux} = 'on';
+    }
+    else {
+        _status_done('failed');
+        my $err = $set_result->{err};
+        $err =~ s/\s+$//;
+        _warn("setsebool failed: $err");
+        $results{selinux} = 'failed';
+    }
+
+    return \%results;
+}
+
+# ---------------------------------------------------------------------------
+# 8. nginx configuration
+# ---------------------------------------------------------------------------
+
+# Return the nginx server block content.
+#
+# HTTP/1.1 with an empty Connection header and proxy_buffering off are required for
+# the engine's SSE streaming: nginx's defaults (HTTP/1.0, buffering on) would hold a
+# whole streamed completion until generation finishes.  The IPv6 listener is emitted
+# only when the kernel actually has IPv6 enabled (the same check as detect_loopback);
+# socket() on [::]:443 would otherwise fail with EAFNOSUPPORT and take nginx down.
+sub nginx_conf_content {
+    my ($port, $upstream_host, $cert_dir) = @_;
+    my $ipv6_listen = -e '/proc/net/if_inet6' ? "listen [::]:443 ssl;\n    " : '';
+    return <<"CONF";
+server {
+    ${ipv6_listen}listen 443 ssl;
+    server_name _;
+
+    ssl_certificate $cert_dir/$CONTAINER_NAME.crt;
+    ssl_certificate_key $cert_dir/$CONTAINER_NAME.key;
+    ssl_protocols TLSv1.2 TLSv1.3;
+
+    client_max_body_size 50m;
+
+    location / {
+        proxy_pass http://$upstream_host:$port;
+        proxy_http_version 1.1;
+        proxy_set_header Connection "";
+        proxy_set_header Host \$host;
+        proxy_set_header X-Real-IP \$remote_addr;
+        proxy_set_header X-Forwarded-For \$proxy_add_x_forwarded_for;
+        proxy_set_header X-Forwarded-Proto \$scheme;
+        proxy_buffering off;
+        proxy_read_timeout 300s;
+        proxy_send_timeout 300s;
+    }
+}
+CONF
+}
+
+sub nginx_conf_path {
+    my ($service_name) = @_;
+    return "/etc/nginx/conf.d/$service_name.conf";
+}
+
+sub setup_nginx {
+    my ($port, $upstream_host, $cert_dir, $service_name, $dry_run) = @_;
+    my %results;
+    my $conf_path = nginx_conf_path($service_name);
+    my $desired_content = nginx_conf_content($port, $upstream_host, $cert_dir);
+
+    # Write the nginx config if it is missing or different.
+    _status('Checking nginx configuration');
+    if (-f $conf_path) {
+        my $current = slurp($conf_path);
+        $current =~ s/^\s+//;
+        $current =~ s/\s+$//;
+        my $desired = $desired_content;
+        $desired =~ s/^\s+//;
+        $desired =~ s/\s+$//;
+        if ($current eq $desired) {
+            _status_done('already configured');
+            $results{nginx_configured} = 1;
+        }
+        elsif ($dry_run) {
+            _status_done('would update');
+            $results{nginx_configured} = 'dry run';
+        }
+        elsif (write_file($conf_path, $desired_content)) {
+            _status_done('updated');
+            $results{nginx_configured} = 1;
+        }
+        else {
+            _status_done('failed');
+            _fail("Could not write $conf_path: " . os_error_text($conf_path));
+            $results{nginx_configured} = 0;
+        }
+    }
+    elsif ($dry_run) {
+        _status_done('would create');
+        $results{nginx_configured} = 'dry run';
+    }
+    elsif (write_file($conf_path, $desired_content)) {
+        _status_done('created');
+        $results{nginx_configured} = 1;
+    }
+    else {
+        _status_done('failed');
+        _fail("Could not write $conf_path: " . os_error_text($conf_path));
+        $results{nginx_configured} = 0;
+    }
+
+    # Ensure nginx is enabled and running (handles the enabled-but-stopped case).
+    _status('Ensuring nginx service is enabled and running');
+    my $nginx_running = systemctl_is_active('nginx');
+    if (systemctl_is_enabled('nginx') && $nginx_running) {
+        _status_done('running');
+        $results{nginx_running} = 1;
+    }
+    elsif ($dry_run) {
+        _status_done('dry run');
+        $results{nginx_running} = 'dry run';
+    }
+    else {
+        my $start_result = systemctl_is_enabled('nginx')
+            ? run(['systemctl', 'start', 'nginx'], timeout => 30)
+            : run(['systemctl', 'enable', '--now', 'nginx'], timeout => 30);
+        if ($start_result->{rc} == 0) {
+            _status_done('enabled and started');
+            $results{nginx_running} = 1;
+        }
+        else {
+            _status_done('failed');
+            my $err = $start_result->{err};
+            $err =~ s/\s+$//;
+            _warn("Could not start nginx: $err");
+            $results{nginx_running} = 0;
+        }
+    }
+
+    # Test and reload the configuration (only possible when nginx is running).
+    _status('Reloading nginx configuration');
+    if ($dry_run) {
+        _status_done('dry run');
+        $results{nginx_reloaded} = 'dry run';
+    }
+    elsif (!$results{nginx_running}) {
+        _status_done('skipped (nginx not running)');
+        $results{nginx_reloaded} = 0;
+    }
+    else {
+        my $test_result = run(['nginx', '-t'], timeout => 30);
+        if ($test_result->{rc} != 0) {
+            _status_done('config test failed');
+            my $err = $test_result->{err};
+            $err =~ s/\s+$//;
+            _fail("nginx -t failed: $err");
+            $results{nginx_reloaded} = 0;
+        }
+        else {
+            my $reload_result = run(['systemctl', 'reload', 'nginx'], timeout => 30);
+            if ($reload_result->{rc} == 0) {
+                _status_done('reloaded');
+                $results{nginx_reloaded} = 1;
+            }
+            else {
+                _status_done('failed');
+                my $err = $reload_result->{err};
+                $err =~ s/\s+$//;
+                _fail("nginx reload failed: $err");
+                $results{nginx_reloaded} = 0;
+            }
+        }
+    }
+
+    return \%results;
+}
+
+# ---------------------------------------------------------------------------
+# 9. systemd service
+# ---------------------------------------------------------------------------
+
+# Return the systemd unit file content.
+#
+# The API key is substituted by systemd from the EnvironmentFile (${SGLANG_API_KEY}),
+# so the key never appears in the unit file itself.
+sub systemd_content {
+    my ($opts) = @_;
+    my $podman = find_exe('podman') // '/usr/bin/podman';
+    my $image  = $opts->{image};
+    my $cache  = "$opts->{state_dir}/$CACHE_SUBDIR";
+
+    my @env_lines = map { "Environment=$_\n" } @{ $opts->{radeon_env} };
+    my $env_block = join('', @env_lines);
+
+    return <<"UNIT";
+[Unit]
+Description=SGLang Inference Server ($opts->{model})
+After=network-online.target
+Wants=network-online.target
+
+[Service]
+Type=simple
+Environment=PYTHONUNBUFFERED=1
+Environment=SGLANG_USE_MODELSCOPE=true
+${env_block}EnvironmentFile=$opts->{env_file}
+ExecStart=$podman run --rm --replace --name $CONTAINER_NAME \\
+  --network=host \\
+  --pull=missing \\
+  --device=/dev/kfd --device=/dev/dri \\
+  --group-add video \\
+  --ipc=host \\
+  --cap-add=SYS_PTRACE \\
+  --security-opt seccomp=unconfined \\
+  --volume $cache:$CACHE_MOUNT:Z \\
+  --env MODELSCOPE_TOKEN \\
+  $image \\
+  python3 -m sglang.launch_server \\
+  --model-path $opts->{model} \\
+  --host $opts->{host} \\
+  --port $opts->{port} \\
+  --api-key \${SGLANG_API_KEY} \\
+  --tp-size $opts->{tensor_parallel} \\
+  --context-length $opts->{max_model_len} \\
+  --mem-fraction-static $opts->{gpu_memory_utilization}
+Restart=on-failure
+RestartSec=10
+
+[Install]
+WantedBy=multi-user.target
+UNIT
+}
+
+sub setup_systemd {
+    my ($opts, $dry_run) = @_;
+    my %results;
+    my $service_name = $opts->{service_name};
+    my $unit_path = "/etc/systemd/system/$service_name.service";
+    my $env_file = "/etc/sysconfig/$service_name";
+    my %unit_opts = (%$opts, env_file => $env_file);
+    my $desired_content = systemd_content(\%unit_opts);
+
+    # Write the unit file if it is missing or different.
+    my $unit_changed = 0;
+    _status("Checking $service_name.service unit file");
+    if (-f $unit_path) {
+        my $current = slurp($unit_path);
+        $current =~ s/^\s+//;
+        $current =~ s/\s+$//;
+        my $desired = $desired_content;
+        $desired =~ s/^\s+//;
+        $desired =~ s/\s+$//;
+        if ($current eq $desired) {
+            _status_done('already configured');
+            $results{unit_configured} = 1;
+        }
+        elsif ($dry_run) {
+            _status_done('would update');
+            $results{unit_configured} = 'dry run';
+        }
+        elsif (write_file($unit_path, $desired_content)) {
+            _status_done('updated');
+            $results{unit_configured} = 1;
+            $unit_changed = 1;
+        }
+        else {
+            _status_done('failed');
+            _fail("Could not write $unit_path: " . os_error_text($unit_path));
+            $results{unit_configured} = 0;
+        }
+    }
+    elsif ($dry_run) {
+        _status_done('would create');
+        $results{unit_configured} = 'dry run';
+    }
+    elsif (write_file($unit_path, $desired_content)) {
+        _status_done('created');
+        $results{unit_configured} = 1;
+        $unit_changed = 1;
+    }
+    else {
+        _status_done('failed');
+        _fail("Could not write $unit_path: " . os_error_text($unit_path));
+        $results{unit_configured} = 0;
+    }
+    $results{unit_changed} = $unit_changed;
+
+    # systemctl daemon-reload.
+    _status('Reloading systemd daemon');
+    if ($dry_run) {
+        _status_done('dry run');
+    }
+    else {
+        my $reload_result = run(['systemctl', 'daemon-reload'], timeout => 30);
+        if ($reload_result->{rc} != 0) {
+            _status_done('failed');
+            my $err = $reload_result->{err};
+            $err =~ s/\s+$//;
+            _fail("daemon-reload failed: $err");
+            $results{unit_configured} = 0;
+        }
+        else {
+            _status_done('ok');
+        }
+    }
+
+    # Enable the service.
+    _status("Enabling $service_name service");
+    if (systemctl_is_enabled($service_name)) {
+        _status_done('already enabled');
+        $results{service_enabled} = 1;
+    }
+    elsif ($dry_run) {
+        _status_done('dry run');
+        $results{service_enabled} = 'dry run';
+    }
+    else {
+        my $enable_result = run(['systemctl', 'enable', $service_name], timeout => 30);
+        if ($enable_result->{rc} == 0) {
+            _status_done('enabled');
+            $results{service_enabled} = 1;
+        }
+        else {
+            _status_done('failed');
+            my $err = $enable_result->{err};
+            $err =~ s/\s+$//;
+            _fail("systemctl enable failed: $err");
+            $results{service_enabled} = 0;
+        }
+    }
+
+    # Start the service, or restart it when the unit changed underneath it.
+    _status("Starting $service_name service");
+    my $is_active = systemctl_is_active($service_name);
+    if ($dry_run) {
+        _status_done('dry run');
+        $results{service_started} = 'dry run';
+    }
+    elsif ($is_active && $unit_changed) {
+        my $restart_result = run(['systemctl', 'try-restart', $service_name], timeout => 60);
+        if ($restart_result->{rc} == 0) {
+            _status_done('restarted (unit changed)');
+            $results{service_started} = 'restarted';
+        }
+        else {
+            _status_done('failed');
+            my $err = $restart_result->{err};
+            $err =~ s/\s+$//;
+            _fail("systemctl try-restart failed: $err "
+                . "(check logs with: journalctl -u $service_name -f)");
+            $results{service_started} = 0;
+        }
+    }
+    elsif ($is_active) {
+        _status_done('already running');
+        $results{service_started} = 1;
+    }
+    else {
+        my $start_result = run(['systemctl', 'start', $service_name], timeout => 30);
+        if ($start_result->{rc} == 0) {
+            _status_done('started');
+            $results{service_started} = 1;
+        }
+        else {
+            _status_done('failed');
+            my $err = $start_result->{err};
+            $err =~ s/\s+$//;
+            _fail("systemctl start failed: $err "
+                . "(check logs with: journalctl -u $service_name -f)");
+            $results{service_started} = 0;
+        }
+    }
+
+    return \%results;
+}
+
+# ---------------------------------------------------------------------------
+# 10. Firewall
+# ---------------------------------------------------------------------------
+
+sub setup_firewall {
+    my ($dry_run) = @_;
+    my %results;
+
+    _status('Checking firewalld');
+    my $fw_result = run(['systemctl', 'is-active', '--quiet', 'firewalld'], timeout => 10);
+    if ($fw_result->{rc} != 0) {
+        _status_done('not running (skipping)');
+        $results{firewall_active} = 0;
+        return \%results;
+    }
+
+    _status_done('active');
+
+    # Check whether the https service is already allowed.
+    _status('Checking HTTPS firewall rule');
+    my $list_result = run(['firewall-cmd', '--permanent', '--list-services'], timeout => 30);
+    if ($list_result->{rc} == 0 && grep { $_ eq 'https' } split /\s+/, $list_result->{out}) {
+        _status_done('already allowed');
+        $results{firewall_configured} = 1;
+        return \%results;
+    }
+
+    if ($dry_run) {
+        _status_done('dry run');
+        $results{firewall_configured} = 'dry run';
+        return \%results;
+    }
+
+    # Add the https service.
+    my $add_result = run(['firewall-cmd', '--permanent', '--add-service=https'], timeout => 30);
+    if ($add_result->{rc} != 0) {
+        _status_done('failed');
+        my $err = $add_result->{err};
+        $err =~ s/\s+$//;
+        _warn("firewall-cmd failed: $err");
+        $results{firewall_configured} = 0;
+        return \%results;
+    }
+
+    # Reload to apply: a failed reload leaves the rule inactive.
+    my $reload_result = run(['firewall-cmd', '--reload'], timeout => 30);
+    if ($reload_result->{rc} == 0) {
+        _status_done('added (permanent)');
+        $results{firewall_configured} = 1;
+    }
+    else {
+        _status_done('failed');
+        my $err = $reload_result->{err};
+        $err =~ s/\s+$//;
+        _warn("firewall-cmd --reload failed: $err "
+            . "(the rule is stored permanently but not active)");
+        $results{firewall_configured} = 0;
+    }
+
+    return \%results;
+}
+
+# ---------------------------------------------------------------------------
+# 11. Uninstall
+# ---------------------------------------------------------------------------
+
+# Tear down the SGLang deployment.
+#
+# Deliberately kept (documented at the end): the image, <state-dir> with the
+# ModelScope cache of downloaded weights, the firewalld https rule, and the SELinux
+# boolean.
+sub uninstall {
+    my ($opts, $dry_run) = @_;
+    my %results;
+    my $service_name = $opts->{service_name};
+    my $state_dir = $opts->{state_dir};
+    my $cert_dir = $opts->{cert_dir};
+
+    # Stop and disable the systemd service.
+    _status("Stopping $service_name service");
+    if (systemctl_is_active($service_name) || systemctl_is_enabled($service_name)) {
+        if ($dry_run) {
+            _status_done('dry run');
+        }
+        else {
+            my $stop_result = run(['systemctl', 'stop', $service_name], timeout => 60);
+            my $disable_result = run(['systemctl', 'disable', $service_name], timeout => 30);
+            if ($stop_result->{rc} != 0 || $disable_result->{rc} != 0) {
+                _status_done('failed');
+                my $stop_err = $stop_result->{err};
+                $stop_err =~ s/\s+$//;
+                my $disable_err = $disable_result->{err};
+                $disable_err =~ s/\s+$//;
+                _warn("stop/disable failed (stop: " . (length $stop_err ? $stop_err : 'ok')
+                    . ", disable: " . (length $disable_err ? $disable_err : 'ok')
+                    . "), continuing cleanup");
+                $results{service_stopped} = 0;
+            }
+            else {
+                _status_done('stopped and disabled');
+                $results{service_stopped} = 1;
+            }
+        }
+    }
+    else {
+        _status_done('not running');
+        $results{service_not_found} = 1;
+    }
+
+    # Remove systemd unit file.
+    my $unit_path = "/etc/systemd/system/$service_name.service";
+    _status("Removing $service_name.service unit file");
+    if (-f $unit_path) {
+        if ($dry_run) {
+            _status_done('dry run');
+        }
+        else {
+            unlink($unit_path);
+            run(['systemctl', 'daemon-reload'], timeout => 30);
+            _status_done('removed');
+            $results{unit_removed} = 1;
+        }
+    }
+    else {
+        _status_done('not present');
+        $results{unit_not_found} = 1;
+    }
+
+    # Remove a container the engine left behind (podman run removes it on a clean
+    # stop; a killed podman leaves one).
+    _status('Removing the engine container');
+    if (podman_container_exists($CONTAINER_NAME)) {
+        if ($dry_run) {
+            _status_done('dry run');
+        }
+        else {
+            my $rm_result = run(['podman', 'rm', '-f', $CONTAINER_NAME], timeout => 60);
+            if ($rm_result->{rc} == 0) {
+                _status_done('removed');
+                $results{container_removed} = 1;
+            }
+            else {
+                _status_done('failed');
+                my $err = $rm_result->{err};
+                $err =~ s/\s+$//;
+                _warn("podman rm -f failed: $err");
+                $results{container_removed} = 0;
+            }
+        }
+    }
+    else {
+        _status_done('not present');
+        $results{container_not_found} = 1;
+    }
+
+    # Remove the API key environment file.
+    my $env_path = "/etc/sysconfig/$service_name";
+    _status('Removing API key environment file');
+    if (-f $env_path) {
+        if ($dry_run) {
+            _status_done('dry run');
+        }
+        else {
+            unlink($env_path);
+            _status_done('removed');
+            $results{env_removed} = 1;
+        }
+    }
+    else {
+        _status_done('not present');
+        $results{env_not_found} = 1;
+    }
+
+    # Remove the nginx config.
+    my $nginx_conf = nginx_conf_path($service_name);
+    _status("Removing nginx $service_name configuration");
+    if (-f $nginx_conf) {
+        if ($dry_run) {
+            _status_done('dry run');
+        }
+        else {
+            unlink($nginx_conf);
+            my $reload_result = run(['systemctl', 'reload', 'nginx'], timeout => 30);
+            if ($reload_result->{rc} != 0) {
+                _status_done('removed (nginx reload failed)');
+                my $err = $reload_result->{err};
+                $err =~ s/\s+$//;
+                _warn("nginx reload failed: $err");
+            }
+            else {
+                _status_done('removed and nginx reloaded');
+            }
+            $results{nginx_removed} = 1;
+        }
+    }
+    else {
+        _status_done('not present');
+        $results{nginx_not_found} = 1;
+    }
+
+    # Remove the TLS certificates.
+    _status('Removing TLS certificates');
+    if (-d $cert_dir) {
+        if ($dry_run) {
+            _status_done('dry run');
+        }
+        else {
+            # Remove the individual files first, then the directory.
+            for my $fname ("$CONTAINER_NAME.key", "$CONTAINER_NAME.crt") {
+                my $fpath = "$cert_dir/$fname";
+                unlink($fpath) if -f $fpath;
+            }
+            rmdir($cert_dir);
+            _status_done('removed');
+            $results{certs_removed} = 1;
+        }
+    }
+    else {
+        _status_done('not present');
+        $results{certs_not_found} = 1;
+    }
+
+    # What deliberately persists after an uninstall.
+    print STDERR "\n";
+    _info('Kept on the system (remove manually if unwanted):');
+    _info("  the engine image (podman rmi <image>)");
+    _info("  $state_dir (ModelScope cache with downloaded model weights)");
+    _info("  firewalld 'https' rule and the SELinux httpd_can_network_connect boolean");
+
+    return \%results;
+}
+
+# ---------------------------------------------------------------------------
+# Summary
+# ---------------------------------------------------------------------------
+
+sub print_summary {
+    my ($opts) = @_;
+    my $results = $opts->{results};
+    my $warnings = $opts->{warnings};
+    my $service_name = $opts->{service_name};
+    my $port = $opts->{port};
+    my $mode = $opts->{uninstall_mode} ? 'Uninstall' : ($opts->{dry_run} ? 'Dry Run' : 'Setup');
+
+    print STDERR "\n${BOLD}── $mode Summary ──${RESET}\n";
+    print STDERR "  OS: $opts->{os_display} $opts->{version_id}\n";
+
+    if ($opts->{uninstall_mode}) {
+        my $ur = $results->{uninstall} // {};
+        for my $pair (
+            ['service_stopped',    'SGLang service stopped'],
+            ['unit_removed',       'systemd unit removed'],
+            ['container_removed',  'engine container removed'],
+            ['env_removed',        'API key environment file removed'],
+            ['nginx_removed',      'nginx config removed'],
+            ['certs_removed',      'TLS certificates removed'],
+        ) {
+            my ($key, $label) = @$pair;
+            next unless defined $ur->{$key};
+            # A step that ran and failed reports failure: 0 is a recorded
+            # outcome, not an absent one.
+            if ($ur->{$key} eq 1) { _ok($label) }
+            else                  { _fail($label) }
+        }
+        for my $pair (
+            ['service_not_found',   'SGLang service: already absent'],
+            ['unit_not_found',      'systemd unit: already absent'],
+            ['container_not_found', 'engine container: already absent'],
+            ['env_not_found',       'API key environment file: already absent'],
+            ['nginx_not_found',     'nginx config: already absent'],
+            ['certs_not_found',     'TLS certs: already absent'],
+        ) {
+            my ($key, $label) = @$pair;
+            _info($label) if exists $ur->{$key};
+        }
+    }
+    else {
+        # Deploy summary.
+        _ok('Model: ' . model_display($opts->{model}));
+
+        my $sd = $results->{system_deps} // {};
+        my $installed = scalar @{ $sd->{installed} // [] };
+        my $skipped = scalar @{ $sd->{skipped} // [] };
+        my $failed_pkgs = scalar @{ $sd->{failed} // [] };
+        if ($opts->{dry_run}) {
+            _ok("System packages: $skipped present, $installed would be installed");
+        }
+        else {
+            _ok("System packages: $skipped already present, $installed installed");
+        }
+        _fail("  $failed_pkgs package(s) failed to install") if $failed_pkgs;
+
+        my $pf = $results->{preflight} // {};
+        if (my $image = $pf->{engine_image}) {
+            _ok("Engine image: $image");
+            if ($pf->{radeon_dev}) {
+                _info('AMD publishes this build daily: a rerun takes the newest one, '
+                    . 'and --image pins a single build');
+            }
+        }
+        my $rocm = $pf->{rocm_version};
+        if (($pf->{rocm_flavour} // '') eq 'from --image') {
+            _info('Host ROCm: ' . (defined $rocm ? $rocm : 'none')
+                . ' (image from --image)');
+        }
+        elsif (defined $rocm) {
+            _info("Host ROCm: $rocm (image flavour $pf->{rocm_flavour})");
+        }
+        else {
+            _info("Host ROCm: none, the image carries it (flavour $pf->{rocm_flavour})");
+        }
+
+        my $image_state = $results->{image} // {};
+        if ($image_state->{image_present}) {
+            _ok('Engine image: already present');
+        }
+        elsif ($image_state->{image_pulled} && $image_state->{image_pulled} ne 'dry run') {
+            _ok('Engine image: pulled');
+        }
+        elsif ($image_state->{image_pulled} && $image_state->{image_pulled} eq 'dry run') {
+            _info('Engine image: would be pulled');
+        }
+        elsif (($image_state->{image_pulled} // 1) == 0) {
+            _fail('Engine image: pull failed');
+        }
+
+        my $state = $results->{state_dir} // {};
+        if ($state->{state_dir_exists}) {
+            _ok("Model cache: $opts->{state_dir}/$CACHE_SUBDIR (existing)");
+        }
+        elsif ($state->{state_dir_created} && $state->{state_dir_created} ne 'dry run') {
+            _ok("Model cache: $opts->{state_dir}/$CACHE_SUBDIR (created)");
+        }
+        elsif ($state->{state_dir_created} && $state->{state_dir_created} eq 'dry run') {
+            _info("Model cache: would create $opts->{state_dir}/$CACHE_SUBDIR");
+        }
+
+        my $tls = $results->{tls} // {};
+        if ($tls->{cert_exists} || ($tls->{cert_created} // '') eq 1) {
+            _ok('TLS certificate: configured (self-signed, 365-day validity)');
+        }
+        elsif (($tls->{cert_created} // '') eq 'dry run') {
+            _info('TLS: would generate a self-signed certificate (SAN from the host FQDN)');
+        }
+
+        my $ak = $results->{api_key} // {};
+        my $env_state = $ak->{env_file};
+        if ($opts->{generated_api_key}) {
+            _ok("API key: stored in /etc/sysconfig/$service_name (0600 root:root)");
+            print STDERR "  ${YELLOW}${BOLD}API key (shown once, store it securely): "
+                . "$opts->{generated_api_key}${RESET}\n";
+        }
+        elsif ($env_state && $env_state eq 'exists') {
+            _ok('API key: existing key reused');
+        }
+        elsif ($env_state && $env_state eq 'updated') {
+            _ok('API key: updated from --api-key');
+        }
+        elsif ($env_state && $env_state eq 'created') {
+            _ok("API key: stored in /etc/sysconfig/$service_name (0600 root:root)");
+        }
+        elsif ($env_state && $env_state eq 'dry run') {
+            _info("API key: would generate/store in /etc/sysconfig/$service_name (0600)");
+        }
+        elsif ($env_state && $env_state eq 'failed') {
+            _fail('API key: could not write the environment file');
+        }
+
+        my $se = ($results->{selinux} // {})->{selinux};
+        if ($se && $se eq 'on') {
+            _ok('SELinux: httpd_can_network_connect on');
+        }
+        elsif ($se && $se eq 'dry run') {
+            _info('SELinux: would set httpd_can_network_connect=1');
+        }
+        elsif ($se && $se eq 'failed') {
+            _fail('SELinux: failed to set httpd_can_network_connect');
+        }
+        elsif ($se && ($se eq 'permissive' || $se eq 'disabled')) {
+            _info("SELinux: $se (skipped)");
+        }
+        elsif ($se && $se eq 'absent') {
+            _info('SELinux: not installed (skipped)');
+        }
+
+        my $ng = $results->{nginx} // {};
+        if ($ng->{nginx_configured} && $ng->{nginx_configured} eq 1
+            && $ng->{nginx_reloaded} && $ng->{nginx_reloaded} eq 1) {
+            _ok('nginx: configured and reloaded');
+        }
+        elsif ($ng->{nginx_configured} && $ng->{nginx_configured} eq 1) {
+            _fail('nginx: config written but reload failed');
+        }
+        elsif (($ng->{nginx_configured} // '') eq 'dry run') {
+            _info('nginx: would write config and reload');
+        }
+
+        my $svc = $results->{systemd} // {};
+        my $started = $svc->{service_started};
+        my $bind_host = $opts->{bind_host};
+        my $disp = index($bind_host, ':') >= 0 ? "[$bind_host]:$port" : "$bind_host:$port";
+        if (defined $started && ($started eq 1 || $started eq 'restarted')) {
+            my $verb = $started eq 'restarted' ? 'restarted with an updated unit' : 'running';
+            _ok("systemd: $service_name $verb on $disp");
+            _info('First load takes minutes. Verify: curl -fk https://localhost/health (retry)');
+        }
+        elsif (defined $started && $started eq 0) {
+            _fail("systemd: $service_name failed to start");
+        }
+        elsif (defined $started && $started eq 'dry run') {
+            _info("systemd: would enable and start $service_name");
+        }
+
+        my $fw = $results->{firewall} // {};
+        if (defined $fw->{firewall_active} && $fw->{firewall_active} eq 0) {
+            _info('Firewall: firewalld not running (skipped)');
+        }
+        elsif ($fw->{firewall_configured} && $fw->{firewall_configured} eq 1) {
+            _ok('Firewall: HTTPS (443) allowed');
+        }
+        elsif (defined $fw->{firewall_configured} && $fw->{firewall_configured} eq 0) {
+            _fail('Firewall: failed to allow HTTPS (443)');
+        }
+        elsif (($fw->{firewall_configured} // '') eq 'dry run') {
+            _info('Firewall: would allow HTTPS (443)');
+        }
+    }
+
+    if (@$warnings) {
+        print STDERR "\n";
+        _warn($_) for @$warnings;
+    }
+
+    print STDERR "\n${BOLD}" . ('═' x 60) . "${RESET}\n";
+    print STDERR "  ${BOLD}Total time: " . sprintf('%.1f', $opts->{elapsed}) . "s${RESET}\n";
+    print STDERR "${BOLD}" . ('═' x 60) . "${RESET}\n\n";
+    return;
+}
+
+# ---------------------------------------------------------------------------
+# CLI
+# ---------------------------------------------------------------------------
+
+sub usage {
+    my $text = <<"USAGE";
+Usage: sglang-deploy.pl [options]
+
+  --model ID                     ModelScope model ID (menu when omitted)
+  --port N                       internal engine port (default: $INTERNAL_PORT, not 443)
+  --tensor-parallel N            GPUs for tensor parallelism (default: 1, written as
+                                 the engine's --tp-size)
+  --max-model-len N              context length (default: 4096, written as the
+                                 engine's --context-length)
+  --gpu-memory-utilization F     static memory fraction (default: 0.90, written as
+                                 the engine's --mem-fraction-static)
+  --state-dir PATH               state and model cache directory (default: $DEFAULT_STATE_DIR)
+  --service-name NAME            systemd service name (default: $DEFAULT_SERVICE)
+  --cert-dir PATH                TLS certificate directory (default: $DEFAULT_CERT_DIR)
+  --image TAG                    engine image (default: resolved from the GPU and
+                                 the newest SGLang release; a Radeon card resolves
+                                 AMD's newest dated gfx1151 build)
+  --rocm-flavour NAME            ROCm flavour of the image (default: from the host
+                                 ROCm; rocm10, rocm724, rocm720 or rocm700)
+  --api-key KEY                  API key for the endpoint (default: generate and
+                                 store in /etc/sysconfig)
+  --dry-run                      preview without making changes
+  --uninstall                    tear down the service, container, nginx config
+                                 and certificates
+  --help                         show this help
+  --version                      show the version
+USAGE
+    print STDERR $text;
+    return;
+}
+
+sub parse_args {
+    my %args = (
+        model                  => undef,
+        port                   => $INTERNAL_PORT,
+        tensor_parallel        => 1,
+        max_model_len          => 4096,
+        gpu_memory_utilization => '0.9',
+        state_dir              => $DEFAULT_STATE_DIR,
+        service_name           => $DEFAULT_SERVICE,
+        cert_dir               => $DEFAULT_CERT_DIR,
+        image                  => '',
+        rocm_flavour           => '',
+        api_key                => undef,
+        dry_run                => 0,
+        uninstall              => 0,
+    );
+    my %takes_value = map { $_ => 1 } qw(
+        model port tensor-parallel max-model-len gpu-memory-utilization
+        state-dir service-name cert-dir image rocm-flavour api-key
+    );
+
+    my $i = 0;
+    while ($i < @ARGV) {
+        my $arg = $ARGV[$i];
+        my $name = $arg;
+        my $inline;
+        if ($arg =~ /^--([^=]+)=(.*)$/s) {
+            ($name, $inline) = ("--$1", $2);
+        }
+        if ($name eq '--help') {
+            usage();
+            exit 0;
+        }
+        if ($name eq '--version') {
+            print "sglang-deploy.pl $VERSION\n";
+            exit 0;
+        }
+        if ($name eq '--dry-run') {
+            $args{dry_run} = 1;
+            $i++;
+            next;
+        }
+        if ($name eq '--uninstall') {
+            $args{uninstall} = 1;
+            $i++;
+            next;
+        }
+        if ($name !~ /^--([a-z-]+)$/ || !$takes_value{$1}) {
+            _fail("Unknown option: $arg");
+            usage();
+            exit 2;
+        }
+        my $key = $1;
+        my $value = $inline;
+        if (!defined $value) {
+            $i++;
+            if ($i >= @ARGV) {
+                _fail("Option $name needs a value");
+                exit 2;
+            }
+            $value = $ARGV[$i];
+        }
+        if ($key eq 'model')                 { $args{model} = $value }
+        elsif ($key eq 'port')               { $args{port} = $value }
+        elsif ($key eq 'tensor-parallel')    { $args{tensor_parallel} = $value }
+        elsif ($key eq 'max-model-len')      { $args{max_model_len} = $value }
+        elsif ($key eq 'gpu-memory-utilization') { $args{gpu_memory_utilization} = $value }
+        elsif ($key eq 'state-dir')          { $args{state_dir} = $value }
+        elsif ($key eq 'service-name')       { $args{service_name} = $value }
+        elsif ($key eq 'cert-dir')           { $args{cert_dir} = $value }
+        elsif ($key eq 'image')              { $args{image} = $value }
+        elsif ($key eq 'rocm-flavour')       { $args{rocm_flavour} = $value }
+        elsif ($key eq 'api-key')            { $args{api_key} = $value }
+        $i++;
+    }
+
+    return %args;
+}
+
+sub model_display {
+    my ($model) = @_;
+    return $MODEL_NAMES{$model} // $model;
+}
+
+sub prompt_model {
+    my ($args) = @_;
+    # Under `curl | sudo perl` stdin is the pipe the script itself arrived on; the
+    # read would hit EOF instantly and look like a cancel.
+    if (!-t STDIN) {
+        _fail('Interactive model selection needs a terminal: pass --model instead');
+        exit 2;
+    }
+    print STDERR "\n${BOLD}Select a model to deploy:${RESET}\n\n";
+    my $i = 0;
+    for my $name (@DEFAULT_MODEL_ORDER) {
+        $i++;
+        print STDERR "  ${GREEN}$i${RESET}. $name\n";
+    }
+    print STDERR "  ${DIM}" . ($i + 1) . ". Enter a custom model ID${RESET}\n\n";
+
+    print STDERR "  Choice [${GREEN}1${RESET}]: ";
+    my $choice = <STDIN>;
+    if (!defined $choice) {
+        print STDERR "\nCancelled.\n";
+        exit 130;
+    }
+    $choice =~ s/^\s+//;
+    $choice =~ s/\s+$//;
+    $choice = '1' if $choice eq '';
+
+    if ($choice !~ /^\d+$/) {
+        print STDERR "${RED}Invalid input.${RESET}\n";
+        exit 1;
+    }
+    my $idx = $choice + 0;
+    if ($idx >= 1 && $idx <= @DEFAULT_MODEL_ORDER) {
+        $args->{model} = $DEFAULT_MODELS{ $DEFAULT_MODEL_ORDER[$idx - 1] };
+    }
+    elsif ($idx == @DEFAULT_MODEL_ORDER + 1) {
+        print STDERR "  Model ID: ";
+        my $custom = <STDIN>;
+        if (!defined $custom) {
+            print STDERR "\nCancelled.\n";
+            exit 130;
+        }
+        $custom =~ s/^\s+//;
+        $custom =~ s/\s+$//;
+        if ($custom eq '') {
+            print STDERR "${RED}Model ID cannot be empty.${RESET}\n";
+            exit 1;
+        }
+        $args->{model} = $custom;
+    }
+    else {
+        print STDERR "${RED}Invalid choice.${RESET}\n";
+        exit 1;
+    }
+    return;
+}
+
+sub is_number {
+    my ($value) = @_;
+    return defined $value && $value =~ /^-?\d+(?:\.\d+)?(?:[eE][-+]?\d+)?$/;
+}
+
+# A positive integer: the port, the context length and the tensor parallel size
+# are counts, so the fractional and exponent forms is_number accepts must not
+# reach the engine's command line.
+sub is_positive_int {
+    my ($value) = @_;
+    return defined $value && $value =~ /^\d+$/ && $value + 0 > 0;
+}
+
+# A directory the generated nginx configuration and the unit file carry
+# verbatim: absolute, and free of the whitespace that splits arguments, of the
+# % systemd expands as a specifier and of the ; that ends an nginx directive.
+sub valid_dir_path {
+    my ($path) = @_;
+    return 0 unless defined $path && length $path;
+    return 0 unless substr($path, 0, 1) eq '/';
+    return $path !~ /[\s%;]/;
+}
+
+sub validate_args {
+    my ($args) = @_;
+    if ($args->{service_name} !~ /^[A-Za-z0-9_.\@-]+$/) {
+        _fail("Invalid --service-name: '$args->{service_name}'");
+        exit 1;
+    }
+    if (length $args->{image} && $args->{image} =~ /[\s%]/) {
+        _fail("Invalid --image: '$args->{image}' (whitespace and % are not allowed)");
+        exit 1;
+    }
+    if (!valid_dir_path($args->{state_dir})) {
+        _fail("Invalid --state-dir: '$args->{state_dir}' (an absolute path without "
+            . "whitespace, % or ;)");
+        exit 1;
+    }
+    if (!valid_dir_path($args->{cert_dir})) {
+        _fail("Invalid --cert-dir: '$args->{cert_dir}' (an absolute path without "
+            . "whitespace, % or ;)");
+        exit 1;
+    }
+    if (length $args->{rocm_flavour}
+        && !grep { $_->[0] eq $args->{rocm_flavour} } @ROCM_FLAVOURS) {
+        _fail("Invalid --rocm-flavour: '$args->{rocm_flavour}' (expected one of "
+            . join(', ', map { $_->[0] } @ROCM_FLAVOURS));
+        exit 1;
+    }
+    return if $args->{uninstall};
+
+    if (!defined $args->{model} || $args->{model} !~ $MODEL_ID_RE) {
+        my $shown = defined $args->{model} ? $args->{model} : '';
+        _fail("Invalid model ID: '$shown' (expected 'org/name', "
+            . "letters, digits, dot, dash, underscore only)");
+        exit 1;
+    }
+    if (!is_positive_int($args->{port}) || $args->{port} + 0 > 65535
+        || $args->{port} + 0 == 443) {
+        _fail("Invalid --port $args->{port}: must be an integer 1-65535 and not 443 "
+            . "(nginx)");
+        exit 1;
+    }
+    if (!is_number($args->{gpu_memory_utilization})
+        || $args->{gpu_memory_utilization} + 0 <= 0
+        || $args->{gpu_memory_utilization} + 0 > 1) {
+        _fail("Invalid --gpu-memory-utilization $args->{gpu_memory_utilization} "
+            . ": must be in (0, 1]");
+        exit 1;
+    }
+    if (!is_positive_int($args->{max_model_len})) {
+        _fail("Invalid --max-model-len $args->{max_model_len}: must be a positive "
+            . "integer");
+        exit 1;
+    }
+    if (!is_positive_int($args->{tensor_parallel})) {
+        _fail("Invalid --tensor-parallel $args->{tensor_parallel}: must be a positive "
+            . "integer");
+        exit 1;
+    }
+    if (defined $args->{api_key} && ($args->{api_key} eq '' || $args->{api_key} =~ /\s/)) {
+        _fail('Invalid --api-key: must be non-empty and contain no whitespace');
+        exit 1;
+    }
+    return;
+}
+
+# ---------------------------------------------------------------------------
+# Main
+# ---------------------------------------------------------------------------
+
+sub main {
+    my $start = time();
+    my (@warnings, %results, @failures);
+
+    # parse_args first: --help/--version must work without root privileges.  The
+    # sections take a reference to it, so it stays one value as it travels.
+    my %opts = parse_args();
+    my $args = \%opts;
+    check_root();
+    prompt_model($args) if !$args->{uninstall} && !defined $args->{model};
+    validate_args($args);
+    my ($os_id, $os_display, $version_id) = detect_os();
+
+    # Header.
+    print STDERR "\n${BOLD}" . ('═' x 60) . "${RESET}\n";
+    print STDERR "${BOLD}  SGLang Deploy  v$VERSION: $os_display $version_id (ROCm)${RESET}\n";
+    print STDERR "${BOLD}" . ('═' x 60) . "${RESET}\n";
+    if ($args->{dry_run}) {
+        print STDERR "\n  ${YELLOW}${BOLD}DRY RUN: no changes will be made${RESET}\n";
+    }
+    if ($args->{uninstall} && !$args->{dry_run}) {
+        print STDERR "\n  ${YELLOW}${BOLD}UNINSTALL MODE: all SGLang components will be removed${RESET}\n";
+    }
+    print STDERR "\n";
+
+    my ($bind_host, $upstream_host) = detect_loopback();
+
+    # ── Uninstall path ──
+    if ($args->{uninstall}) {
+        print STDERR "${BOLD}── Uninstall ──${RESET}\n";
+        $results{uninstall} = uninstall($args, $args->{dry_run});
+        print_summary({
+            results        => \%results,
+            warnings       => \@warnings,
+            service_name   => $args->{service_name},
+            port           => $args->{port},
+            os_display     => $os_display,
+            version_id     => $version_id,
+            elapsed        => time() - $start,
+            dry_run        => $args->{dry_run},
+            uninstall_mode => 1,
+            bind_host      => $bind_host,
+        });
+        exit 1 if defined $results{uninstall}{container_removed}
+            && $results{uninstall}{container_removed} eq 0;
+        return 0;
+    }
+
+    # ── Deploy path ──
+    # 1. System dependencies (before preflight: provides lspci, curl and podman).
+    print STDERR "\n${BOLD}── System Dependencies ──${RESET}\n";
+    $results{system_deps} = install_system_deps($args->{dry_run});
+    my @failed_pkgs = @{ $results{system_deps}{failed} // [] };
+    push @failures, 'failed to install packages: ' . join(', ', @failed_pkgs) if @failed_pkgs;
+
+    # 2. Pre-flight checks.
+    print STDERR "\n${BOLD}── Pre-flight Checks ──${RESET}\n";
+    my $preflight = preflight_checks($os_id, $version_id, $args);
+    $results{preflight} = $preflight;
+    my $gpu_count = $preflight->{gpu_count} // 0;
+    _info("GPU count: $gpu_count");
+    if ($gpu_count && $gpu_count < $args->{tensor_parallel} + 0) {
+        push @warnings, "--tensor-parallel=$args->{tensor_parallel} but only "
+            . "$gpu_count GPU(s) detected";
+    }
+
+    # 3. State directory and model cache.
+    print STDERR "\n${BOLD}── Model Cache ──${RESET}\n";
+    $results{state_dir} = setup_state_dir($args->{state_dir}, $args->{dry_run});
+    if (defined $results{state_dir}{state_dir_created}
+        && $results{state_dir}{state_dir_created} eq 0) {
+        _fail('Could not create the state directory: cannot continue');
+        exit 1;
+    }
+
+    # 4. Engine image (fatal on failure, nothing runs without it).
+    print STDERR "\n${BOLD}── Engine Image ──${RESET}\n";
+    $results{image} = fetch_engine_image($preflight->{engine_image}, $args->{dry_run});
+    if (defined $results{image}{image_pulled} && $results{image}{image_pulled} eq 0) {
+        _fail('Engine image is not available: cannot continue');
+        exit 1;
+    }
+
+    # 5. TLS certificate (fatal, nginx cannot start without it).
+    print STDERR "\n${BOLD}── TLS Certificate ──${RESET}\n";
+    $results{tls} = setup_tls($args->{cert_dir}, $args->{dry_run});
+    if (defined $results{tls}{cert_created} && $results{tls}{cert_created} eq 0) {
+        _fail('TLS certificate setup failed: cannot continue');
+        exit 1;
+    }
+
+    # 6. API key environment file.
+    print STDERR "\n${BOLD}── API Key ──${RESET}\n";
+    $results{api_key} = setup_api_key($args->{service_name}, $args->{api_key}, $args->{dry_run});
+    if (defined $results{api_key}{env_file} && $results{api_key}{env_file} eq 'failed') {
+        _fail('Could not store the API key: cannot continue');
+        exit 1;
+    }
+
+    # 7. SELinux (non-fatal: only relevant on enforcing systems).
+    print STDERR "\n${BOLD}── SELinux ──${RESET}\n";
+    $results{selinux} = setup_selinux($args->{dry_run});
+    if (defined $results{selinux}{selinux} && $results{selinux}{selinux} eq 'failed') {
+        push @failures, 'SELinux boolean httpd_can_network_connect not set';
+    }
+
+    # 8. nginx.
+    print STDERR "\n${BOLD}── nginx ──${RESET}\n";
+    $results{nginx} = setup_nginx(
+        $args->{port}, $upstream_host, $args->{cert_dir}, $args->{service_name}, $args->{dry_run},
+    );
+    if (defined $results{nginx}{nginx_reloaded} && $results{nginx}{nginx_reloaded} eq 0) {
+        push @failures, 'nginx configuration reload failed';
+    }
+
+    # 9. systemd service (the model is probed before the unit is written).
+    print STDERR "\n${BOLD}── systemd Service ──${RESET}\n";
+    _status('Verifying ' . model_display($args->{model}) . ' on ModelScope');
+    my $ms_status = ms_model_status($args->{model});
+    if ($ms_status eq 'missing') {
+        _status_done('not found');
+        _fail("Model '$args->{model}' does not exist on ModelScope");
+        exit 1;
+    }
+    if ($ms_status eq 'unknown') {
+        _status_done('could not verify (offline?)');
+    }
+    else {
+        _status_done('found');
+    }
+
+    $results{systemd} = setup_systemd({
+        model                  => $args->{model},
+        port                   => $args->{port},
+        host                   => $bind_host,
+        tensor_parallel        => $args->{tensor_parallel},
+        max_model_len          => $args->{max_model_len},
+        gpu_memory_utilization => $args->{gpu_memory_utilization},
+        state_dir              => $args->{state_dir},
+        service_name           => $args->{service_name},
+        image                  => $preflight->{engine_image},
+        radeon_env             => $preflight->{radeon_env},
+    }, $args->{dry_run});
+    if (defined $results{systemd}{service_started} && $results{systemd}{service_started} eq 0) {
+        push @failures, "$args->{service_name} service failed to start";
+    }
+
+    # 10. Firewall.
+    print STDERR "\n${BOLD}── Firewall ──${RESET}\n";
+    $results{firewall} = setup_firewall($args->{dry_run});
+    if (defined $results{firewall}{firewall_configured}
+        && $results{firewall}{firewall_configured} eq 0) {
+        push @failures, 'firewall rule for HTTPS (443) not applied';
+    }
+
+    print_summary({
+        results          => \%results,
+        warnings         => \@warnings,
+        model            => $args->{model},
+        port             => $args->{port},
+        service_name     => $args->{service_name},
+        os_display       => $os_display,
+        version_id       => $version_id,
+        state_dir        => $args->{state_dir},
+        elapsed          => time() - $start,
+        dry_run          => $args->{dry_run},
+        uninstall_mode   => 0,
+        bind_host        => $bind_host,
+        generated_api_key => $results{api_key}{generated_key},
+    });
+
+    if (@failures) {
+        _fail('Completed with ' . scalar(@failures) . ' failed step(s):');
+        _info("  - $_") for @failures;
+        exit 1;
+    }
+    return 0;
+}
+
+END {
+    remove_scratch();
+}
+
+exit(main()) unless caller;
diff --git a/system-diag.pl b/system-diag.pl
new file mode 100644
index 0000000..84968a1
--- /dev/null
+++ b/system-diag.pl
@@ -0,0 +1,2325 @@
+#!/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;
diff --git a/system-optimise.pl b/system-optimise.pl
new file mode 100644
index 0000000..07949d7
--- /dev/null
+++ b/system-optimise.pl
@@ -0,0 +1,1727 @@
+#!/usr/bin/env perl
+# Copyright (c) 2026 Petr Balvín <opensource@petrbalvin.org> (https://petrbalvin.org)
+# SPDX-License-Identifier: MIT
+
+# Idempotent system cleanup and optimisation for Fedora, CentOS Stream and openEuler.
+#
+# Cleans old kernels, dnf caches, systemd journals, temp files and core dumps.
+# Every operation checks the current state before acting, so running it again
+# produces the same result with no errors and no repeated work.  ostree-based
+# (atomic) systems are refused, because package and kernel management there
+# belongs to rpm-ostree.
+#
+# Perl builtins only: no module has to be installed.  Three pieces of work that
+# Perl does not carry as builtins are therefore written out here:
+#
+#   * the command runner, which forks and keeps stdout and stderr apart in the
+#     scratch directory, because the failure messages quote stderr;
+#   * RPM's version comparison (rpmvercmp), which decides which kernels are the
+#     newest and so must not be approximated;
+#   * a JSON decoder, which reads what dnf5 writes for --json.
+#
+# The dnf generation is detected once, and both are driven in their own spelling,
+# because both are current on the systems these scripts run on: Fedora 41 and newer
+# ship dnf 5, while CentOS Stream 10 and openEuler ship dnf 4 (measured on the
+# Stream 10 image: dnf 4.20.0, no dnf5 binary and no libdnf5).  Needing dnf 4
+# because that is what the system has is not legacy, so nothing is refused over it.
+# An unreadable version is driven as dnf 4 and said out loud, since the choice
+# decides which cache directory gets measured.
+#
+# External binaries used: dnf, rpm, journalctl, systemctl and find.
+#
+# One optional module, never assumed: Time::HiRes, used only for the elapsed
+# time in the summary.  Without it that figure falls back to whole seconds.
+#
+# Usage:
+#     system-optimise.pl                  # full cleanup
+#     system-optimise.pl --dry-run        # preview without changes
+#     system-optimise.pl --skip-dnf       # skip DNF cleanup
+#     system-optimise.pl --skip-journal   # skip journal cleanup
+#     system-optimise.pl --skip-tmp       # skip temp file cleanup
+#     system-optimise.pl --skip-cores     # skip core dump cleanup
+#     system-optimise.pl --version
+
+use strict;
+use warnings;
+
+my $VERSION = '2.0.0';
+
+my $BOLD   = "\033[1m";
+my $RED    = "\033[31m";
+my $GREEN  = "\033[32m";
+my $YELLOW = "\033[33m";
+my $DIM    = "\033[2m";
+my $RESET  = "\033[0m";
+
+# Supported systems, in the order the messages list them.
+my @SUPPORTED_ORDER = ('fedora', 'centos', 'openeuler');
+my %SUPPORTED_OS = (
+    fedora    => 'Fedora',
+    centos    => 'CentOS Stream',
+    openeuler => 'openEuler',
+);
+
+# Kernel retention: keep the newest INSTALLONLY_LIMIT kernels plus the running
+# one.  dnf forbids installonly_limit=1, a bootable fallback must always remain.
+my $INSTALLONLY_LIMIT = 2;
+
+# Temp file retention, matching systemd-tmpfiles defaults on both targets.
+my $TMP_MAX_AGE_DAYS    = 10;
+my $VARTMP_MAX_AGE_DAYS = 30;
+
+# Core dumps younger than this are kept: a crash under active analysis must never
+# be swept away by a cleanup run.
+my $COREDUMP_MAX_AGE_DAYS = 7;
+
+my $JOURNAL_VACUUM_SIZE_MB = 500;
+my $JOURNAL_WARN_BYTES     = 1024 * 1024 * 1024;
+my @JOURNAL_DIRS = ('/var/log/journal', '/run/log/journal');
+
+# The dnf generation, probed once and then reused, and whether the unreadable case
+# has already been reported.
+my $DNF_MAJOR;
+my $DNF_MAJOR_WARNED = 0;
+
+# Unit file types audited for leftovers in /etc/systemd/system/.
+my @UNIT_SUFFIXES = qw(.service .socket .timer .target .path .mount .automount .slice);
+
+# The optional clock, loaded once and guarded where it is used.
+my $HAVE_HIRES = eval { require Time::HiRes; 1 } ? 1 : 0;
+
+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 helpers, all 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;
+}
+
+sub _info {
+    my ($msg) = @_;
+    print STDERR "  ${DIM}$msg$RESET\n";
+    return;
+}
+
+sub _warn {
+    my ($msg) = @_;
+    print STDERR "  ${YELLOW}⚠ $msg$RESET\n";
+    return;
+}
+
+sub _ok {
+    my ($msg) = @_;
+    print STDERR "  ${GREEN}✓ $msg$RESET\n";
+    return;
+}
+
+sub _fail {
+    my ($msg) = @_;
+    print STDERR "  ${RED}✗ $msg$RESET\n";
+    return;
+}
+
+# ---------------------------------------------------------------------------
+# Support: the clock, path lookup, scratch files and the command runner
+# ---------------------------------------------------------------------------
+
+sub now {
+    return $HAVE_HIRES ? Time::HiRes::time() : time();
+}
+
+# A hand-rolled which(1), so that the lookup itself needs no external binary.
+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;
+}
+
+# mkdir is atomic and refuses to follow a symlink, so a hostile entry in a
+# shared /tmp cannot redirect where the runner writes.
+sub scratch_dir {
+    return $TMP_DIR if defined $TMP_DIR;
+    # an empty TMPDIR would place the scratch directory at the filesystem root
+    my $base = defined $ENV{TMPDIR} && length $ENV{TMPDIR} ? $ENV{TMPDIR} : '/tmp';
+    for my $attempt (0 .. 9) {
+        my $dir = "$base/system-optimise.$$" . ($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 runner forks, 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 child is forked with its two streams sent to separate files in the scratch
+# directory, because the messages quote stderr while the parsers read stdout, and
+# the builtin pipe forms cannot keep them apart.  The locale is forced to C so
+# that tool output is parsed in English.  Nothing raises: a missing binary, a
+# timeout and a failed exec become rc 127, 124 and 126, which is the contract the
+# callers below were written against.
+sub run {
+    my ($cmd, $timeout) = @_;
+    $timeout = 120 unless defined $timeout;
+
+    my $exe = find_exe($cmd->[0]);
+    return { rc => 127, out => '', err => "command not found: $cmd->[0]" } 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';
+            # a failed exec falls through to the or branch, and stderr is
+            # already the file the parent quotes, so the reason travels with it
+            exec { $exe } @$cmd
+                or print STDERR "cannot execute $exe: $!\n";
+        }
+        exit 126;   # reached only when the redirection or the exec failed
+    }
+
+    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 => $out,
+        err => $timed_out ? "timed out after ${timeout}s" : $err,
+    };
+}
+
+# ---------------------------------------------------------------------------
+# OS detection and the root check
+# ---------------------------------------------------------------------------
+
+sub parse_os_release {
+    my %release;
+    open(my $fh, '<', '/etc/os-release') or return \%release;
+    while (my $line = <$fh>) {
+        $line =~ s/^\s+//;
+        $line =~ s/\s+$//;
+        next unless length $line;
+        next if index($line, '#') == 0;
+        next unless index($line, '=') >= 0;
+        my ($key, $value) = split /=/, $line, 2;
+        $value = '' unless defined $value;
+        $value =~ s/^\s+//;
+        $value =~ s/\s+$//;
+        for my $quote ('"', "'") {
+            $value =~ s/^\Q$quote\E+//;
+            $value =~ s/\Q$quote\E+$//;
+        }
+        $release{$key} = $value;
+    }
+    close($fh);
+    return \%release;
+}
+
+sub detect_os {
+    my $release = parse_os_release();
+    my $os_id = lc($release->{ID} // '');
+    my $version_id = $release->{VERSION_ID} // 'unknown';
+
+    # An ostree-based (atomic) system reports a normal ID, Silverblue reports
+    # ID=fedora, but has no dnf and manages kernels through rpm-ostree.
+    if (-e '/run/ostree-booted') {
+        print STDERR "${RED}${BOLD}Error:$RESET ostree-based (atomic) system detected "
+            . "(/run/ostree-booted present).\n";
+        print STDERR "  Package and kernel management there belongs to rpm-ostree; "
+            . "this script only supports traditional dnf/rpm systems.\n";
+        exit 1;
+    }
+    if (!exists $SUPPORTED_OS{$os_id}) {
+        print STDERR "${RED}${BOLD}Error:$RESET Unsupported operating system: "
+            . "'" . ($release->{ID} // 'unknown') . "' (detected from /etc/os-release).\n";
+        print STDERR "  Supported systems: "
+            . join(', ', map { $SUPPORTED_OS{$_} } @SUPPORTED_ORDER) . "\n";
+        exit 1;
+    }
+    return ($os_id, $SUPPORTED_OS{$os_id}, $version_id);
+}
+
+sub check_root {
+    return if $> == 0;
+    print STDERR "${RED}${BOLD}Error:$RESET This script must be run as root (UID 0).\n";
+    print STDERR "  Current UID: $>. Try: sudo perl system-optimise.pl\n";
+    exit 1;
+}
+
+# ---------------------------------------------------------------------------
+# Sizes and error text
+# ---------------------------------------------------------------------------
+
+sub format_size {
+    my ($bytes) = @_;
+    $bytes = 0 unless defined $bytes;
+    return '0 B' if $bytes < 0;
+    return sprintf('%.2f GB', $bytes / (1024 * 1024 * 1024)) if $bytes >= 1024 * 1024 * 1024;
+    return sprintf('%.1f MB', $bytes / (1024 * 1024)) if $bytes >= 1024 * 1024;
+    return sprintf('%.1f KB', $bytes / 1024) if $bytes >= 1024;
+    return "$bytes B";
+}
+
+# Total size of the files under a directory.  Symbolic links to files count,
+# through stat; symbolic links to directories are not followed, and unreadable
+# directories are skipped rather than fatal.
+sub du {
+    my ($path) = @_;
+    return 0 unless -d $path;
+    my $total = 0;
+    my @pending = ($path);
+    while (defined(my $dir = pop @pending)) {
+        opendir(my $dh, $dir) or next;
+        for my $entry (readdir($dh)) {
+            next if $entry eq '.' || $entry eq '..';
+            my $full = "$dir/$entry";
+            if (-l $full) {
+                my $size = -s $full;
+                $total += $size if defined $size && -f $full;
+                next;
+            }
+            if (-d $full) { push @pending, $full; next }
+            if (-f $full) {
+                my $size = -s $full;
+                $total += $size if defined $size;
+            }
+        }
+        closedir($dh);
+    }
+    return $total;
+}
+
+sub last_lines {
+    my ($text, $count) = @_;
+    $count = 3 unless defined $count;
+    $text = '' unless defined $text;
+    my @lines;
+    for my $line (split /\n/, $text) {
+        $line =~ s/^\s+//;
+        $line =~ s/\s+$//;
+        push @lines, $line if length $line;
+    }
+    return 'no error output' unless @lines;
+    my @tail = @lines > $count ? @lines[-$count .. -1] : @lines;
+    return join(' | ', @tail);
+}
+
+# ---------------------------------------------------------------------------
+# RPM version comparison
+# ---------------------------------------------------------------------------
+
+# rpmvercmp, as rpm itself defines it: segments alternate between digits and
+# letters, numeric segments compare numerically and always beat alphabetic
+# ones, "~" sorts before everything including the end of the string, and "^"
+# sorts after the end of the string but before any segment.  Comparison is
+# byte oriented, which is what RPM does with ASCII version strings.
+sub rpmvercmp {
+    my ($ver_a, $ver_b) = @_;
+    return 0 if $ver_a eq $ver_b;
+    my $len_a = length $ver_a;
+    my $len_b = length $ver_b;
+    my ($pos_a, $pos_b) = (0, 0);
+
+    while ($pos_a < $len_a || $pos_b < $len_b) {
+        # separators are skipped, but never a tilde or a caret: both are
+        # ordering operators in their own right and stop the skip
+        $pos_a++ while $pos_a < $len_a && substr($ver_a, $pos_a, 1) =~ /[^A-Za-z0-9~^]/;
+        $pos_b++ while $pos_b < $len_b && substr($ver_b, $pos_b, 1) =~ /[^A-Za-z0-9~^]/;
+
+        my $char_a = $pos_a < $len_a ? substr($ver_a, $pos_a, 1) : '';
+        my $char_b = $pos_b < $len_b ? substr($ver_b, $pos_b, 1) : '';
+
+        # a tilde sorts before everything, including the end of the string
+        if ($char_a eq '~' || $char_b eq '~') {
+            return 1  if $char_a ne '~';
+            return -1 if $char_b ne '~';
+            $pos_a++;
+            $pos_b++;
+            next;
+        }
+        # a caret sorts after the end of the string but before any segment
+        if ($char_a eq '^' || $char_b eq '^') {
+            return -1 if $char_a eq '';
+            return 1  if $char_b eq '';
+            return 1  if $char_a ne '^';
+            return -1 if $char_b ne '^';
+            $pos_a++;
+            $pos_b++;
+            next;
+        }
+
+        last unless length $char_a && length $char_b;
+
+        my $numeric_a = $char_a =~ /[0-9]/ ? 1 : 0;
+        my $numeric_b = $char_b =~ /[0-9]/ ? 1 : 0;
+        if ($numeric_a != $numeric_b) {
+            return $numeric_a ? 1 : -1;
+        }
+
+        my ($start_a, $start_b) = ($pos_a, $pos_b);
+        my ($seg_a, $seg_b);
+        if ($numeric_a) {
+            $pos_a++ while $pos_a < $len_a && substr($ver_a, $pos_a, 1) =~ /[0-9]/;
+            $pos_b++ while $pos_b < $len_b && substr($ver_b, $pos_b, 1) =~ /[0-9]/;
+            $seg_a = substr($ver_a, $start_a, $pos_a - $start_a);
+            $seg_b = substr($ver_b, $start_b, $pos_b - $start_b);
+            $seg_a =~ s/^0+//;
+            $seg_b =~ s/^0+//;
+            $seg_a = '0' unless length $seg_a;
+            $seg_b = '0' unless length $seg_b;
+            if (length $seg_a != length $seg_b) {
+                return length $seg_a > length $seg_b ? 1 : -1;
+            }
+        }
+        else {
+            $pos_a++ while $pos_a < $len_a && substr($ver_a, $pos_a, 1) =~ /[A-Za-z]/;
+            $pos_b++ while $pos_b < $len_b && substr($ver_b, $pos_b, 1) =~ /[A-Za-z]/;
+            $seg_a = substr($ver_a, $start_a, $pos_a - $start_a);
+            $seg_b = substr($ver_b, $start_b, $pos_b - $start_b);
+        }
+        if ($seg_a ne $seg_b) {
+            return $seg_a gt $seg_b ? 1 : -1;
+        }
+    }
+
+    # whichever side still has segments left over is the newer version
+    return 1 if $pos_a < $len_a;
+    return -1 if $pos_b < $len_b;
+    return 0;
+}
+
+# Split an EVR the way rpm's own parser splits it: an epoch is the leading
+# digits before a colon, and the release is everything after the last dash of
+# what remains.  A missing epoch counts as zero; a missing release is undef,
+# which the comparison below keeps apart from an empty one.
+sub parse_evr {
+    my ($evr) = @_;
+    $evr = '' unless defined $evr;
+    my $epoch;
+    my $version = $evr;
+    if ($version =~ /^([0-9]*):/) {
+        $epoch = length $1 ? $1 : '0';
+        $version = substr($version, length($1) + 1);
+    }
+    my $release;
+    my $cut = rindex($version, '-');
+    if ($cut >= 0) {
+        $release = substr($version, $cut + 1);
+        $version = substr($version, 0, $cut);
+    }
+    return ($epoch, $version, $release);
+}
+
+# Epoch, then version, then release, each with rpmvercmp: the field by field
+# comparison rpm itself makes, where a version with a release outranks one
+# without.  Comparing the whole remainder as one string instead would let a
+# version bleed into a release, so "1.0-2" would wrongly outrank "1.0.1-1".
+sub rpm_evr_cmp {
+    my ($evr_a, $evr_b) = @_;
+    my ($epoch_a, $version_a, $release_a) = parse_evr($evr_a);
+    my ($epoch_b, $version_b, $release_b) = parse_evr($evr_b);
+    my $rc = rpmvercmp($epoch_a // '0', $epoch_b // '0');
+    return $rc if $rc;
+    $rc = rpmvercmp($version_a, $version_b);
+    return $rc if $rc;
+    return  1 if defined $release_a && !defined $release_b;
+    return -1 if !defined $release_a && defined $release_b;
+    return 0 unless defined $release_a;   # neither side carries a release
+    return rpmvercmp($release_a, $release_b);
+}
+
+# ---------------------------------------------------------------------------
+# Kernels
+# ---------------------------------------------------------------------------
+
+sub kernel_pkg_name {
+    my ($os_id) = @_;
+    return $os_id eq 'openeuler' ? 'kernel' : 'kernel-core';
+}
+
+# Installed kernel EVRs (epoch:version-release.arch), newest first, or undef when
+# the rpm query itself failed: an empty list and a failed query are different
+# answers.  The sort is a version sort because rpm -q lists in install order,
+# which is not version order.
+sub list_kernel_packages {
+    my ($os_id) = @_;
+    my $p = run([
+        'rpm', '-q', kernel_pkg_name($os_id),
+        '--qf', "%{EPOCHNUM}:%{VERSION}-%{RELEASE}.%{ARCH}\n",
+    ], 30);
+    return undef if $p->{rc} != 0;
+    my @evrs;
+    for my $line (split /\n/, $p->{out}) {
+        $line =~ s/^\s+//;
+        $line =~ s/\s+$//;
+        push @evrs, $line if length $line;
+    }
+    @evrs = sort { rpm_evr_cmp($b, $a) } @evrs;
+    return \@evrs;
+}
+
+sub running_kernel {
+    if (open(my $fh, '<', '/proc/sys/kernel/osrelease')) {
+        my $line = <$fh>;
+        close($fh);
+        if (defined $line) {
+            $line =~ s/\s+$//;
+            return $line;
+        }
+    }
+    return '';
+}
+
+# Split the EVRs (newest first) into what is kept and what would go, mirroring
+# dnf's --oldinstallonly: the newest INSTALLONLY_LIMIT versions, and always the
+# running one even when it is not among them, which is the state after an update
+# that has not been rebooted into yet.
+sub select_kernels_to_keep {
+    my ($kernels, $running) = @_;
+    my $limit = @$kernels < $INSTALLONLY_LIMIT ? scalar @$kernels : $INSTALLONLY_LIMIT;
+    my @kept = $limit > 0 ? @$kernels[0 .. $limit - 1] : ();
+
+    my ($running_evr) = grep {
+        my (undef, $rest) = split /:/, $_, 2;
+        defined $rest && $rest eq $running;
+    } @$kernels;
+    if (defined $running_evr && !grep { $_ eq $running_evr } @kept) {
+        push @kept, $running_evr;
+    }
+    my %kept = map { $_ => 1 } @kept;
+    my @would_remove = grep { !$kept{$_} } @$kernels;
+    return (\@kept, \@would_remove);
+}
+
+# The major version of the installed dnf, probed once and reused, or 0 when it
+# cannot be read at all.
+sub dnf_major {
+    return $DNF_MAJOR if defined $DNF_MAJOR;
+    $DNF_MAJOR = 0;
+    my $p = run(['dnf', '--version'], 15);
+    if ($p->{rc} == 0 && length $p->{out}) {
+        my ($first) = split /\n/, $p->{out};
+        $DNF_MAJOR = $1 + 0 if defined $first && $first =~ /(\d+)\.\d+/;
+    }
+    return $DNF_MAJOR;
+}
+
+# The generation to drive, in the spellings that generation understands.  Both are
+# current on the systems these scripts run on, so both are driven: Fedora 41 and
+# newer ship dnf 5, while CentOS Stream 10 and openEuler ship dnf 4 (measured on
+# the Stream 10 image: dnf 4.20.0, no dnf5 binary and no libdnf5).  Needing dnf 4
+# because that is what the system has is not legacy: the script follows the system
+# rather than the other way round.
+#
+# An unreadable version is driven as dnf 4, and the choice is said out loud,
+# because the choice is not cosmetic: it decides which cache directory gets
+# measured, and a wrong guess would report a saving of zero as though it were true.
+sub dnf_generation {
+    my $major = dnf_major();
+    return $major if $major > 0;
+    if (!$DNF_MAJOR_WARNED) {
+        $DNF_MAJOR_WARNED = 1;
+        _warn('Could not read the dnf version, driving dnf as version 4');
+    }
+    return 4;
+}
+
+# The cache directories the given generation owns, and those left behind by the
+# other: the first set is measured and cleaned, the second is named and left alone.
+sub dnf_cache_dirs {
+    my ($major) = @_;
+    return (['/var/cache/libdnf5'], ['/var/cache/dnf', '/var/cache/yum']) if $major >= 5;
+    return (['/var/cache/dnf', '/var/cache/yum'], []);
+}
+
+# ---------------------------------------------------------------------------
+# Section 1: DNF cleanup
+# ---------------------------------------------------------------------------
+
+# The removed-package count from a dnf transaction preview.  dnf 4 writes
+# "Remove  12 Packages" in its summary and dnf 5 "Removing:  12 packages"; both
+# generations are current, so both are read.  An unparseable preview returns undef
+# rather than zero, so that a failure is never reported as "nothing to remove".
+sub parse_removal_count {
+    my ($text) = @_;
+    $text = '' unless defined $text;
+    return $1 + 0 if $text =~ /^Remove\s+(\d+)\s+Packages?\b/m;
+    return $1 + 0 if $text =~ /^\s*Removing:\s+(\d+)\s+packages?\b/m;
+    return 0 if index($text, 'Nothing to do') >= 0;
+    return undef;
+}
+
+sub dnf_cleanup {
+    my ($os_id, $dnf_major, %opt) = @_;
+    my $dry_run  = $opt{dry_run};
+    my $warnings = $opt{warnings};
+    my $pkg_name = kernel_pkg_name($os_id);
+    my %result = (
+        autoremoved       => 0,
+        autoremoved_count => 0,
+        kernels_removed   => 0,
+        kernels_planned   => 0,
+        kernels_kept      => '',
+        space_saved       => 0,
+        cache_cleaned     => 0,
+        errors            => [],
+    );
+
+    # 1. Autoremove packages nothing needs any more.
+    status('Removing unneeded packages (dnf autoremove)');
+    if ($dry_run) {
+        # --assumeno makes dnf print the transaction and then answer no, so the
+        # exit code can be non-zero while stdout still carries the answer.
+        my $p = run(['dnf', 'autoremove', '--assumeno'], 300);
+        my $count = parse_removal_count($p->{out});
+        if (defined $count) {
+            $result{autoremoved_count} = $count;
+            status_done($count ? "would remove $count package(s)" : 'nothing to remove');
+        }
+        elsif ($p->{rc} == 0) {
+            status_done('would run (package count unavailable)');
+        }
+        else {
+            status_done('failed');
+            _warn('dnf autoremove preview failed: ' . last_lines($p->{err}));
+            push @{ $result{errors} }, 'dnf autoremove preview failed';
+        }
+    }
+    else {
+        my $p = run(['dnf', 'autoremove', '-y'], 300);
+        if ($p->{rc} == 0) {
+            my $count = parse_removal_count($p->{out});
+            $count = 0 unless defined $count;
+            $result{autoremoved_count} = $count;
+            $result{autoremoved} = $count ? 1 : 0;
+            status_done($count ? "removed $count package(s)" : 'nothing to do');
+        }
+        else {
+            status_done('failed');
+            _warn('dnf autoremove failed: ' . last_lines($p->{err}));
+            push @{ $result{errors} }, 'dnf autoremove failed';
+        }
+    }
+
+    # 2. Prune old kernels.  dnf decides what to remove, never this script.
+    my $kernels = list_kernel_packages($os_id);
+    if (!defined $kernels) {
+        _warn('Could not query installed kernels (rpm), skipping kernel cleanup');
+        push @$warnings, 'Kernel query via rpm failed, kernel cleanup skipped';
+        push @{ $result{errors} }, 'rpm kernel query failed';
+        $result{kernels_kept} = 'unknown';
+    }
+    elsif (!@$kernels) {
+        _info('No kernel packages found');
+        $result{kernels_kept} = 'none';
+    }
+    else {
+        my $running = running_kernel();
+        my ($kept, $would_remove) = select_kernels_to_keep($kernels, $running);
+        $result{kernels_kept} = join(', ', map { "$pkg_name-$_" } @$kept);
+
+        if (!@$would_remove) {
+            _info('Old kernels: none to remove (' . scalar(@$kernels)
+                . ' installed, keeping ' . scalar(@$kept) . ')');
+        }
+        elsif ($dry_run) {
+            status("Pruning old kernels (keeping newest $INSTALLONLY_LIMIT + running)");
+            $result{kernels_planned} = scalar @$would_remove;
+            status_done('would remove ' . scalar @$would_remove);
+            _info("would remove $pkg_name-$_") for @$would_remove;
+        }
+        else {
+            status('Pruning ' . scalar(@$would_remove) . ' old kernel(s) via dnf (keeping '
+                . scalar(@$kept) . ')');
+            my @cmd = ('dnf', 'remove', '-y', '--oldinstallonly');
+            if ($dnf_major >= 5) {
+                push @cmd, "--limit=$INSTALLONLY_LIMIT";
+            }
+            else {
+                push @cmd, '--setopt', "installonly_limit=$INSTALLONLY_LIMIT";
+            }
+            push @cmd, $pkg_name;
+            my $p = run(\@cmd, 300);
+            if ($p->{rc} == 0) {
+                # dnf may keep more than the model allows for, and it protects
+                # the running kernel itself, so re-query and report what happened
+                # rather than what was planned.
+                my $after = list_kernel_packages($os_id);
+                if (!defined $after) {
+                    $result{kernels_removed} = 0;
+                    status_done('done (post-check failed)');
+                    push @$warnings, 'Could not verify kernel removal (rpm), removed count unknown';
+                }
+                else {
+                    my %still_there = map { $_ => 1 } @$after;
+                    my @removed_now = grep { !$still_there{$_} } @$kernels;
+                    my $running_present = grep {
+                        my (undef, $rest) = split /:/, $_, 2;
+                        defined $rest && $rest eq $running;
+                    } @$after;
+                    if (!$running_present) {
+                        _fail("Running kernel $running is no longer installed, do not reboot");
+                        push @{ $result{errors} }, 'running kernel missing after kernel prune';
+                    }
+                    $result{kernels_removed} = scalar @removed_now;
+                    status_done('removed ' . scalar(@removed_now)
+                        . ' (planned ' . scalar(@$would_remove) . ", running: $running)");
+                }
+            }
+            else {
+                status_done('failed');
+                _warn('Kernel removal failed: ' . last_lines($p->{err}));
+                push @{ $result{errors} }, 'old kernel removal failed';
+            }
+        }
+    }
+
+    # 3. Clean the cache, measuring only what this generation owns, and name what
+    # the other generation left behind without touching it.
+    my ($active_caches, $stale_caches) = dnf_cache_dirs($dnf_major);
+    for my $stale (@$stale_caches) {
+        my $stale_size = du($stale);
+        next unless $stale_size > 0;
+        my $msg = "Stale dnf4 cache at $stale (" . format_size($stale_size)
+            . '), unused by dnf5';
+        _info($msg);
+        push @$warnings, $msg;
+    }
+    my $cache_before = 0;
+    $cache_before += du($_) for @$active_caches;
+    status('Cleaning DNF cache');
+    if ($dry_run) {
+        $result{space_saved} += $cache_before;
+        status_done('would free ~' . format_size($cache_before));
+    }
+    else {
+        my $p = run(['dnf', 'clean', 'all'], 60);
+        if ($p->{rc} == 0) {
+            my $cache_after = 0;
+            $cache_after += du($_) for @$active_caches;
+            my $saved = $cache_before - $cache_after;
+            $saved = 0 if $saved < 0;
+            $result{space_saved} += $saved;
+            $result{cache_cleaned} = 1;
+            status_done(format_size($saved));
+        }
+        else {
+            status_done('failed');
+            _warn('dnf clean all failed: ' . last_lines($p->{err}));
+            push @{ $result{errors} }, 'dnf clean all failed';
+        }
+    }
+
+    return \%result;
+}
+
+# ---------------------------------------------------------------------------
+# Section 2: journal cleanup
+# ---------------------------------------------------------------------------
+
+sub journal_size {
+    my $total = 0;
+    for my $path (@JOURNAL_DIRS) {
+        $total += du($path) if -e $path;
+    }
+    return $total;
+}
+
+sub journal_cleanup {
+    my (%opt) = @_;
+    my $dry_run  = $opt{dry_run};
+    my $warnings = $opt{warnings};
+    my %result = (
+        vacuumed           => 0,
+        space_saved        => 0,
+        journal_size_after => 0,
+        persistent_warning => 0,
+        errors             => [],
+    );
+
+    my $vacuum_arg = "--vacuum-size=${JOURNAL_VACUUM_SIZE_MB}M";
+    my $size_before = journal_size();
+    status("Vacuuming journal ($vacuum_arg)");
+
+    my $size_check;
+    if ($dry_run) {
+        my $estimated = $size_before - $JOURNAL_VACUUM_SIZE_MB * 1024 * 1024;
+        $estimated = 0 if $estimated < 0;
+        $result{space_saved} = $estimated;
+        status_done('would free ~' . format_size($estimated));
+        $size_check = $size_before - $estimated;
+    }
+    else {
+        my $p = run(['journalctl', $vacuum_arg], 120);
+        if ($p->{rc} == 0) {
+            $result{vacuumed} = 1;
+            $result{journal_size_after} = journal_size();
+            my $saved = $size_before - $result{journal_size_after};
+            $result{space_saved} = $saved > 0 ? $saved : 0;
+            status_done(format_size($result{space_saved}));
+        }
+        else {
+            status_done('failed');
+            _warn('journalctl vacuum failed: ' . last_lines($p->{err}));
+            push @{ $result{errors} }, 'journal vacuum failed';
+        }
+        $size_check = journal_size();
+    }
+
+    # A journal that stays large after a vacuum needs SystemMaxUse rather than
+    # another vacuum, so it is reported.
+    if ($size_check > $JOURNAL_WARN_BYTES) {
+        my $msg = 'Journal still large (' . format_size($size_check)
+            . ') after vacuum. Consider setting SystemMaxUse= in /etc/systemd/journald.conf';
+        _warn($msg);
+        push @$warnings, $msg;
+        $result{persistent_warning} = 1;
+    }
+
+    return \%result;
+}
+
+# ---------------------------------------------------------------------------
+# Section 3: systemd audit, informational only
+# ---------------------------------------------------------------------------
+
+sub systemd_audit {
+    my (%opt) = @_;
+    my $warnings = $opt{warnings};
+    my %result = (
+        failed_units   => [],
+        disabled_count => 0,
+        leftover_files => [],
+        errors         => [],
+    );
+
+    # 1. Failed units
+    status('Checking for failed systemd units');
+    my $p = run(['systemctl', '--failed', '--no-legend'], 30);
+    if ($p->{rc} != 0 && !length $p->{out}) {
+        status_done('unavailable');
+        my $msg = 'systemctl --failed unavailable: ' . last_lines($p->{err});
+        _warn($msg);
+        push @$warnings, $msg;
+    }
+    else {
+        my @failed;
+        for my $line (split /\n/, $p->{out}) {
+            $line =~ s/^\s+//;
+            $line =~ s/\s+$//;
+            push @failed, $line if length $line;
+        }
+        $result{failed_units} = \@failed;
+        status_done(scalar(@failed) . ' failed');
+        _warn("Failed unit: $_") for @failed;
+        push @$warnings, scalar(@failed) . ' failed systemd unit(s), see above' if @failed;
+    }
+
+    # 2. Disabled unit files, counted for information only.
+    status('Counting disabled unit files');
+    my $disabled = run(['systemctl', 'list-unit-files', '--state=disabled', '--no-legend'], 30);
+    if ($disabled->{rc} != 0 && !length $disabled->{out}) {
+        status_done('unavailable');
+        my $msg = 'systemctl list-unit-files --state=disabled unavailable: '
+            . last_lines($disabled->{err});
+        _warn($msg);
+        push @$warnings, $msg;
+    }
+    else {
+        my @disabled_lines;
+        for my $line (split /\n/, $disabled->{out}) {
+            $line =~ s/^\s+//;
+            $line =~ s/\s+$//;
+            push @disabled_lines, $line if length $line;
+        }
+        $result{disabled_count} = scalar @disabled_lines;
+        status_done($result{disabled_count} . ' disabled (informational only)');
+    }
+
+    # 3. Leftover unit files: regular files systemd does not know about.  One
+    # listing yields every unit name systemd recognises, so static, disabled and
+    # indirect units are all legitimate and only unknown names are leftovers.
+    my $etc_systemd = '/etc/systemd/system';
+    if (-d $etc_systemd) {
+        status('Checking for leftover unit files');
+        my $units = run(['systemctl', 'list-unit-files', '--no-legend'], 30);
+        if ($units->{rc} != 0) {
+            status_done('unavailable');
+            my $msg = 'systemctl list-unit-files unavailable: ' . last_lines($units->{err});
+            _warn($msg);
+            push @$warnings, $msg;
+        }
+        else {
+            my %known;
+            for my $line (split /\n/, $units->{out}) {
+                my @fields = split ' ', $line;
+                $known{ $fields[0] } = 1 if @fields;
+            }
+            my @leftovers;
+            if (opendir(my $dh, $etc_systemd)) {
+                for my $entry (sort readdir($dh)) {
+                    next if $entry eq '.' || $entry eq '..';
+                    my $full = "$etc_systemd/$entry";
+                    next if -l $full || !-f $full;
+                    next unless grep { substr($entry, -length $_) eq $_ } @UNIT_SUFFIXES;
+                    push @leftovers, $entry unless $known{$entry};
+                }
+                closedir($dh);
+            }
+            $result{leftover_files} = \@leftovers;
+            if (@leftovers) {
+                status_done(scalar(@leftovers) . ' leftover(s)');
+                _warn("Leftover unit file: $etc_systemd/$_") for @leftovers;
+                push @$warnings, scalar(@leftovers) . " leftover unit file(s) in $etc_systemd/";
+            }
+            else {
+                status_done('none');
+            }
+        }
+    }
+
+    return \%result;
+}
+
+# ---------------------------------------------------------------------------
+# Section 4: temp file cleanup
+# ---------------------------------------------------------------------------
+
+# Regular files under a directory older than the given number of days.  The walk
+# stays on one filesystem (-xdev) and never matches the start directory itself
+# (-mindepth 1).  undef means the find command failed, which callers must keep
+# apart from an empty result.
+sub find_old_files {
+    my ($directory, $days) = @_;
+    my $p = run([
+        'find', $directory, '-mindepth', '1', '-xdev',
+        '-type', 'f', '-mtime', "+$days", '-print0',
+    ], 120);
+    return undef if $p->{rc} != 0;
+    return [ grep { length } split /\0/, $p->{out} ];
+}
+
+sub paths_size {
+    my ($paths) = @_;
+    my $total = 0;
+    for my $path (@$paths) {
+        my $size = -s $path;
+        $total += $size if defined $size;
+    }
+    return $total;
+}
+
+# Split the paths listed before deletion into those the verification pass no
+# longer sees (gone) and those it still sees (left).  Only the first group is
+# what this run took away: a file that merely ages into the window between the
+# two passes shows up in the second listing without ever having been listed
+# before, and a count difference would wrongly charge it against the deletions.
+sub split_by_presence {
+    my ($before, $after) = @_;
+    my %after = map { $_ => 1 } @$after;
+    return (
+        [ grep { !$after{$_} } @$before ],
+        [ grep {  $after{$_} } @$before ],
+    );
+}
+
+# Clean one temp directory, returning (files affected, bytes freed).  Files are
+# counted and measured before anything is removed, so the real-mode numbers
+# describe what was actually taken away, while a dry run reports the size of the
+# matching files and removes nothing.
+sub clean_temp_dir {
+    my ($directory, $days, %opt) = @_;
+    my $dry_run  = $opt{dry_run};
+    my $warnings = $opt{warnings};
+    my $errors   = $opt{errors};
+
+    my $old_files = find_old_files($directory, $days);
+    if (!defined $old_files) {
+        status_done('failed');
+        _warn("find $directory failed, cannot list old files");
+        push @$warnings, "Temp cleanup of $directory failed (find error)";
+        push @$errors, "find failed in $directory";
+        return (0, 0);
+    }
+    my $old_size = paths_size($old_files);
+
+    if ($dry_run) {
+        status_done('would remove ' . scalar(@$old_files) . ' file(s) (~'
+            . format_size($old_size) . ')');
+        return (scalar @$old_files, $old_size);
+    }
+
+    for my $extra (
+        ['-type', 'f', '-mtime', "+$days"],
+        # The same age filter for directories: without it, freshly created empty
+        # directories belonging to running applications would be removed.
+        ['-type', 'd', '-empty', '-mtime', "+$days"],
+    ) {
+        my $p = run(['find', $directory, '-mindepth', '1', '-xdev', @$extra, '-delete'], 120);
+        if ($p->{rc} != 0) {
+            _warn("find $directory -delete failed: " . last_lines($p->{err}));
+            push @$warnings, "Temp cleanup of $directory hit find errors";
+            push @$errors, "find -delete failed in $directory";
+        }
+    }
+
+    my $remaining = find_old_files($directory, $days);
+    if (!defined $remaining) {
+        # Success numbers are never fabricated when the verification pass failed.
+        _warn("Could not verify deletions in $directory, counts unknown");
+        push @$warnings, "Temp cleanup of $directory: post-delete verification failed";
+        push @$errors, "find verification failed in $directory";
+        return (0, 0);
+    }
+    my ($gone, $left) = split_by_presence($old_files, $remaining);
+    my $removed = scalar @$gone;
+    my $freed = $old_size - paths_size($left);
+    $freed = 0 if $freed < 0;
+    status_done("$removed file(s), freed " . format_size($freed));
+    return ($removed, $freed);
+}
+
+sub temp_cleanup {
+    my (%opt) = @_;
+    my $dry_run  = $opt{dry_run};
+    my $warnings = $opt{warnings};
+    my %result = (
+        tmp_files_removed    => 0,
+        vartmp_files_removed => 0,
+        tmp_files_planned    => 0,
+        vartmp_files_planned => 0,
+        space_saved          => 0,
+        errors               => [],
+    );
+
+    status("Cleaning /tmp (files older than $TMP_MAX_AGE_DAYS days)");
+    my ($removed, $freed) = clean_temp_dir('/tmp', $TMP_MAX_AGE_DAYS,
+        dry_run => $dry_run, warnings => $warnings, errors => $result{errors});
+    $result{ $dry_run ? 'tmp_files_planned' : 'tmp_files_removed' } = $removed;
+    $result{space_saved} += $freed;
+
+    if (-d '/var/tmp') {
+        status("Cleaning /var/tmp (files older than $VARTMP_MAX_AGE_DAYS days)");
+        ($removed, $freed) = clean_temp_dir('/var/tmp', $VARTMP_MAX_AGE_DAYS,
+            dry_run => $dry_run, warnings => $warnings, errors => $result{errors});
+        $result{ $dry_run ? 'vartmp_files_planned' : 'vartmp_files_removed' } = $removed;
+        $result{space_saved} += $freed;
+    }
+    else {
+        _info('/var/tmp: directory not found, skipping');
+    }
+
+    return \%result;
+}
+
+# ---------------------------------------------------------------------------
+# Section 5: core dump cleanup
+# ---------------------------------------------------------------------------
+
+sub coredump_cleanup {
+    my (%opt) = @_;
+    my $dry_run  = $opt{dry_run};
+    my $warnings = $opt{warnings};
+    my %result = (
+        cores_removed     => 0,
+        cores_planned     => 0,
+        cores_kept_recent => 0,
+        space_saved       => 0,
+        errors            => [],
+    );
+
+    my $coredump_dir = '/var/lib/systemd/coredump';
+    if (!-d $coredump_dir) {
+        _info('No coredump directory found, skipping');
+        return \%result;
+    }
+
+    my $cutoff = time() - $COREDUMP_MAX_AGE_DAYS * 86400;
+    my @old_dumps;   # [name, mtime, size]
+    my $recent = 0;
+    my $dh;
+    if (!opendir($dh, $coredump_dir)) {
+        _warn("Cannot list $coredump_dir: $!");
+        push @$warnings, "Core dump cleanup skipped, cannot read $coredump_dir";
+        push @{ $result{errors} }, 'coredump listdir failed';
+        return \%result;
+    }
+    my @entries = sort readdir($dh);
+    closedir($dh);
+    for my $entry (@entries) {
+        next if $entry eq '.' || $entry eq '..';
+        my $full = "$coredump_dir/$entry";
+        my @st = stat($full);
+        next unless @st;
+        next unless -f $full;
+        if ($st[9] < $cutoff) {
+            push @old_dumps, [$entry, $st[9], $st[7]];
+        }
+        else {
+            $recent++;
+        }
+    }
+    $result{cores_kept_recent} = $recent;
+
+    if (!@old_dumps) {
+        _info("No core dumps older than $COREDUMP_MAX_AGE_DAYS days found");
+        _info("Keeping $recent recent core dump(s) (< $COREDUMP_MAX_AGE_DAYS days old)")
+            if $recent;
+        return \%result;
+    }
+
+    # Every dump is listed with its date and size before anything is removed.
+    my $total_size = 0;
+    $total_size += $_->[2] for @old_dumps;
+    my $heading = $dry_run ? 'Would remove' : 'Removing';
+    _info("$heading " . scalar(@old_dumps) . ' core dump(s) older than '
+        . "$COREDUMP_MAX_AGE_DAYS days (" . format_size($total_size) . '):');
+    for my $dump (@old_dumps) {
+        my ($name, $mtime, $size) = @$dump;
+        my @t = localtime($mtime);
+        my $date = sprintf('%04d-%02d-%02d %02d:%02d',
+            $t[5] + 1900, $t[4] + 1, $t[3], $t[2], $t[1]);
+        my $prefix = $dry_run ? 'would remove' : 'remove';
+        _info("  $prefix: $name ($date, " . format_size($size) . ')');
+    }
+
+    if ($dry_run) {
+        $result{cores_planned} = scalar @old_dumps;
+        $result{space_saved} = $total_size;
+        return \%result;
+    }
+
+    status('Deleting ' . scalar(@old_dumps) . ' core dump(s)');
+    my ($removed, $freed, $failed) = (0, 0, 0);
+    for my $dump (@old_dumps) {
+        my ($name, undef, $size) = @$dump;
+        if (unlink("$coredump_dir/$name")) {
+            $removed++;
+            $freed += $size;
+        }
+        else {
+            $failed++;
+            _warn("Could not remove $name: $!");
+        }
+    }
+    $result{cores_removed} = $removed;
+    $result{space_saved} = $freed > 0 ? $freed : 0;
+    if ($failed) {
+        push @$warnings, "$failed core dump(s) could not be removed, see above";
+        push @{ $result{errors} }, 'coredump removal incomplete';
+    }
+    status_done('removed ' . $removed . ', freed ' . format_size($result{space_saved}));
+    _info("Keeping $recent recent core dump(s) (< $COREDUMP_MAX_AGE_DAYS days old)")
+        if $recent;
+    return \%result;
+}
+
+# ---------------------------------------------------------------------------
+# JSON decoding, hand-rolled
+# ---------------------------------------------------------------------------
+#
+# dnf5 can describe a package list as JSON, which is steadier to read than its
+# table output, and no JSON module may be assumed to exist.  The decoder below
+# covers the grammar the format allows, so another script that has to read JSON
+# can lift it unchanged.
+
+sub json_decode {
+    my ($text) = @_;
+    $text = '' unless defined $text;
+    my $pos = 0;
+    my $value = json_parse_value($text, \$pos);
+    json_skip_space($text, \$pos);
+    die "trailing data at offset $pos\n" if $pos < length $text;
+    return $value;
+}
+
+sub json_skip_space {
+    my ($text, $pos_ref) = @_;
+    my $length = length $text;
+    while ($$pos_ref < $length && substr($text, $$pos_ref, 1) =~ /[ \t\r\n]/) {
+        $$pos_ref++;
+    }
+    return;
+}
+
+sub json_parse_value {
+    my ($text, $pos_ref) = @_;
+    json_skip_space($text, $pos_ref);
+    die "unexpected end of input at offset $$pos_ref\n" if $$pos_ref >= length $text;
+    my $char = substr($text, $$pos_ref, 1);
+    return json_parse_object($text, $pos_ref) if $char eq '{';
+    return json_parse_array($text, $pos_ref)  if $char eq '[';
+    return json_parse_string($text, $pos_ref) if $char eq '"';
+    return json_parse_number($text, $pos_ref) if $char =~ /[-0-9]/;
+    for my $literal (['true', 1], ['false', 0], ['null', undef]) {
+        my ($word, $value) = @$literal;
+        if (substr($text, $$pos_ref, length $word) eq $word) {
+            $$pos_ref += length $word;
+            return $value;
+        }
+    }
+    die "unrecognised token at offset $$pos_ref\n";
+}
+
+sub json_parse_object {
+    my ($text, $pos_ref) = @_;
+    my %object;
+    $$pos_ref++;   # the opening brace
+    json_skip_space($text, $pos_ref);
+    if (substr($text, $$pos_ref, 1) eq '}') {
+        $$pos_ref++;
+        return \%object;
+    }
+    while (1) {
+        json_skip_space($text, $pos_ref);
+        die "expected a key at offset $$pos_ref\n" unless substr($text, $$pos_ref, 1) eq '"';
+        my $key = json_parse_string($text, $pos_ref);
+        json_skip_space($text, $pos_ref);
+        die "expected a colon at offset $$pos_ref\n" unless substr($text, $$pos_ref, 1) eq ':';
+        $$pos_ref++;
+        $object{$key} = json_parse_value($text, $pos_ref);
+        json_skip_space($text, $pos_ref);
+        my $next = substr($text, $$pos_ref, 1);
+        if ($next eq ',') { $$pos_ref++; next }
+        if ($next eq '}') { $$pos_ref++; last }
+        die "expected a comma or a closing brace at offset $$pos_ref\n";
+    }
+    return \%object;
+}
+
+sub json_parse_array {
+    my ($text, $pos_ref) = @_;
+    my @items;
+    $$pos_ref++;   # the opening bracket
+    json_skip_space($text, $pos_ref);
+    if (substr($text, $$pos_ref, 1) eq ']') {
+        $$pos_ref++;
+        return \@items;
+    }
+    while (1) {
+        push @items, json_parse_value($text, $pos_ref);
+        json_skip_space($text, $pos_ref);
+        my $next = substr($text, $$pos_ref, 1);
+        if ($next eq ',') { $$pos_ref++; next }
+        if ($next eq ']') { $$pos_ref++; last }
+        die "expected a comma or a closing bracket at offset $$pos_ref\n";
+    }
+    return \@items;
+}
+
+sub json_parse_string {
+    my ($text, $pos_ref) = @_;
+    $$pos_ref++;   # the opening quote
+    my $out = '';
+    my $length = length $text;
+    my %simple = (
+        '"'  => '"',
+        '\\' => '\\',
+        '/'  => '/',
+        'b'  => "\b",
+        'f'  => "\f",
+        'n'  => "\n",
+        'r'  => "\r",
+        't'  => "\t",
+    );
+    while ($$pos_ref < $length) {
+        my $char = substr($text, $$pos_ref, 1);
+        if ($char eq '"') {
+            $$pos_ref++;
+            return $out;
+        }
+        if ($char ne '\\') {
+            $out .= $char;
+            $$pos_ref++;
+            next;
+        }
+        $$pos_ref++;
+        my $escape = substr($text, $$pos_ref, 1);
+        if (exists $simple{$escape}) {
+            $out .= $simple{$escape};
+            $$pos_ref++;
+            next;
+        }
+        die "unrecognised escape at offset $$pos_ref\n" unless $escape eq 'u';
+        my $hex = substr($text, $$pos_ref + 1, 4);
+        die "malformed \\u escape at offset $$pos_ref\n" unless $hex =~ /^[0-9a-fA-F]{4}$/;
+        my $code = hex $hex;
+        $$pos_ref += 5;
+        # a high surrogate is followed by the low half of the pair
+        if ($code >= 0xd800 && $code <= 0xdbff && substr($text, $$pos_ref, 2) eq '\\u') {
+            my $low_hex = substr($text, $$pos_ref + 2, 4);
+            if ($low_hex =~ /^[0-9a-fA-F]{4}$/) {
+                my $low = hex $low_hex;
+                if ($low >= 0xdc00 && $low <= 0xdfff) {
+                    $code = 0x10000 + (($code - 0xd800) << 10) + ($low - 0xdc00);
+                    $$pos_ref += 6;
+                }
+            }
+        }
+        my $bytes = pack('U', $code);
+        utf8::encode($bytes);
+        $out .= $bytes;
+    }
+    die "unterminated string\n";
+}
+
+sub json_parse_number {
+    my ($text, $pos_ref) = @_;
+    my $length = length $text;
+    my $start = $$pos_ref;
+    $$pos_ref++ if substr($text, $$pos_ref, 1) eq '-';
+    $$pos_ref++ while $$pos_ref < $length && substr($text, $$pos_ref, 1) =~ /[0-9]/;
+    if ($$pos_ref < $length && substr($text, $$pos_ref, 1) eq '.') {
+        $$pos_ref++;
+        $$pos_ref++ while $$pos_ref < $length && substr($text, $$pos_ref, 1) =~ /[0-9]/;
+    }
+    if ($$pos_ref < $length && substr($text, $$pos_ref, 1) =~ /[eE]/) {
+        $$pos_ref++;
+        $$pos_ref++ if substr($text, $$pos_ref, 1) =~ /[-+]/;
+        $$pos_ref++ while $$pos_ref < $length && substr($text, $$pos_ref, 1) =~ /[0-9]/;
+    }
+    my $literal = substr($text, $start, $$pos_ref - $start);
+    unless ($literal =~ /^-?(?:0|[1-9][0-9]*)(?:\.[0-9]+)?(?:[eE][-+]?[0-9]+)?$/) {
+        die "malformed number at offset $start\n";
+    }
+    return $literal + 0;
+}
+
+# ---------------------------------------------------------------------------
+# Section 6: package audit, informational only
+# ---------------------------------------------------------------------------
+
+# The package names in a dnf5 --json answer, as name.arch where an architecture
+# is given, sorted.  Returns undef when the text is not JSON this can read, which
+# the caller reports as unavailable rather than as an empty list.
+sub extras_names {
+    my ($text) = @_;
+    my $data = eval { json_decode($text) };
+    return undef unless defined $data && ref $data eq 'HASH';
+    my @found;
+    for my $section (values %$data) {
+        next unless ref $section eq 'ARRAY';
+        for my $package (@$section) {
+            next unless ref $package eq 'HASH' && $package->{name};
+            push @found, $package->{arch}
+                ? "$package->{name}.$package->{arch}"
+                : $package->{name};
+        }
+    }
+    return [ sort @found ];
+}
+
+# The package names in a dnf 4 --quiet listing: one per line, above which dnf
+# writes header lines naming cache and section state rather than packages.  The
+# order dnf printed them in is kept.
+sub extras_names_text {
+    my ($text) = @_;
+    my @headers = ('last metadata', 'extra packages', 'available packages', 'installed packages');
+    my @names;
+    for my $line (split /\n/, ($text // '')) {
+        $line =~ s/^\s+//;
+        $line =~ s/\s+$//;
+        next unless length $line;
+        my $lower = lc $line;
+        next if grep { index($lower, $_) == 0 } @headers;
+        my @fields = split ' ', $line;
+        push @names, $fields[0] if @fields;
+    }
+    return \@names;
+}
+
+sub package_audit {
+    my ($dnf_major, %opt) = @_;
+    my $warnings = $opt{warnings};
+    my %result = (
+        extras_count    => 0,
+        extras_packages => [],
+        errors          => [],
+    );
+
+    status('Checking for packages not in any repo (dnf list --extras)');
+
+    my ($p, $names);
+    if ($dnf_major >= 5) {
+        # dnf 5 describes the list as JSON, which does not have to be read out of
+        # a table whose columns move between releases.
+        $p = run(['dnf', 'list', '--extras', '--json'], 60);
+        $names = $p->{rc} == 0 ? extras_names($p->{out}) : undef;
+    }
+    else {
+        # dnf 4 has no --json option, so its quiet listing is read instead.
+        $p = run(['dnf', 'list', '--extras', '--quiet'], 60);
+        $names = $p->{rc} == 0 ? extras_names_text($p->{out}) : undef;
+    }
+
+    if (!defined $names) {
+        status_done('unavailable');
+        my $detail = $p->{rc} != 0 ? last_lines($p->{err}) : 'unparseable dnf output';
+        my $msg = "dnf list --extras unavailable: $detail";
+        _warn($msg);
+        push @$warnings, $msg;
+        return \%result;
+    }
+
+    $result{extras_count} = scalar @$names;
+    $result{extras_packages} = $names;
+    if (@$names) {
+        status_done(scalar(@$names) . ' package(s)');
+        _warn("Extra package: $_") for @$names[0 .. (@$names > 10 ? 9 : $#$names)];
+        _warn('  ... and ' . (scalar(@$names) - 10) . ' more') if @$names > 10;
+        push @$warnings, scalar(@$names) . ' installed package(s) not found in any repo';
+    }
+    else {
+        status_done('none');
+    }
+
+    return \%result;
+}
+
+# ---------------------------------------------------------------------------
+# Summary
+# ---------------------------------------------------------------------------
+
+sub print_summary {
+    my ($os_display, $version_id, $results, $warnings, $elapsed, %opt) = @_;
+    my $dry_run = $opt{dry_run};
+    my $bar = "═" x 60;
+
+    print STDERR "\n${BOLD}── Optimisation Summary ──$RESET\n";
+    print STDERR "  OS: $os_display $version_id\n";
+    if ($dry_run) {
+        print STDERR "  ${YELLOW}DRY RUN: nothing was changed, every action below is a would-be action$RESET\n";
+    }
+
+    my $dnf = $results->{dnf} // {};
+    if (%$dnf) {
+        my $count = $dnf->{autoremoved_count} // 0;
+        if ($dry_run) {
+            if ($count > 0) { _info("DNF autoremove: would remove $count package(s)") }
+            else            { _info('DNF autoremove: nothing to remove') }
+        }
+        elsif ($dnf->{autoremoved}) { _ok("DNF autoremove: removed $count package(s)") }
+        else                        { _info('DNF autoremove: nothing to remove') }
+
+        my $kernels = $dry_run ? ($dnf->{kernels_planned} // 0) : ($dnf->{kernels_removed} // 0);
+        if ($kernels > 0) {
+            if ($dry_run) { _info("Old kernels: would remove $kernels") }
+            else          { _ok("Old kernels removed: $kernels") }
+        }
+        else {
+            _info('Old kernels: none to remove');
+        }
+        _info('Kernels kept: ' . ($dnf->{kernels_kept} // '?'));
+
+        my $cache_saved = format_size($dnf->{space_saved} // 0);
+        if ($dry_run) { _info("DNF cache: would clean (~$cache_saved)") }
+        elsif ($dnf->{cache_cleaned}) { _ok("DNF cache: cleaned (freed $cache_saved)") }
+    }
+
+    my $journal = $results->{journal} // {};
+    if (%$journal) {
+        if ($dry_run) {
+            _info("Journal: would vacuum to ${JOURNAL_VACUUM_SIZE_MB}M (est. freed ~"
+                . format_size($journal->{space_saved} // 0) . ')');
+        }
+        elsif ($journal->{vacuumed}) {
+            _ok('Journal vacuumed: freed ' . format_size($journal->{space_saved} // 0));
+        }
+        if ($journal->{persistent_warning}) {
+            _warn('Journal storage is still large, check SystemMaxUse= in journald.conf');
+        }
+    }
+
+    my $systemd = $results->{systemd} // {};
+    if (%$systemd) {
+        my $failed = scalar @{ $systemd->{failed_units} // [] };
+        if ($failed > 0) { _warn("Failed systemd units: $failed") }
+        else             { _ok('Failed systemd units: none') }
+        _info('Disabled unit files: ' . ($systemd->{disabled_count} // 0) . ' (informational)');
+        my $leftovers = scalar @{ $systemd->{leftover_files} // [] };
+        if ($leftovers > 0) { _warn("Leftover unit files in /etc/systemd/system/: $leftovers") }
+        else                { _info('Leftover unit files: none') }
+    }
+
+    my $tmp = $results->{tmp} // {};
+    if (%$tmp) {
+        my ($tmp_count, $vartmp_count) = $dry_run
+            ? ($tmp->{tmp_files_planned} // 0, $tmp->{vartmp_files_planned} // 0)
+            : ($tmp->{tmp_files_removed} // 0, $tmp->{vartmp_files_removed} // 0);
+        if ($tmp_count > 0 || $vartmp_count > 0) {
+            my $verb = $dry_run ? 'would remove' : 'removed';
+            my $msg = "Temp files: $verb $tmp_count from /tmp, $vartmp_count from /var/tmp";
+            $dry_run ? _info($msg) : _ok($msg);
+        }
+        else {
+            _info('Temp files: none to remove');
+        }
+    }
+
+    my $cores = $results->{cores} // {};
+    if (%$cores) {
+        my $count = $dry_run ? ($cores->{cores_planned} // 0) : ($cores->{cores_removed} // 0);
+        if ($count > 0) {
+            my $verb = $dry_run ? 'would remove' : 'removed';
+            my $msg = "Core dumps: $verb $count (older than $COREDUMP_MAX_AGE_DAYS days)";
+            $dry_run ? _info($msg) : _ok($msg);
+        }
+        else {
+            _info('Core dumps: none to remove');
+        }
+        if (($cores->{cores_kept_recent} // 0) > 0) {
+            _info('Core dumps kept (recent): ' . $cores->{cores_kept_recent});
+        }
+    }
+
+    my $packages = $results->{packages} // {};
+    if (%$packages) {
+        my $extras = $packages->{extras_count} // 0;
+        if ($extras > 0) { _warn("Packages not in any repo: $extras") }
+        else             { _ok('Package audit: all packages from known repos') }
+    }
+
+    my $total_space = 0;
+    $total_space += ($results->{$_} // {})->{space_saved} // 0 for qw(dnf journal tmp cores);
+    if ($dry_run) {
+        _info('Estimated space to free: ~' . format_size($total_space));
+    }
+    elsif ($total_space > 0) {
+        _ok('Total space freed: ' . format_size($total_space));
+    }
+    else {
+        _info('Total space freed: 0 B');
+    }
+
+    if (@$warnings) {
+        print STDERR "\n";
+        _warn($_) for @$warnings;
+    }
+
+    print STDERR "\n${BOLD}${bar}$RESET\n";
+    printf STDERR "  %sTotal time: %.1fs%s\n", $BOLD, $elapsed, $RESET;
+    print STDERR "${BOLD}${bar}$RESET\n\n";
+    return;
+}
+
+# ---------------------------------------------------------------------------
+# Command line
+# ---------------------------------------------------------------------------
+
+sub usage {
+    my $name = $0;
+    $name =~ s{.*/}{};
+    return <<"USAGE";
+Usage: $name [options]
+
+Idempotent system cleanup and optimisation for Fedora, CentOS Stream and openEuler
+
+Options:
+  --dry-run       Preview without making changes
+  --skip-dnf      Skip DNF cleanup (autoremove, old kernels, cache)
+  --skip-journal  Skip journal vacuum
+  --skip-tmp      Skip temp file cleanup
+  --skip-cores    Skip core dump cleanup
+  --version       Show the version and exit
+  -h, --help      Show this help and exit
+USAGE
+}
+
+sub parse_args {
+    my %opt = (
+        dry_run      => 0,
+        skip_dnf     => 0,
+        skip_journal => 0,
+        skip_tmp     => 0,
+        skip_cores   => 0,
+    );
+    my %flag_for = (
+        '--dry-run'      => 'dry_run',
+        '--skip-dnf'     => 'skip_dnf',
+        '--skip-journal' => 'skip_journal',
+        '--skip-tmp'     => 'skip_tmp',
+        '--skip-cores'   => 'skip_cores',
+    );
+    my @argv = @ARGV;
+    while (defined(my $arg = shift @argv)) {
+        if (exists $flag_for{$arg}) { $opt{ $flag_for{$arg} } = 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 $start_time = now();
+    my @warnings;
+    my @failures;
+    my %results;
+
+    my %opt = parse_args();
+    check_root();
+    my ($os_id, $os_display, $version_id) = detect_os();
+    my $dnf_major = dnf_generation();
+
+    my $bar = "═" x 60;
+    print STDERR "\n${BOLD}${bar}$RESET\n";
+    print STDERR "${BOLD}  System Optimise  v$VERSION  ($os_display $version_id)$RESET\n";
+    print STDERR "${BOLD}${bar}$RESET\n";
+    if ($opt{dry_run}) {
+        print STDERR "\n  ${YELLOW}${BOLD}DRY RUN: no changes will be made$RESET\n";
+    }
+    print STDERR "\n";
+
+    my @sections = (
+        ['dnf', 'DNF Cleanup',
+            sub { dnf_cleanup($os_id, $dnf_major, dry_run => $opt{dry_run}, warnings => \@warnings) },
+            $opt{skip_dnf} ? '--skip-dnf' : undef],
+        ['journal', 'Journal Cleanup',
+            sub { journal_cleanup(dry_run => $opt{dry_run}, warnings => \@warnings) },
+            $opt{skip_journal} ? '--skip-journal' : undef],
+        ['systemd', 'systemd Audit',
+            sub { systemd_audit(warnings => \@warnings) },
+            undef],
+        ['tmp', 'Temp File Cleanup',
+            sub { temp_cleanup(dry_run => $opt{dry_run}, warnings => \@warnings) },
+            $opt{skip_tmp} ? '--skip-tmp' : undef],
+        ['cores', 'Core Dump Cleanup',
+            sub { coredump_cleanup(dry_run => $opt{dry_run}, warnings => \@warnings) },
+            $opt{skip_cores} ? '--skip-cores' : undef],
+        ['packages', 'Package Audit',
+            sub { package_audit($dnf_major, warnings => \@warnings) },
+            undef],
+    );
+
+    # Every section is isolated: one that fails or dies is recorded and reported
+    # without stopping the rest or the summary.
+    for my $section (@sections) {
+        my ($key, $title, $code, $skip_flag) = @$section;
+        print STDERR "\n${BOLD}── $title ──$RESET\n";
+        if (defined $skip_flag) {
+            _info("$title: skipped ($skip_flag)");
+            next;
+        }
+        my $result = eval { $code->() };
+        if (my $error = $@) {
+            $error =~ s/\s+\z//;
+            _fail("$title crashed: $error");
+            push @failures, "$title: crashed ($error)";
+            next;
+        }
+        $results{$key} = $result;
+        push @failures, map { "$title: $_" } @{ $result->{errors} // [] };
+    }
+
+    my $elapsed = now() - $start_time;
+    print_summary($os_display, $version_id, \%results, \@warnings, $elapsed,
+        dry_run => $opt{dry_run});
+
+    if (@failures) {
+        print STDERR "${RED}${BOLD}Failed operations (" . scalar(@failures) . "):$RESET\n";
+        _fail($_) for @failures;
+        print STDERR "\n";
+        exit 1;
+    }
+    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;
diff --git a/tests/container/rig.pl b/tests/container/rig.pl
new file mode 100644
index 0000000..b1ffd3d
--- /dev/null
+++ b/tests/container/rig.pl
@@ -0,0 +1,732 @@
+#!/usr/bin/perl
+# Rig for sglang-deploy.pl: runs the real script as root inside a container against
+# stub commands, and checks the state, the written files and the exit codes it leaves.
+use strict;
+use warnings;
+
+# The rig file lives beside this repository's other checks, everything it writes lives
+# in a work directory that is bind mounted into the container, and the script under test
+# is the one in the repository root.
+my $RIG    = $0 =~ m{^(.*)/[^/]+$} ? $1 : '.';
+my $WORK   = $ENV{SGLANG_RIG_WORK} // '/tmp/sglang-rig';
+my $BIN    = "$WORK/bin";
+my $FIX    = "$WORK/fixture";
+my $ST     = "$WORK/state";
+my $LOG    = "$WORK/log/stubs.log";
+my $SCRIPT = $ENV{SGLANG_RIG_SCRIPT} // "$RIG/../../sglang-deploy.pl";
+my $UNIT   = '/etc/systemd/system/sglang.service';
+my $ENVFILE = '/etc/sysconfig/sglang';
+my $NGINX  = '/etc/nginx/conf.d/sglang.conf';
+my $CERTDIR = '/etc/ssl/sglang';
+my $STATEDIR = '/opt/sglang';
+
+my ($passed, $failed) = (0, 0);
+my @failures;
+
+sub check {
+    my ($cond, $label) = @_;
+    if (!defined $label || $label eq '') {
+        my @stack;
+        for my $i (0 .. 3) {
+            my @c = caller($i);
+            push @stack, join(':', $c[1] // '?', $c[2] // '?');
+        }
+        $label = 'no label, stack ' . join(' <- ', @stack);
+    }
+    if ($cond) { $passed++; print "ok   $label\n"; return 1 }
+    $failed++;
+    push @failures, $label;
+    print "FAIL $label\n";
+    return 0;
+}
+
+# The verdict is forced into a boolean: a bare match in a sub argument list is a list
+# context, where a failed match yields the empty list and would shift the label into
+# the condition slot, turning a failure into a silent pass.
+sub check_like {
+    my ($text, $re, $label) = @_;
+    $label = 'check_like without a label' unless defined $label;
+    my $matched = (defined $text && $text =~ $re) ? 1 : 0;
+    return check($matched, $label);
+}
+
+sub check_unlike {
+    my ($text, $re, $label) = @_;
+    $label = 'check_unlike without a label' unless defined $label;
+    my $matched = (defined $text && $text !~ $re) ? 1 : 0;
+    return check($matched, $label);
+}
+
+# Directories are made and removed with the language's own calls, so no module has to
+# be installed on the machine running the rig.
+sub make_dirs {
+    for my $path (@_) {
+        next if -d $path;
+        my @parts = split m{/}, $path;
+        my $built = '';
+        for my $part (@parts) {
+            next unless length $part;
+            $built .= "/$part";
+            mkdir($built, 0755) unless -d $built;
+        }
+    }
+    return;
+}
+
+sub remove_tree {
+    my ($path) = @_;
+    return unless -d $path;
+    if (opendir(my $dh, $path)) {
+        for my $entry (readdir($dh)) {
+            next if $entry eq '.' || $entry eq '..';
+            my $child = "$path/$entry";
+            remove_tree($child) if -d $child;
+            unlink($child);
+        }
+        closedir($dh);
+    }
+    rmdir($path);
+    return;
+}
+
+sub slurp_file {
+    my ($path) = @_;
+    return '' unless -f $path;
+    open(my $fh, '<', $path) or return '';
+    local $/ = undef;
+    my $text = <$fh>;
+    close($fh);
+    return defined $text ? $text : '';
+}
+
+sub mode_of {
+    my ($path) = @_;
+    return sprintf('%04o', (stat($path))[2] & 07777);
+}
+
+sub reset_fixture {
+    for my $path ($UNIT, $ENVFILE, $NGINX) {
+        unlink($path);
+    }
+    remove_tree($CERTDIR);
+    remove_tree($STATEDIR);
+    remove_tree($FIX);
+    remove_tree($ST);
+    # Directories a host that ran server-setup.pl has: nginx's configuration drop-in
+    # and systemd's unit directory.
+    make_dirs($FIX, $ST, "$WORK/log", '/etc/nginx/conf.d', '/etc/systemd/system');
+    my $fh;
+    open($fh, q{>}, $LOG) and close($fh);
+    # Packages a real host or a previous run has already installed.
+    write_fixture('rpm-installed', "nginx\n");
+    write_fixture('fw-services', "\n");
+    # firewalld is running: server-setup.pl ensures it, and the firewall step needs it.
+    my $fw;
+    open($fw, '>', "$ST/active.firewalld") and close($fw);
+    return;
+}
+
+sub write_fixture {
+    my ($name, $content) = @_;
+    open(my $fh, '>', "$FIX/$name") or die "cannot write $FIX/$name: $!\n";
+    print {$fh} $content;
+    close($fh);
+    return;
+}
+
+sub fixture_exists {
+    my ($name) = @_;
+    return -f "$FIX/$name" ? 1 : 0;
+}
+
+# Run the script with the stub PATH and return (rc, merged output).
+sub run_script {
+    my (@args) = @_;
+    my $out_file = "$WORK/log/run.out";
+    my $pid = fork();
+    die "cannot fork: $!\n" unless defined $pid;
+    if ($pid == 0) {
+        open(STDOUT, '>', $out_file);
+        open(STDERR, '>&', \*STDOUT);
+        $ENV{PATH} = "$BIN:/usr/bin:/bin";
+        # The stubs read the work directory from the environment, since they are
+        # reached through links and cannot tell where the rig file lives.
+        $ENV{STUB_WORK} = $WORK;
+        exec '/usr/bin/perl', $SCRIPT, @args;
+        exit 126;
+    }
+    waitpid($pid, 0);
+    my $rc = $? >> 8;
+    return ($rc, slurp_file($out_file));
+}
+
+sub stub_log {
+    return slurp_file($LOG);
+}
+
+sub count_in_log {
+    my ($pattern) = @_;
+    my @lines = grep { /$pattern/ } split /\n/, stub_log();
+    return scalar @lines;
+}
+
+sub reset_log {
+    my $fh;
+    open($fh, q{>}, $LOG) and close($fh);
+    return;
+}
+
+# ---------------------------------------------------------------------------
+# Scenarios
+# ---------------------------------------------------------------------------
+
+# The stubs are one dispatcher file reached through links named after each command,
+# so the script's own PATH lookup finds them and nothing of the real system is used.
+sub prepare_stubs {
+    make_dirs($BIN, $FIX, $ST, "$WORK/log");
+    for my $name (qw(lspci rpm dnf podman systemctl curl openssl nginx
+        firewall-cmd getenforce getsebool setsebool)) {
+        my $link = "$BIN/$name";
+        # A link left over from a work directory that moved reads as broken to
+        # -e, and its stale target would leave the stubs unreachable: it is
+        # replaced rather than kept or died on.
+        if (-l $link && !-e $link) { unlink($link) }
+        next if -e $link;
+        symlink("$RIG/stub.pl", $link) or die "cannot link $link: $!\n";
+    }
+    return;
+}
+
+sub prepare_devices {
+    # The driver creates these on a real host; the rig fakes them (needs --privileged).
+    return if -e q{/dev/kfd};
+    system(qw(mknod /dev/kfd c 237 0));
+    mkdir(q{/dev/dri}, 0755) unless -d q{/dev/dri};
+    return;
+}
+
+sub scenario_fresh {
+    reset_fixture();
+    write_fixture('gpu.txt', "03:00.0 VGA compatible controller [0300]: Advanced Micro Devices, Inc. [AMD/ATI] Instinct MI300X OAM [1002:74a1] (rev 01)\n");
+    write_fixture('rocm.txt', "7.2.4\n");
+    my ($rc, $out) = run_script('--model', 'ZhipuAI/GLM-5.3');
+
+    check($rc == 0, 'fresh: exit 0');
+    check(-f $UNIT, 'fresh: unit written');
+    check(-f $ENVFILE, 'fresh: environment file written');
+    check(-f $NGINX, 'fresh: nginx configuration written');
+    check(-f "$CERTDIR/sglang.crt" && -f "$CERTDIR/sglang.key", 'fresh: certificate written');
+    check(-d "$STATEDIR/modelscope", 'fresh: model cache directory created');
+    check(mode_of($ENVFILE) eq '0600', 'fresh: environment file is 0600 (' . mode_of($ENVFILE) . ')');
+    check(mode_of("$CERTDIR/sglang.key") eq '0600', 'fresh: key is 0600');
+    check(mode_of("$CERTDIR/sglang.crt") eq '0644', 'fresh: certificate is 0644');
+
+    my $env = slurp_file($ENVFILE);
+    check_like($env, qr/^SGLANG_API_KEY=([A-Za-z0-9_-]{43})\n$/, 'fresh: generated key, url-safe, 43 chars');
+
+    my $unit = slurp_file($UNIT);
+    check_like($unit, qr|docker\.io/lmsysorg/sglang:v0\.5\.19-rocm724-mi30x|, 'fresh: image resolved from ROCm 7.2.4 and MI300');
+    check_like($unit, qr/--tp-size 1/, 'fresh: tensor parallel default');
+    check_like($unit, qr/--context-length 4096/, 'fresh: context length default');
+    check_like($unit, qr/--mem-fraction-static 0\.9/, 'fresh: memory fraction default');
+    check_unlike($unit, qr/SGLANG_USE_AITER/, 'fresh: no Radeon variables on an Instinct host');
+
+    my $nginx = slurp_file($NGINX);
+    check_like($nginx, qr|proxy_pass http://\[::1\]:8000;|, 'fresh: nginx proxies to the loopback engine');
+    check_like($nginx, qr|ssl_certificate /etc/ssl/sglang/sglang\.crt;|, 'fresh: nginx uses the sglang certificate');
+
+    check(count_in_log(qr/^podman pull /) == 1, 'fresh: exactly one image pull');
+    check_like(stub_log(), qr/^podman pull docker\.io\/lmsysorg\/sglang:v0\.5\.19-rocm724-mi30x$/m,
+        'fresh: the pulled image is the resolved tag');
+    check(count_in_log(qr/^systemctl enable sglang$/) == 1, 'fresh: service enabled');
+    check(count_in_log(qr/^systemctl start sglang$/) == 1, 'fresh: service started');
+    check_like(stub_log(), qr/^firewall-cmd --permanent --add-service=https$/m, 'fresh: HTTPS opened');
+    check_like($out, qr/Engine image: docker\.io\/lmsysorg\/sglang:v0\.5\.19-rocm724-mi30x/,
+        'fresh: summary names the image');
+    check_like($out, qr/systemd: sglang running on \[::1\]:8000/, 'fresh: summary names the endpoint');
+    check_like($out, qr/API key \(shown once, store it securely\)/, 'fresh: the generated key is shown once');
+    check_unlike($out, qr/✗/, 'fresh: no failed step');
+    return;
+}
+
+sub scenario_rerun {
+    scenario_fresh();
+    reset_log();
+    my $key_before = slurp_file($ENVFILE);
+    my $unit_before = slurp_file($UNIT);
+    my ($rc, $out) = run_script('--model', 'ZhipuAI/GLM-5.3');
+
+    check($rc == 0, 'rerun: exit 0');
+    check(count_in_log(qr/^podman pull /) == 0, 'rerun: no second pull');
+    check_like(stub_log(), qr/^podman image exists /m, 'rerun: the image is checked instead');
+    check(count_in_log(qr/^systemctl enable sglang$/) == 0, 'rerun: no second enable');
+    check(count_in_log(qr/^systemctl start sglang$/) == 0, 'rerun: no second start');
+    check(count_in_log(qr/try-restart/) == 0, 'rerun: no restart, the unit did not change');
+    check(count_in_log(qr/^dnf install /) == 0, 'rerun: no second package transaction');
+    check(slurp_file($ENVFILE) eq $key_before, 'rerun: the API key is reused, not regenerated');
+    check(slurp_file($UNIT) eq $unit_before, 'rerun: the unit file is byte-identical');
+    check_like($out, qr/API key: existing key reused/, 'rerun: the key is reported as reused');
+    check_like($out, qr/Engine image: already present/, 'rerun: the image is reported present');
+    check_like($out, qr/systemd: sglang running/, 'rerun: the service is reported running');
+    check_unlike($out, qr/would /, 'rerun: nothing is phrased as would');
+    check_unlike($out, qr/✗/, 'rerun: no failed step');
+    return;
+}
+
+sub scenario_dry_run {
+    reset_fixture();
+    write_fixture('gpu.txt', "03:00.0 VGA compatible controller [0300]: Advanced Micro Devices, Inc. [AMD/ATI] Instinct MI300X OAM [1002:74a1] (rev 01)\n");
+    write_fixture('rocm.txt', "7.2.4\n");
+    my ($rc, $out) = run_script('--model', 'ZhipuAI/GLM-5.3', '--dry-run');
+
+    check($rc == 0, 'dry run: exit 0');
+    check(!-f $UNIT, 'dry run: no unit written');
+    check(!-f $ENVFILE, 'dry run: no environment file written');
+    check(!-f $NGINX, 'dry run: no nginx configuration written');
+    check(!-d $CERTDIR, 'dry run: no certificate directory');
+    check(count_in_log(qr/^podman pull /) == 0, 'dry run: no pull');
+    check(count_in_log(qr/^systemctl (enable|start) /) == 0, 'dry run: no service change');
+    check(count_in_log(qr/^dnf install /) == 0, 'dry run: no package transaction');
+    check_like($out, qr/DRY RUN: no changes will be made/, 'dry run: banner');
+    check_like($out, qr/would be pulled|would be installed/, 'dry run: phrased as would');
+    check_like($out, qr|Engine image: docker\.io/lmsysorg/sglang:v0\.5\.19-rocm724-mi30x|,
+        'dry run: the resolved image is reported');
+    return;
+}
+
+sub scenario_uninstall {
+    scenario_fresh();
+    reset_log();
+    my ($rc, $out) = run_script('--uninstall');
+
+    check($rc == 0, 'uninstall: exit 0');
+    check(!-f $UNIT, 'uninstall: unit removed');
+    check(!-f $ENVFILE, 'uninstall: environment file removed');
+    check(!-f $NGINX, 'uninstall: nginx configuration removed');
+    check(!-d $CERTDIR, 'uninstall: certificate directory removed');
+    check(-d $STATEDIR, 'uninstall: model cache kept');
+    check(-e "$ST/image.docker.io_lmsysorg_sglang_v0.5.19-rocm724-mi30x",
+        'uninstall: the image is kept in podman');
+    check_like(stub_log(), qr/^systemctl stop sglang$/m, 'uninstall: service stopped');
+    check_like(stub_log(), qr/^systemctl disable sglang$/m, 'uninstall: service disabled');
+    check_like($out, qr/SGLang service stopped/, 'uninstall: summary reports the stop');
+    check_like($out, qr/Kept on the system/, 'uninstall: the kept state is listed');
+    check_like($out, qr/ModelScope cache/, 'uninstall: the cache is named as kept');
+    return;
+}
+
+sub scenario_uninstall_twice {
+    scenario_uninstall();
+    reset_log();
+    my ($rc, $out) = run_script('--uninstall');
+    check($rc == 0, 'uninstall twice: exit 0');
+    check_like($out, qr/already absent/, 'uninstall twice: idempotent');
+    check(count_in_log(qr/^systemctl stop /) == 0, 'uninstall twice: nothing to stop');
+    return;
+}
+
+sub scenario_radeon {
+    reset_fixture();
+    write_fixture('gpu.txt', "03:00.0 VGA compatible controller [0300]: Advanced Micro Devices, Inc. [AMD/ATI] Navi 31 [Radeon RX 7900 XTX] [1002:744c] (rev c8)\n");
+    write_fixture('rocm.txt', "7.2.4\n");
+    my ($rc, $out) = run_script('--model', 'ZhipuAI/GLM-5.3');
+
+    check($rc == 1, 'radeon: exit 1');
+    check_like($out, qr/Radeon card detected/, 'radeon: names the cause');
+    check_like($out, qr/rocm\.Dockerfile/, 'radeon: names the build recipe');
+    check_like($out, qr/--image sglang-rocm:latest/, 'radeon: names the way forward');
+    check(!-f $UNIT, 'radeon: nothing deployed');
+    return;
+}
+
+sub scenario_radeon_dev {
+    reset_fixture();
+    write_fixture('gpu.txt', "03:00.0 VGA compatible controller [0300]: Advanced Micro Devices, Inc. [AMD/ATI] Strix Halo [Radeon Graphics / Radeon 8050S Graphics / Radeon 8060S Graphics] [1002:1586] (rev d1)\n");
+    write_fixture('rocm.txt', "7.2.4\n");
+    my ($rc, $out) = run_script('--model', 'ZhipuAI/GLM-5.3');
+
+    check($rc == 0, 'radeon dev: exit 0');
+    check_like(stub_log(), qr{^curl .*rocm/sgl-dev/tags\?.*$}m,
+        'radeon dev: the AMD tag index is asked for the newest build');
+    my $unit = slurp_file($UNIT);
+    check_like($unit, qr|docker\.io/rocm/sgl-dev:v0\.5\.19-rocm724-gfx1151-20260916|,
+        'radeon dev: the newest dated build is deployed');
+    check_like($unit, qr/Environment=SGLANG_USE_AITER=false/, 'radeon dev: AITER off');
+    check_like($unit, qr/Environment=SGLANG_ROCM_FUSED_DECODE_MLA=false/,
+        'radeon dev: fused decode MLA off');
+    check_like($out, qr/AMD publishes this build daily/, 'radeon dev: the moving tag is stated');
+    check_like($out, qr/the only flavour published for gfx1151/, 'radeon dev: the flavour is explained');
+
+    reset_log();
+    my ($rc2, $out2) = run_script('--model', 'ZhipuAI/GLM-5.3', '--image', 'localhost/pinned:1');
+    check_like(slurp_file($UNIT), qr|localhost/pinned:1|, 'radeon dev: --image pins a build');
+    check(count_in_log(qr{^curl .*rocm/sgl-dev/tags\?.*$}) == 0,
+        'radeon dev: no tag resolution when --image is given');
+    return;
+}
+
+sub scenario_radeon_with_image {
+    reset_fixture();
+    write_fixture('gpu.txt', "03:00.0 VGA compatible controller [0300]: Advanced Micro Devices, Inc. [AMD/ATI] Strix Halo [Radeon 8060S] [1002:150e]\n");
+    my ($rc, $out) = run_script('--model', 'ZhipuAI/GLM-5.3', '--image', 'localhost/sglang-rocm:gfx1151');
+
+    check($rc == 0, 'radeon with image: exit 0');
+    my $unit = slurp_file($UNIT);
+    check_like($unit, qr/Environment=SGLANG_USE_AITER=false/, 'radeon with image: AITER off');
+    check_like($unit, qr/Environment=SGLANG_ROCM_FUSED_DECODE_MLA=false/,
+        'radeon with image: fused decode MLA off');
+    check_like($unit, qr|localhost/sglang-rocm:gfx1151|, 'radeon with image: the requested image');
+    my ($rc2, $out2) = run_script('--model', 'ZhipuAI/GLM-5.3', '--image', 'localhost/sglang-rocm:gfx1151');
+    check($rc2 == 0, 'radeon with image: rerun exit 0');
+    check(slurp_file($UNIT) eq $unit, 'radeon with image: the unit is unchanged on a rerun');
+    return;
+}
+
+sub scenario_rocm_flavours {
+    reset_fixture();
+    write_fixture('gpu.txt', "03:00.0 VGA compatible controller [0300]: Advanced Micro Devices, Inc. [AMD/ATI] Instinct MI300X OAM [1002:74a1]\n");
+    write_fixture('rocm.txt', "7.2.3\n");
+    my ($rc, $out) = run_script('--dry-run', '--model', 'ZhipuAI/GLM-5.3');
+    check_like($out, qr/rocm720-mi30x/, 'flavour: ROCm 7.2.3 takes rocm720');
+    reset_fixture();
+    write_fixture('gpu.txt', "03:00.0 VGA compatible controller [0300]: Advanced Micro Devices, Inc. [AMD/ATI] Instinct MI300X OAM [1002:74a1]\n");
+    write_fixture('rocm.txt', "10.0.0\n");
+    ($rc, $out) = run_script('--dry-run', '--model', 'ZhipuAI/GLM-5.3');
+    check_like($out, qr/rocm10-mi30x/, 'flavour: ROCm 10.0.0 takes rocm10');
+    reset_fixture();
+    write_fixture('gpu.txt', "03:00.0 VGA compatible controller [0300]: Advanced Micro Devices, Inc. [AMD/ATI] Instinct MI350X [1002:75a0]\n");
+    write_fixture('rocm.txt', "7.2.4\n");
+    ($rc, $out) = run_script('--dry-run', '--model', 'ZhipuAI/GLM-5.3');
+    check_like($out, qr/rocm724-mi35x/, 'flavour: MI350X takes mi35x');
+    reset_fixture();
+    write_fixture('gpu.txt', "03:00.0 VGA compatible controller [0300]: Advanced Micro Devices, Inc. [AMD/ATI] Instinct MI300X OAM [1002:74a1]\n");
+    write_fixture('rocm.txt', "6.4.0\n");
+    ($rc, $out) = run_script('--model', 'ZhipuAI/GLM-5.3');
+    check($rc == 1, 'flavour: an old host ROCm is refused');
+    check_like($out, qr/No published image targets ROCm 6\.4\.0/, 'flavour: the refusal names the version');
+    check_like($out, qr/--image/, 'flavour: the refusal names the way forward');
+    reset_fixture();
+    write_fixture('gpu.txt', "03:00.0 VGA compatible controller [0300]: Advanced Micro Devices, Inc. [AMD/ATI] Instinct MI300X OAM [1002:74a1]\n");
+    ($rc, $out) = run_script('--dry-run', '--model', 'ZhipuAI/GLM-5.3');
+    check_like($out, qr/rocm10-mi30x/, 'flavour: no host ROCm takes the newest');
+    check_like($out, qr/No ROCm userland found on the host/, 'flavour: the assumption is stated out loud');
+    return;
+}
+
+sub scenario_modelscope {
+    reset_fixture();
+    write_fixture('gpu.txt', "03:00.0 VGA compatible controller [0300]: Advanced Micro Devices, Inc. [AMD/ATI] Instinct MI300X OAM [1002:74a1]\n");
+    write_fixture('rocm.txt', "7.2.4\n");
+    write_fixture('ms.code', "200\n");
+    write_fixture('ms.json', qq({"Data":{"Name":"GLM-5.3"}}\n));
+    my ($rc, $out) = run_script('--dry-run', '--model', 'ZhipuAI/GLM-5.3');
+    check_like($out, qr/Verifying GLM 5\.3 on ModelScope\.\.\. found/, 'modelscope: found');
+
+    reset_fixture();
+    write_fixture('gpu.txt', "03:00.0 VGA compatible controller [0300]: Advanced Micro Devices, Inc. [AMD/ATI] Instinct MI300X OAM [1002:74a1]\n");
+    write_fixture('rocm.txt', "7.2.4\n");
+    write_fixture('ms.code', "404\n");
+    ($rc, $out) = run_script('--model', 'nope/does-not-exist');
+    check($rc == 1, 'missing model: exit 1');
+    check_like($out, qr/does not exist on ModelScope/, 'missing model: named as missing');
+
+    reset_fixture();
+    write_fixture('gpu.txt', "03:00.0 VGA compatible controller [0300]: Advanced Micro Devices, Inc. [AMD/ATI] Instinct MI300X OAM [1002:74a1]\n");
+    write_fixture('rocm.txt', "7.2.4\n");
+    # A 200 without a Name carries no usable answer: the deployment proceeds with
+    # the probe marked unverified rather than blocked.
+    write_fixture('ms.code', "200\n");
+    write_fixture('ms.json', qq({}\n));
+    ($rc, $out) = run_script('--dry-run', '--model', 'ZhipuAI/GLM-5.3');
+    check($rc == 0, 'modelscope: an unnamed answer does not block');
+    check_like($out, qr/could not verify/, 'modelscope: the unnamed answer reads as unverified');
+    return;
+}
+
+sub scenario_hardware {
+    reset_fixture();
+    my ($rc, $out) = run_script('--model', 'ZhipuAI/GLM-5.3');
+    check($rc == 1, 'no GPU: exit 1');
+    check_like($out, qr/No AMD GPU detected/, 'no GPU: named as missing');
+
+    # The missing driver is checked outside the rig: podman bind-mounts /dev/kfd into a
+    # privileged container, so it cannot be removed from inside one.
+    return;
+}
+
+# Run without a GPU device node (a container without --privileged, or a host whose
+# driver is not loaded): the script must refuse and say what is missing.
+sub scenario_no_driver {
+    reset_fixture();
+    write_fixture('gpu.txt', "03:00.0 VGA compatible controller [0300]: Advanced Micro Devices, Inc. [AMD/ATI] Instinct MI300X OAM [1002:74a1]\n");
+    if (-e '/dev/kfd') {
+        print "skip no driver: this run has the device node (needs a run without --privileged)\n";
+        return;
+    }
+    my ($rc, $out) = run_script('--model', 'ZhipuAI/GLM-5.3');
+    check($rc == 1, 'no driver: exit 1');
+    check_like($out, qr/amdgpu kernel driver is not ready/, 'no driver: named as missing');
+    check_like($out, qr{/dev/kfd}, 'no driver: names the device node');
+    check(!-f $UNIT, 'no driver: nothing deployed');
+    return;
+}
+
+sub scenario_bad_os {
+    reset_fixture();
+    write_fixture('gpu.txt', "03:00.0 VGA compatible controller [0300]: Advanced Micro Devices, Inc. [AMD/ATI] Instinct MI300X OAM [1002:74a1]\n");
+    write_fixture('os-release', "ID=ubuntu\nVERSION_ID=\"24.04\"\n");
+    my $real = slurp_file('/etc/os-release');
+    open(my $fh, '>', '/etc/os-release') or die "cannot write /etc/os-release: $!\n";
+    print {$fh} slurp_file("$FIX/os-release");
+    close($fh);
+    my ($rc, $out) = run_script('--model', 'ZhipuAI/GLM-5.3', '--dry-run');
+    open(my $back, '>', '/etc/os-release') or die "cannot restore /etc/os-release: $!\n";
+    print {$back} $real;
+    close($back);
+
+    check($rc == 1, 'bad OS: exit 1');
+    check_like($out, qr/Unsupported operating system: 'ubuntu'/, 'bad OS: names the system');
+    check_like($out, qr/Supported systems: Fedora, CentOS Stream, openEuler/, 'bad OS: lists the supported ones');
+    return;
+}
+
+sub scenario_validation {
+    reset_fixture();
+    write_fixture('gpu.txt', "03:00.0 VGA compatible controller [0300]: Advanced Micro Devices, Inc. [AMD/ATI] Instinct MI300X OAM [1002:74a1]\n");
+    my ($rc, $out) = run_script('--model', 'ZhipuAI/GLM-5.3', '--port', '443', '--dry-run');
+    check($rc == 1, 'validation: port 443 refused');
+    check_like($out, qr/must be 1-65535 and not 443/, 'validation: port message');
+    ($rc, $out) = run_script('--model', 'not-a-model-id', '--dry-run');
+    check($rc == 1, 'validation: bad model ID refused');
+    check_like($out, qr/Invalid model ID/, 'validation: model message');
+    ($rc, $out) = run_script('--model', 'ZhipuAI/GLM-5.3', '--gpu-memory-utilization', '1.5', '--dry-run');
+    check($rc == 1, 'validation: memory fraction above 1 refused');
+    check_like($out, qr/must be in \(0, 1\]/, 'validation: memory fraction message');
+    ($rc, $out) = run_script('--model', 'ZhipuAI/GLM-5.3', '--api-key', 'has space', '--dry-run');
+    check($rc == 1, 'validation: whitespace API key refused');
+    ($rc, $out) = run_script('--model', 'ZhipuAI/GLM-5.3', '--rocm-flavour', 'rocm999', '--dry-run');
+    check($rc == 1, 'validation: unknown flavour refused');
+    check_like($out, qr/Invalid --rocm-flavour/, 'validation: flavour message');
+    ($rc, $out) = run_script('--model', 'ZhipuAI/GLM-5.3', '--image', 'bad image%name', '--dry-run');
+    check($rc == 1, 'validation: image with whitespace or % refused');
+    check_like($out, qr/Invalid --image/, 'validation: image message');
+    return;
+}
+
+sub scenario_api_key_argument {
+    reset_fixture();
+    write_fixture('gpu.txt', "03:00.0 VGA compatible controller [0300]: Advanced Micro Devices, Inc. [AMD/ATI] Instinct MI300X OAM [1002:74a1]\n");
+    write_fixture('rocm.txt', "7.2.4\n");
+    my ($rc, $out) = run_script('--model', 'ZhipuAI/GLM-5.3', '--api-key', 'chosen-key-1234');
+    check($rc == 0, 'api key argument: exit 0');
+    check_like(slurp_file($ENVFILE), qr/^SGLANG_API_KEY=chosen-key-1234$/, 'api key argument: the key is stored');
+    check_unlike($out, qr/chosen-key-1234/, 'api key argument: a given key is never echoed');
+    my $unit = slurp_file($UNIT);
+    check_unlike($unit, qr/chosen-key-1234/, 'api key argument: the key is not in the unit');
+    return;
+}
+
+sub scenario_non_root {
+    reset_fixture();
+    my $out_file = "$WORK/log/run.out";
+    my $pid = fork();
+    die "cannot fork: $!\n" unless defined $pid;
+    if ($pid == 0) {
+        open(STDOUT, '>', $out_file);
+        open(STDERR, '>&', \*STDOUT);
+        $ENV{PATH} = "$BIN:/usr/bin:/bin";
+        $ENV{STUB_WORK} = $WORK;
+        $) = 1000;
+        $> = 1000;
+        exec '/usr/bin/perl', $SCRIPT, '--version';
+        exit 126;
+    }
+    waitpid($pid, 0);
+    my $rc = $? >> 8;
+    my $out = slurp_file($out_file);
+    check($rc == 0, 'non-root: --version works without root');
+    check_like($out, qr/^sglang-deploy\.pl 2\.0\.0$/, 'non-root: the version is printed');
+
+    my $pid3 = fork();
+    die "cannot fork: $!\n" unless defined $pid3;
+    if ($pid3 == 0) {
+        open(STDOUT, '>', $out_file);
+        open(STDERR, '>&', \*STDOUT);
+        $ENV{PATH} = "$BIN:/usr/bin:/bin";
+        $ENV{STUB_WORK} = $WORK;
+        $) = 1000;
+        $> = 1000;
+        exec '/usr/bin/perl', $SCRIPT, '--model', 'ZhipuAI/GLM-5.3';
+        exit 126;
+    }
+    waitpid($pid3, 0);
+    my $rc3 = $? >> 8;
+    my $out3 = slurp_file($out_file);
+    check($rc3 == 1, 'non-root: exit 1');
+    check_like($out3, qr/must be run as root/, 'non-root: the message says so');
+    return;
+}
+
+sub scenario_offline {
+    reset_fixture();
+    write_fixture('gpu.txt', "03:00.0 VGA compatible controller [0300]: Advanced Micro Devices, Inc. [AMD/ATI] Instinct MI300X OAM [1002:74a1]\n");
+    write_fixture('rocm.txt', "7.2.4\n");
+    write_fixture('image-missing', "1\n");
+    my ($rc, $out) = run_script('--model', 'ZhipuAI/GLM-5.3');
+    check($rc == 1, 'unpublished tag: exit 1');
+    check_like($out, qr/resolved image tag does not exist/, 'unpublished tag: named as missing');
+    check_like($out, qr/--image/, 'unpublished tag: names the way forward');
+    return;
+}
+
+sub scenario_dependency_section {
+    reset_fixture();
+    write_fixture('gpu.txt', "03:00.0 VGA compatible controller [0300]: Advanced Micro Devices, Inc. [AMD/ATI] Instinct MI300X OAM [1002:74a1]\n");
+    write_fixture('rocm.txt', "7.2.4\n");
+    write_fixture('rpm-installed', "pciutils\ncurl\nopenssl\npodman\nnginx\n");
+    reset_log();
+    my ($rc, $out) = run_script('--model', 'ZhipuAI/GLM-5.3', '--dry-run');
+    check($rc == 0, 'deps: exit 0');
+    check(count_in_log(qr/^dnf install /) == 0, 'deps: no transaction when all packages are present');
+    check_like($out, qr/All 4 packages already installed/, 'deps: reported as present');
+
+    reset_fixture();
+    write_fixture('gpu.txt', "03:00.0 VGA compatible controller [0300]: Advanced Micro Devices, Inc. [AMD/ATI] Instinct MI300X OAM [1002:74a1]\n");
+    write_fixture('rocm.txt', "7.2.4\n");
+    write_fixture('rpm-installed', "\n");
+    reset_log();
+    ($rc, $out) = run_script('--model', 'ZhipuAI/GLM-5.3');
+    check_like(stub_log(), qr/^dnf install -y pciutils curl openssl podman$/m,
+        'deps: the four packages are installed in one transaction');
+    check_like($out, qr/nginx \(reverse proxy\) is not installed: run server-setup.pl first/,
+        'deps: the missing reverse proxy is warned about');
+    return;
+}
+
+sub scenario_custom_layout {
+    reset_fixture();
+    write_fixture('gpu.txt', "03:00.0 VGA compatible controller [0300]: Advanced Micro Devices, Inc. [AMD/ATI] Instinct MI300X OAM [1002:74a1]\n");
+    write_fixture('rocm.txt', "7.2.4\n");
+    my ($rc, $out) = run_script(
+        '--model', 'ZhipuAI/GLM-5.3',
+        '--service-name', 'llm',
+        '--state-dir', '/srv/llm',
+        '--cert-dir', '/etc/ssl/llm',
+        '--port', '9000',
+        '--tensor-parallel', '8',
+        '--max-model-len', '131072',
+        '--gpu-memory-utilization', '0.85',
+    );
+    check($rc == 0, 'custom layout: exit 0');
+    check(-f '/etc/systemd/system/llm.service', 'custom layout: the named unit is written');
+    check(-f '/etc/nginx/conf.d/llm.conf', 'custom layout: the named nginx file is written');
+    # The certificate file names follow the program, as they did before, not the
+    # service name; the directory follows --cert-dir.
+    check(-f '/etc/ssl/llm/sglang.crt', 'custom layout: certificates follow the directory');
+    check(-d '/srv/llm/modelscope', 'custom layout: the state directory follows');
+    my $unit = slurp_file('/etc/systemd/system/llm.service');
+    check_like($unit, qr/--port 9000/, 'custom layout: port in the unit');
+    check_like($unit, qr/--tp-size 8/, 'custom layout: tensor parallel in the unit');
+    check_like($unit, qr/--context-length 131072/, 'custom layout: context length in the unit');
+    check_like($unit, qr/--mem-fraction-static 0\.85/, 'custom layout: memory fraction in the unit');
+    check_like($unit, qr|--volume /srv/llm/modelscope:/root/\.cache/modelscope:Z|,
+        'custom layout: the cache volume follows the state directory');
+    unlink('/etc/systemd/system/llm.service');
+    unlink('/etc/nginx/conf.d/llm.conf');
+    remove_tree('/etc/ssl/llm');
+    remove_tree('/srv/llm');
+    return;
+}
+
+sub scenario_tls_existing {
+    reset_fixture();
+    write_fixture('gpu.txt', "03:00.0 VGA compatible controller [0300]: Advanced Micro Devices, Inc. [AMD/ATI] Instinct MI300X OAM [1002:74a1]\n");
+    write_fixture('rocm.txt', "7.2.4\n");
+    run_script('--model', 'ZhipuAI/GLM-5.3');
+    my $crt = slurp_file("$CERTDIR/sglang.crt");
+    reset_log();
+    my ($rc, $out) = run_script('--model', 'ZhipuAI/GLM-5.3');
+    check(slurp_file("$CERTDIR/sglang.crt") eq $crt, 'tls: an existing certificate is kept');
+    check(count_in_log(qr/^openssl /) == 0, 'tls: no second certificate');
+    check_like($out, qr/TLS certificate: configured/, 'tls: reported as configured');
+    return;
+}
+
+sub scenario_stale_container {
+    reset_fixture();
+    write_fixture('gpu.txt', "03:00.0 VGA compatible controller [0300]: Advanced Micro Devices, Inc. [AMD/ATI] Instinct MI300X OAM [1002:74a1]\n");
+    write_fixture('rocm.txt', "7.2.4\n");
+    my $fh;
+    open($fh, q{>}, "$ST/container.sglang") and close($fh);
+    my ($rc, $out) = run_script('--uninstall');
+    check($rc == 0, 'stale container: uninstall exit 0');
+    check_like(stub_log(), qr/^podman rm -f sglang$/m, 'stale container: removed');
+    check(!-e "$ST/container.sglang", 'stale container: gone from podman');
+    return;
+}
+
+sub scenario_selinux {
+    reset_fixture();
+    write_fixture('gpu.txt', "03:00.0 VGA compatible controller [0300]: Advanced Micro Devices, Inc. [AMD/ATI] Instinct MI300X OAM [1002:74a1]\n");
+    write_fixture('rocm.txt', "7.2.4\n");
+    $ENV{STUB_SELINUX} = 'Permissive';
+    my ($rc, $out) = run_script('--model', 'ZhipuAI/GLM-5.3');
+    check(count_in_log(qr/^setsebool /) == 0, 'selinux: nothing set while permissive');
+    check_like($out, qr/SELinux: permissive \(skipped\)/, 'selinux: reported as skipped');
+
+    reset_fixture();
+    write_fixture('gpu.txt', "03:00.0 VGA compatible controller [0300]: Advanced Micro Devices, Inc. [AMD/ATI] Instinct MI300X OAM [1002:74a1]\n");
+    write_fixture('rocm.txt', "7.2.4\n");
+    $ENV{STUB_SELINUX} = 'Enforcing';
+    reset_log();
+    ($rc, $out) = run_script('--model', 'ZhipuAI/GLM-5.3');
+    check_like(stub_log(), qr/^setsebool -P httpd_can_network_connect=1$/m, 'selinux: the boolean is set');
+    check_like($out, qr/SELinux: httpd_can_network_connect on/, 'selinux: reported as on');
+    reset_log();
+    my ($rc2, $out2) = run_script('--model', 'ZhipuAI/GLM-5.3');
+    check(count_in_log(qr/^setsebool /) == 0, 'selinux: nothing set when already on');
+    delete $ENV{STUB_SELINUX};
+    return;
+}
+
+my %scenarios = (
+    fresh             => \&scenario_fresh,
+    rerun             => \&scenario_rerun,
+    dry_run           => \&scenario_dry_run,
+    uninstall         => \&scenario_uninstall,
+    uninstall_twice   => \&scenario_uninstall_twice,
+    radeon            => \&scenario_radeon,
+    radeon_dev        => \&scenario_radeon_dev,
+    radeon_with_image => \&scenario_radeon_with_image,
+    rocm_flavours     => \&scenario_rocm_flavours,
+    modelscope => \&scenario_modelscope,
+    hardware          => \&scenario_hardware,
+    bad_os            => \&scenario_bad_os,
+    no_driver         => \&scenario_no_driver,
+    validation        => \&scenario_validation,
+    api_key_argument  => \&scenario_api_key_argument,
+    non_root          => \&scenario_non_root,
+    offline           => \&scenario_offline,
+    dependencies      => \&scenario_dependency_section,
+    custom_layout     => \&scenario_custom_layout,
+    tls_existing      => \&scenario_tls_existing,
+    stale_container   => \&scenario_stale_container,
+    selinux           => \&scenario_selinux,
+);
+
+prepare_stubs();
+prepare_devices();
+
+my @wanted = @ARGV ? @ARGV : sort keys %scenarios;
+for my $name (@wanted) {
+    if (!exists $scenarios{$name}) {
+        print "FAIL unknown scenario $name\n";
+        $failed++;
+        next;
+    }
+    print "\n== $name ==\n";
+    $scenarios{$name}->();
+}
+
+print "\n" . ($failed ? "$failed FAILED of " . ($passed + $failed) : "all " . $passed . " checks passed") . "\n";
+exit($failed ? 1 : 0);
diff --git a/tests/container/stub.pl b/tests/container/stub.pl
new file mode 100644
index 0000000..ad2d78d
--- /dev/null
+++ b/tests/container/stub.pl
@@ -0,0 +1,220 @@
+#!/usr/bin/perl
+# Stub commands for the sglang-deploy.pl rig.  One file, dispatched by $0's basename,
+# so every stubbed tool answers from the fixture under /rig/fixture and /rig/state.
+use strict;
+use warnings;
+
+
+# Everything this stub reads and writes lives in the work directory the rig exports to
+# the script under test, which is why it is read from the environment: the stub is
+# reached through a link named after the command it stands in for.
+my $RIG = $ENV{STUB_WORK} // '/tmp/sglang-rig';
+my $FIX = "$RIG/fixture";
+my $ST  = "$RIG/state";
+my $LOG = "$RIG/log/stubs.log";
+
+my ($name) = $0 =~ m{([^/]+)$};
+my @args = @ARGV;
+
+sub log_call {
+    if (open(my $fh, '>>', $LOG)) {
+        print {$fh} "$name @args\n";
+        close($fh);
+    }
+    return;
+}
+
+sub fixture_text {
+    my ($file, $default) = @_;
+    my $path = "$FIX/$file";
+    return $default unless -f $path;
+    open(my $fh, '<', $path) or return $default;
+    local $/ = undef;
+    my $text = <$fh>;
+    close($fh);
+    return defined $text ? $text : $default;
+}
+
+# Image names carry slashes and colons, which are not file names; the marker files keep
+# the image identity without them.
+sub state_name   { my ($name) = @_; $name =~ s{[/:]}{_}g; return $name }
+sub state_exists { return -e "$ST/" . state_name($_[0]) ? 1 : 0 }
+sub touch_state  {
+    my $fh;
+    open($fh, '>', "$ST/" . state_name($_[0])) and close($fh);
+    return;
+}
+sub drop_state   { unlink("$ST/" . state_name($_[0])); return }
+
+log_call();
+
+if ($name eq 'lspci') {
+    print fixture_text('gpu.txt', '');
+    exit 0;
+}
+
+if ($name eq 'rpm') {
+    my $joined = join(' ', @args);
+    if ($joined =~ /%\{VERSION\}/ && $joined =~ /rocm-runtime/) {
+        my $version = fixture_text('rocm.txt', '');
+        $version =~ s/\s+$//;
+        exit 1 unless length $version;
+        print "$version\n";
+        exit 0;
+    }
+    my $pkg = $args[-1];
+    my $installed = fixture_text('rpm-installed', '');
+    if ($installed =~ /^\Q$pkg\E$/m) {
+        print "$pkg-1.0-1.x86_64\n";
+        exit 0;
+    }
+    print STDERR "package $pkg is not installed\n";
+    exit 1;
+}
+
+if ($name eq 'dnf') {
+    my @pkgs = grep { !/^-/ && $_ ne 'install' } @args;
+    my $installed = fixture_text('rpm-installed', '');
+    for my $pkg (@pkgs) {
+        $installed .= "$pkg\n" unless $installed =~ /^\Q$pkg\E$/m;
+    }
+    if (open(my $fh, '>', "$FIX/rpm-installed")) {
+        print {$fh} $installed;
+        close($fh);
+    }
+    print "Installing: @pkgs\n";
+    exit 0;
+}
+
+if ($name eq 'podman') {
+    my $sub = $args[0] // '';
+    if ($sub eq '--version') { print "podman version 5.8.4\n"; exit 0 }
+    if ($sub eq 'pull') {
+        my $image = $args[-1];
+        touch_state("image.$image");
+        print "Pulled $image\n";
+        exit 0;
+    }
+    if ($sub eq 'image' && ($args[1] // '') eq 'exists') {
+        exit(state_exists("image.$args[2]") ? 0 : 1);
+    }
+    if ($sub eq 'container' && ($args[1] // '') eq 'exists') {
+        exit(state_exists("container.$args[2]") ? 0 : 1);
+    }
+    if ($sub eq 'rm') {
+        my $target = $args[-1];
+        drop_state("container.$target");
+        print "$target\n";
+        exit 0;
+    }
+    exit 0;
+}
+
+if ($name eq 'systemctl') {
+    my @rest = grep { $_ !~ /^--/ } @args;
+    my $verb = shift @rest // '';
+    my $svc = $rest[0] // '';
+    $svc =~ s/\.service$//;
+    if ($verb eq 'is-active')  { exit(state_exists("active.$svc") ? 0 : 1) }
+    if ($verb eq 'is-enabled') { exit(state_exists("enabled.$svc") ? 0 : 1) }
+    if ($verb eq 'start')      { touch_state("active.$svc");  exit 0 }
+    if ($verb eq 'stop')       { drop_state("active.$svc");   exit 0 }
+    if ($verb eq 'enable')     { touch_state("enabled.$svc"); touch_state("active.$svc") if grep { $_ eq q{--now} } @args; exit 0 }
+    if ($verb eq 'disable')    { drop_state("enabled.$svc");  exit 0 }
+    if ($verb eq 'try-restart') { exit(state_exists("active.$svc") ? 0 : 1) }
+    if ($verb eq 'reload' || $verb eq 'daemon-reload') { exit 0 }
+    exit 0;
+}
+
+if ($name eq 'curl') {
+    my ($url) = grep { /^https?:\/\// } @args;
+    my $joined = join(' ', @args);
+    $url //= '';
+    if ($url =~ m{modelscope\.cn/api/v1/models/}) {
+        my $code = fixture_text('ms.code', '200');
+        $code =~ s/\s+$//;
+        my $body = $joined =~ /__HTTP__/ ? fixture_text('ms.json', '{"Data":{"Name":"GLM-5.3"}}') : '';
+        print $body;
+        print "\n__HTTP__$code\n" if $joined =~ /__HTTP__/;
+        exit 0;
+    }
+    if ($url =~ m{api\.github\.com}) {
+        print fixture_text('releases.json', qq({"tag_name":"v0.5.19"}\n));
+        exit 0;
+    }
+    if ($url =~ m{hub\.docker\.com}) {
+        if (-f "$FIX/image-missing") {
+            print STDERR "curl: (22) The requested URL returned error: 404\n";
+            exit 22;
+        }
+        if ($url =~ /tags\?/) {
+            # A tag listing, newest first: the rig's AMD development build.
+            print qq({"results":[{"name":"v0.5.19-rocm724-gfx1151-20260916"}]}\n);
+            exit 0;
+        }
+        print qq({"name":"ok"}\n);
+        exit 0;
+    }
+    exit 0;
+}
+
+if ($name eq 'openssl') {
+    my %want;
+    for my $i (0 .. $#args) {
+        if ($args[$i] eq '-keyout') { $want{key} = $args[$i + 1] }
+        if ($args[$i] eq '-out')    { $want{crt} = $args[$i + 1] }
+        if ($args[$i] eq '-subj')   { $want{subj} = $args[$i + 1] }
+        if ($args[$i] eq '-addext') { $want{san} = $args[$i + 1] }
+    }
+    for my $kind (qw(key crt)) {
+        my $path = $want{$kind};
+        next unless defined $path;
+        if (open(my $fh, '>', $path)) {
+            print {$fh} "stub $kind $want{subj} $want{san}\n";
+            close($fh);
+        }
+        else {
+            print STDERR "can't open $path\n";
+            exit 1;
+        }
+    }
+    exit 0;
+}
+
+if ($name eq 'nginx') {
+    print "nginx: configuration file /etc/nginx/nginx.conf test is successful\n";
+    exit 0;
+}
+
+if ($name eq 'firewall-cmd') {
+    my $joined = join(' ', @args);
+    if ($joined =~ /--list-services/) {
+        print fixture_text('fw-services', "\n");
+        exit 0;
+    }
+    if ($joined =~ /--add-service=https/) {
+        my $fh;
+        open($fh, q{>>}, "$FIX/fw-services") and print {$fh} "https\n" and close($fh);
+        exit 0;
+    }
+    exit 0;
+}
+
+if ($name eq 'getenforce') {
+    my $mode = $ENV{STUB_SELINUX} // 'Enforcing';
+    print "$mode\n";
+    exit 0;
+}
+
+if ($name eq 'getsebool') {
+    my $value = state_exists('sebool') ? 'on' : 'off';
+    print "httpd_can_network_connect --> $value\n";
+    exit 0;
+}
+
+if ($name eq 'setsebool') {
+    touch_state('sebool');
+    exit 0;
+}
+
+exit 0;
diff --git a/tests/network-diag.pl b/tests/network-diag.pl
new file mode 100644
index 0000000..f09eb90
--- /dev/null
+++ b/tests/network-diag.pl
@@ -0,0 +1,316 @@
+#!/usr/bin/env perl
+# Copyright (c) 2026 Petr Balvín <opensource@petrbalvin.org> (https://petrbalvin.org)
+# SPDX-License-Identifier: MIT
+
+# Checks for network-diag.pl: the address arithmetic, the address classification, the
+# ping parsing, the MTU family fallback and the small helpers.
+#
+# Run from anywhere: perl tests/network-diag.pl
+
+use strict;
+use warnings;
+
+my $root = $0 =~ m{^(.*)/[^/]+$} ? "$1/.." : '..';
+$root = "./$root" if $root !~ m{^/};
+require "$root/network-diag.pl";
+
+my ($passed, $failed) = (0, 0);
+
+sub is {
+    my ($got, $want, $label) = @_;
+    $got = 'undef' unless defined $got;
+    $want = 'undef' unless defined $want;
+    if ($got eq $want) {
+        $passed++;
+        print "ok   $label\n";
+        return 1;
+    }
+    $failed++;
+    print "FAIL $label\n     got:  $got\n     want: $want\n";
+    return 0;
+}
+
+sub check {
+    my ($cond, $label) = @_;
+    return is($cond ? 1 : 0, 1, $label);
+}
+
+sub hex_of {
+    my ($bytes) = @_;
+    return join(' ', map { sprintf('%02x', $_) } unpack('C*', $bytes));
+}
+
+# ---------------------------------------------------------------------------
+# IPv4 and IPv6 parsing
+# ---------------------------------------------------------------------------
+
+is(hex_of(ip4_bytes('127.0.0.1')), '7f 00 00 01', 'ip4: 127.0.0.1');
+is(hex_of(ip4_bytes('0.0.0.0')), '00 00 00 00', 'ip4: the unspecified address');
+is(hex_of(ip4_bytes('255.255.255.255')), 'ff ff ff ff', 'ip4: the broadcast address');
+is(ip4_bytes('256.0.0.1'), undef, 'ip4: an octet above 255 is refused');
+is(ip4_bytes('1.2.3'), undef, 'ip4: three octets are refused');
+is(ip4_bytes('1.2.3.4.5'), undef, 'ip4: five octets are refused');
+is(ip4_bytes('::1'), undef, 'ip4: an IPv6 address is refused');
+
+is(hex_of(ip6_bytes('::')), '00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00',
+    'ip6: the unspecified address');
+is(hex_of(ip6_bytes('::1')), '00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 01',
+    'ip6: loopback in shorthand');
+is(hex_of(ip6_bytes('2001:db8::1')), '20 01 0d b8 00 00 00 00 00 00 00 00 00 00 00 01',
+    'ip6: shorthand in the middle');
+is(hex_of(ip6_bytes('::ffff:127.0.0.1')), '00 00 00 00 00 00 00 00 00 00 ff ff 7f 00 00 01',
+    'ip6: an embedded IPv4 address');
+is(hex_of(ip6_bytes('fe80::1%eth0')), 'fe 80 00 00 00 00 00 00 00 00 00 00 00 00 00 01',
+    'ip6: a scope suffix is dropped');
+is(hex_of(ip6_bytes('2001:0db8:0000:0000:0000:0000:0000:0001')),
+    '20 01 0d b8 00 00 00 00 00 00 00 00 00 00 00 01', 'ip6: the full form');
+is(ip6_bytes('127.0.0.1'), undef, 'ip6: an IPv4 address is refused');
+is(ip6_bytes('2001:db8:::1'), undef, 'ip6: a malformed address is refused');
+is(ip6_bytes('2001:db8::1::2'), undef, 'ip6: two shorthands are refused');
+
+is(is_mapped6('::ffff:10.0.0.1'), 1, 'mapped: an IPv4-mapped address');
+is(is_mapped6('::1'), 0, 'mapped: loopback is not mapped');
+is(is_mapped6('2001:db8::1'), 0, 'mapped: a global address is not mapped');
+
+# ---------------------------------------------------------------------------
+# sockaddr packing
+# ---------------------------------------------------------------------------
+
+my $sa = sa_in('127.0.0.1', 80);
+is(length($sa), 16, 'sa_in: a sockaddr_in is 16 bytes');
+is(unpack('S', substr($sa, 0, 2)), 2, 'sa_in: the family is AF_INET');
+is(unpack('n', substr($sa, 2, 2)), 80, 'sa_in: the port is network order');
+is(hex_of(substr($sa, 4, 4)), '7f 00 00 01', 'sa_in: the address follows');
+is(hex_of(substr($sa, 8)), '00 00 00 00 00 00 00 00', 'sa_in: the padding is zero');
+is(sa_in('::1', 80), undef, 'sa_in: an IPv6 address is refused');
+
+my $sa6 = sa_in6('::1', 443);
+is(length($sa6), 28, 'sa_in6: a sockaddr_in6 is 28 bytes');
+is(unpack('n', substr($sa6, 2, 2)), 443, 'sa_in6: the port is network order');
+is(hex_of(substr($sa6, 8, 16)), '00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 01',
+    'sa_in6: the address follows the flow information');
+is(sa_in6('127.0.0.1', 443), undef, 'sa_in6: an IPv4 address is refused');
+
+# ---------------------------------------------------------------------------
+# Address classification
+# ---------------------------------------------------------------------------
+
+is(class4(ip4_bytes('127.0.0.1')), 'loopback', 'class4: loopback');
+is(class4(ip4_bytes('169.254.1.1')), 'linklocal', 'class4: link-local');
+is(class4(ip4_bytes('0.0.0.0')), 'unspecified', 'class4: unspecified');
+is(class4(ip4_bytes('224.0.0.1')), 'multicast', 'class4: multicast');
+is(class4(ip4_bytes('10.0.0.1')), 'private', 'class4: the ten network');
+is(class4(ip4_bytes('192.168.1.1')), 'private', 'class4: the 192.168 network');
+is(class4(ip4_bytes('172.16.0.1')), 'private', 'class4: the 172.16 network');
+is(class4(ip4_bytes('100.64.0.1')), 'private', 'class4: carrier-grade NAT');
+is(class4(ip4_bytes('8.8.8.8')), 'global', 'class4: a global address');
+
+is(class6(ip6_bytes('::')), 'unspecified', 'class6: unspecified');
+is(class6(ip6_bytes('::1')), 'loopback', 'class6: loopback');
+is(class6(ip6_bytes('::ffff:1.2.3.4')), 'mapped', 'class6: IPv4-mapped');
+is(class6(ip6_bytes('fe80::1')), 'linklocal', 'class6: link-local');
+is(class6(ip6_bytes('ff02::1')), 'multicast', 'class6: multicast');
+is(class6(ip6_bytes('fd00::1')), 'private', 'class6: unique local');
+is(class6(ip6_bytes('2002::1')), 'private', 'class6: 6to4');
+is(class6(ip6_bytes('2001:db8::1')), 'global', 'class6: a documentation prefix');
+
+is(address_kind('v4', '127.0.0.1'), 'loopback', 'address_kind: an IPv4 class');
+is(address_kind('v6', '::1'), 'loopback', 'address_kind: an IPv6 class');
+is(address_kind('v4', 'not-an-address'), '', 'address_kind: unparsable input is empty');
+
+# ---------------------------------------------------------------------------
+# Ping output
+# ---------------------------------------------------------------------------
+
+my $iputils = <<'PING';
+PING cloudflare.com (104.16.132.229) 56(84) bytes of data.
+64 bytes from 104.16.132.229: icmp_seq=1 ttl=57 time=11.2 ms
+64 bytes from 104.16.132.229: icmp_seq=2 ttl=57 time=12.4 ms
+64 bytes from 104.16.132.229: icmp_seq=3 ttl=57 time=10.1 ms
+
+--- cloudflare.com ping statistics ---
+3 packets transmitted, 3 received, 0% packet loss, time 2003ms
+rtt min/avg/max/mdev = 10.109/11.233/12.401/0.938 ms
+PING
+
+my ($latencies, $received) = parse_ping_output($iputils);
+is(scalar(@$latencies), 3, 'ping: three replies are parsed');
+is($latencies->[0], '11.2', 'ping: the first latency');
+is($latencies->[2], '10.1', 'ping: the last latency');
+is($received, 3, 'ping: the received counter');
+
+my $lossy = <<'PING';
+2 packets transmitted, 1 received, 50% packet loss, time 1001ms
+PING
+my ($none, $one) = parse_ping_output($lossy);
+is(scalar(@$none), 0, 'ping: a transcript without replies has no latencies');
+is($one, 1, 'ping: a partial loss is counted');
+
+my ($min, $max, $sum) = min_max_sum([3, 1, 2]);
+is($min, 1, 'latency: the minimum');
+is($max, 3, 'latency: the maximum');
+is($sum, 6, 'latency: the sum');
+
+# ---------------------------------------------------------------------------
+# Listening sockets
+# ---------------------------------------------------------------------------
+
+my @ss_ports = parse_ss_output(
+    "State  Recv-Q  Send-Q  Local Address:Port  Peer Address:Port  Process\n" .
+    "LISTEN  0       128     0.0.0.0:22          0.0.0.0:*          users:((\"sshd daemon\",pid=977,fd=3))\n" .
+    "LISTEN  0       128     [::]:22             [::]:*\n"
+);
+is($ss_ports[0]{process}, 'users:(("sshd daemon",pid=977,fd=3))',
+    'ss: a process name with spaces is kept whole');
+is($ss_ports[0]{bucket}, 'tcp4', 'ss: a plain local address is IPv4');
+is($ss_ports[1]{process}, '', 'ss: a socket without permission has no process');
+is($ss_ports[1]{bucket}, 'tcp6', 'ss: a bracketed local address is IPv6');
+
+# ---------------------------------------------------------------------------
+# Grading
+# ---------------------------------------------------------------------------
+
+is(grade_letter(100), 'A', 'grade: a perfect score');
+is(grade_letter(90), 'A', 'grade: the A boundary');
+is(grade_letter(89.9), 'B', 'grade: just under the A boundary');
+is(grade_letter(80), 'B', 'grade: the B boundary');
+is(grade_letter(70), 'C', 'grade: the C boundary');
+is(grade_letter(60), 'D', 'grade: the D boundary');
+is(grade_letter(59.9), 'F', 'grade: just under the D boundary');
+is(grade_letter(0), 'F', 'grade: zero');
+
+my $graded = compute_grade({});
+is(ref($graded), 'HASH', 'grade: the verdict is a hash');
+is($graded->{score}, 0, 'grade: no data scores zero');
+is($graded->{grade}, 'F', 'grade: no data fails');
+check($graded->{max_score} > 0, 'grade: the maximum is reported');
+check(ref($graded->{breakdown}) eq 'HASH', 'grade: the breakdown is a hash');
+my $full = compute_grade({
+    ping => { loss_pct => 0, avg_ms => 10 },
+    dns  => { v4 => { 'example.org' => [{ ms => 5 }] } },
+});
+check($full->{score} >= 0 && $full->{score} <= $full->{max_score},
+    'grade: a measured run stays within the maximum');
+
+is(ms_colour(undef), "\033[2m", 'colour: an unmeasured latency is dim');
+is(ms_colour(0), "\033[2m", 'colour: a zero latency is dim');
+check(ms_colour(5) ne ms_colour(5000), 'colour: the bands differ');
+
+# ---------------------------------------------------------------------------
+# Serialisation and arguments
+# ---------------------------------------------------------------------------
+
+is(perl_literal(5), '5', 'literal: an integer stays bare');
+is(perl_literal(1.5), '1.5', 'literal: a float stays bare');
+is(perl_literal('abc'), "'abc'", 'literal: a word is quoted');
+is(perl_literal('42x'), "'42x'", 'literal: a number-like word is quoted');
+is(perl_literal(undef), 'undef', 'literal: undef');
+is(perl_literal("it's"), "'it\\'s'", 'literal: a quote is escaped');
+is(perl_literal([1, 2]), '[1, 2]', 'literal: an array');
+is(perl_literal({ b => 2, a => 1 }), "{ 'a' => 1, 'b' => 2 }", 'literal: a hash in key order');
+
+eval { write_literal('/nonexistent/network-diag-check', 1) };
+check(scalar($@ =~ /cannot write /), 'result write: a failed write names the operation');
+
+{
+    local $ENV{TMPDIR} = '';
+    my $scratch = eval { scratch_dir() };
+    check(defined($scratch) && index($scratch // '', '/tmp/') == 0,
+        'scratch: an empty TMPDIR falls back to /tmp');
+    remove_scratch() if defined $scratch;
+}
+
+my $report_out = '';
+open(my $report_cap, '>', \$report_out) or die "cannot capture the report: $!\n";
+{
+    local *STDOUT = $report_cap;
+    print_report({ hostname => 'testhost', os => 'linux', dns => { error => 'probe boom' } });
+}
+close($report_cap);
+check(index($report_out, 'unavailable: probe boom') >= 0,
+    'report: a failed DNS check names its error');
+
+my @saved = @ARGV;
+@ARGV = ('--target', 'example.org', '--protocol', 'v6');
+my %args = parse_args();
+is($args{target}, 'example.org', 'args: --target takes a value');
+is($args{protocol}, 'v6', 'args: --protocol takes a value');
+@ARGV = @saved;
+
+@ARGV = ();
+my %defaults = parse_args();
+is($defaults{protocol}, 'auto', 'args: the family defaults to auto');
+is($defaults{target}, 'cloudflare.com', 'args: the target has a default');
+@ARGV = @saved;
+
+# ---------------------------------------------------------------------------
+# The MTU probe, through fixture binaries on a private PATH
+# ---------------------------------------------------------------------------
+
+# A fake getent answers the resolver probe and one fixed name, and a fake ping
+# models a host whose IPv6 path is dead while IPv4 passes a 1500 B DF probe.
+# Together they exercise the family fallback of check_mtu end to end without
+# touching the network.
+sub install_fake_bin {
+    my ($dir, $name, $body) = @_;
+    open(my $fh, '>', "$dir/$name") or die "cannot write $dir/$name: $!\n";
+    print {$fh} "#!/usr/bin/env perl\n", $body;
+    close($fh);
+    chmod(0755, "$dir/$name") or die "cannot chmod $dir/$name: $!\n";
+    return;
+}
+
+my $bindir = "/tmp/network-diag-test-bin.$$";
+mkdir($bindir, 0700) or die "cannot create $bindir: $!\n";
+
+{
+    local $ENV{PATH} = "$bindir:$ENV{PATH}";
+
+    install_fake_bin($bindir, 'getent', <<'FIXTURE');
+my ($verb, $host) = @ARGV;
+if ($verb eq 'ahostsv4' && $host eq 'localhost') {
+    print "127.0.0.1        STREAM\n";
+    print "# the localhost resolver probe\n";
+    exit 0;
+}
+if ($host eq 'mtu-fallback.test') {
+    print $verb eq 'ahostsv6' ? "2001:db8::1     STREAM\n" : "192.0.2.10      STREAM\n";
+    exit 0;
+}
+exit 2;
+FIXTURE
+
+    install_fake_bin($bindir, 'ping', <<'FIXTURE');
+my ($family, $payload) = ('', 0);
+for (my $i = 0; $i < @ARGV; $i++) {
+    $family = $ARGV[$i] if $ARGV[$i] eq '-4' || $ARGV[$i] eq '-6';
+    $payload = $ARGV[$i + 1] if $ARGV[$i] eq '-s';
+}
+if ($family eq '-6' || $payload > 1472) {
+    print "1 packets transmitted, 0 received, 100% packet loss, time 0ms\n";
+    exit 1;
+}
+print "1 packets transmitted, 1 received, 0% packet loss, time 0ms\n";
+exit 0;
+FIXTURE
+
+    my $auto = check_mtu('mtu-fallback.test', 'auto', 'linux');
+    is($auto->{path_mtu}, 1500, 'mtu: a dead preferred family falls back to the other');
+    check(index($auto->{method} // '', 'IPv4 fallback') >= 0,
+        'mtu: the fallback names the family that answered');
+
+    my $v6 = check_mtu('mtu-fallback.test', 'v6', 'linux');
+    is($v6->{path_mtu}, 0, 'mtu: an explicit protocol choice does not fall back');
+    is($v6->{method}, 'ping DF probe (no probe size succeeded)',
+        'mtu: an explicit protocol choice reports the failure');
+
+    my $v4 = check_mtu('mtu-fallback.test', 'v4', 'linux');
+    is($v4->{path_mtu}, 1500, 'mtu: the preferred family answering needs no fallback');
+    is($v4->{method}, 'ping DF probe (1500B OK)', 'mtu: a direct hit carries no fallback note');
+}
+
+unlink(glob("$bindir/*"));
+rmdir($bindir) or die "cannot remove $bindir: $!\n";
+
+print "\n" . ($failed ? "$failed FAILED of " . ($passed + $failed) : "all $passed checks passed") . "\n";
+exit($failed ? 1 : 0);
diff --git a/tests/security-audit.pl b/tests/security-audit.pl
new file mode 100644
index 0000000..b9ea62f
--- /dev/null
+++ b/tests/security-audit.pl
@@ -0,0 +1,706 @@
+#!/usr/bin/env perl
+# Copyright (c) 2026 Petr Balvín <opensource@petrbalvin.org> (https://petrbalvin.org)
+# SPDX-License-Identifier: MIT
+
+# Checks for security-audit.pl: the SSH configuration readers and their
+# evaluator, the socket and firewall parsers with their coverage and exposure
+# rules, SELinux, updates, accounts, the kernel hardening verdicts, the deep
+# scan evaluator, the grade, the findings order and the JSON encoder.
+#
+# Run from anywhere: perl tests/security-audit.pl
+
+use strict;
+use warnings;
+
+my $root = $0 =~ m{^(.*)/[^/]+$} ? "$1/.." : '..';
+$root = "./$root" if $root !~ m{^/};
+require "$root/security-audit.pl";
+
+my ($passed, $failed) = (0, 0);
+
+sub is {
+    my ($got, $want, $label) = @_;
+    $got = 'undef' unless defined $got;
+    $want = 'undef' unless defined $want;
+    if ($got eq $want) {
+        $passed++;
+        print "ok   $label\n";
+        return 1;
+    }
+    $failed++;
+    print "FAIL $label\n     got:  $got\n     want: $want\n";
+    return 0;
+}
+
+sub check {
+    my ($cond, $label) = @_;
+    # A match in an argument list yields the empty list on failure, which would
+    # shift the label into the condition slot, so the condition is forced first.
+    return is($cond ? 1 : 0, 1, $label);
+}
+
+sub like {
+    my ($got, $re, $label) = @_;
+    my $matched = (defined $got && $got =~ $re) ? 1 : 0;
+    if ($matched) {
+        $passed++;
+        print "ok   $label\n";
+        return 1;
+    }
+    $failed++;
+    print "FAIL $label\n     got:  " . (defined $got ? $got : 'undef') . "\n     want: $re\n";
+    return 0;
+}
+
+# The severity a check id carries in a list of checks, and the message with it.
+sub severity_of {
+    my ($checks, $id) = @_;
+    for my $check (@$checks) {
+        return ($check->{severity}, $check->{message}) if $check->{id} eq $id;
+    }
+    return ('missing', '');
+}
+
+# ---------------------------------------------------------------------------
+# RPM version comparison
+# ---------------------------------------------------------------------------
+
+is(rpmvercmp('1.0', '1.0'), 0, 'rpmvercmp: equal');
+is(rpmvercmp('1.0', '1.0.1'), -1, 'rpmvercmp: an extra segment is newer');
+is(rpmvercmp('2.0', '1.9.9'), 1, 'rpmvercmp: the major decides');
+is(rpmvercmp('1.10', '1.9'), 1, 'rpmvercmp: numeric segments compare by value');
+is(rpmvercmp('1.007', '1.7'), 0, 'rpmvercmp: leading zeros are stripped');
+is(rpmvercmp('1.0~rc1', '1.0'), -1, 'rpmvercmp: tilde sorts before the release');
+is(rpmvercmp('1.0~rc1', '1.0~rc2'), -1, 'rpmvercmp: two pre releases');
+is(rpmvercmp('1.0.fc41', '1.0.fc41'), 0, 'rpmvercmp: identical dist tags');
+is(rpmvercmp('6.12.4-200.fc41', '6.12.4-100.fc41'), 1, 'rpmvercmp: a kernel release');
+is(rpmvercmp('1.0b', '1.0'), 1, 'rpmvercmp: an alpha suffix is newer than none');
+is(rpmvercmp('1.0', '1.0b'), -1, 'rpmvercmp: and the mirror side');
+is(rpmvercmp('2016a', '2015616'), -1, 'rpmvercmp: a numeric segment beats an alpha one');
+
+# ---------------------------------------------------------------------------
+# SSH configuration
+# ---------------------------------------------------------------------------
+
+my ($values, $ports) = parse_sshd_effective(<<'SSHD');
+port 22
+port 2222
+addressfamily any
+listenaddress 0.0.0.0:22
+permitrootlogin prohibit-password
+passwordauthentication no
+permitemptypasswords no
+pubkeyauthentication yes
+x11forwarding no
+maxauthtries 3
+SSHD
+is($values->{permitrootlogin}, 'prohibit-password', 'sshd -T: a keyword reads back');
+is($values->{passwordauthentication}, 'no', 'sshd -T: the key is lowercased');
+is(scalar @$ports, 2, 'sshd -T: both port lines are kept');
+is($ports->[1], 2222, 'sshd -T: the second port in order');
+
+my $tmp_dir = "/tmp/security-audit-test.$$";
+mkdir($tmp_dir, 0700) or die "cannot mkdir $tmp_dir: $!\n";
+open(my $main_fh, '>', "$tmp_dir/sshd_config") or die "cannot write: $!\n";
+print {$main_fh} <<'CONF';
+# a comment
+Port 22
+PasswordAuthentication yes
+
+Match User backup
+    PasswordAuthentication no
+CONF
+close($main_fh);
+open(my $drop_fh, '>', "$tmp_dir/50-audit.conf") or die "cannot write: $!\n";
+print {$drop_fh} "PasswordAuthentication no\nMaxAuthTries 2\n";
+close($drop_fh);
+
+my $conf_state = { values => {}, seen => {}, accum => {} };
+read_sshd_config("$tmp_dir/sshd_config", $conf_state, 0);
+is($conf_state->{values}{passwordauthentication}, 'yes', 'config: the first value wins');
+is($conf_state->{values}{permitrootlogin}, undef, 'config: an absent key stays absent');
+my $port_count = grep { $_ eq '22' } @{ $conf_state->{accum}{port} // [] };
+is($port_count, 1, 'config: the port accumulates');
+
+# Include expansion, with a path that is not under /etc/ssh.
+open($main_fh, '>', "$tmp_dir/sshd_config") or die "cannot write: $!\n";
+print {$main_fh} "Include $tmp_dir/*.conf\nPasswordAuthentication yes\n";
+close($main_fh);
+$conf_state = { values => {}, seen => {}, accum => {} };
+read_sshd_config("$tmp_dir/sshd_config", $conf_state, 0);
+is($conf_state->{values}{passwordauthentication}, 'no',
+    'config: an include is read before the lines after it');
+is($conf_state->{values}{maxauthtries}, '2', 'config: the drop-in carries its own key');
+# The Match block of the first fixture must not be picked up either: the first
+# value is the one a global reading of the file yields, which is what the
+# fallback promises.
+
+# A Match block alone sets nothing: everything after the Match line is
+# conditional on a pattern the fallback cannot evaluate.
+open($main_fh, '>', "$tmp_dir/sshd_config") or die "cannot write: $!\n";
+print {$main_fh} "Match User admin\n    PermitRootLogin yes\n";
+close($main_fh);
+$conf_state = { values => {}, seen => {}, accum => {} };
+read_sshd_config("$tmp_dir/sshd_config", $conf_state, 0);
+is($conf_state->{values}{permitrootlogin}, undef, 'config: a Match block alone sets nothing');
+
+sub ssh_values {
+    my %pair = @_;
+    my %values;
+    $values{$_} = $pair{$_} for keys %pair;
+    return \%values;
+}
+
+my @checks = evaluate_ssh({
+    available => 1, source => 'effective',
+    values => ssh_values(
+        permitrootlogin => 'yes', passwordauthentication => 'no',
+        permitemptypasswords => 'no', pubkeyauthentication => 'yes',
+        x11forwarding => 'no', maxauthtries => '3',
+    ),
+    ports => [22],
+});
+is((severity_of(\@checks, 'ssh.permit_root_login'))[0], 'critical',
+    'ssh: root login yes is critical');
+
+@checks = evaluate_ssh({
+    available => 1, source => 'config',
+    values => ssh_values(
+        permitrootlogin => 'prohibit-password', passwordauthentication => 'yes',
+        permitemptypasswords => 'yes',
+    ),
+    ports => [22],
+});
+is((severity_of(\@checks, 'ssh.permit_root_login'))[0], 'pass',
+    'ssh: prohibit-password passes');
+is((severity_of(\@checks, 'ssh.password_authentication'))[0], 'warn',
+    'ssh: password authentication on is a warning');
+is((severity_of(\@checks, 'ssh.permit_empty_passwords'))[0], 'critical',
+    'ssh: empty passwords permitted is critical');
+is((severity_of(\@checks, 'ssh.max_auth_tries'))[0], 'pass',
+    'ssh: an absent MaxAuthTries falls back to OpenSSH default and passes');
+is((severity_of(\@checks, 'ssh.max_auth_tries'))[1], 'MaxAuthTries 6',
+    'ssh: the OpenSSH default for MaxAuthTries is 6');
+
+# sshd accepts and lowercases the Yes and No values, so an uppercase value in
+# the configuration file is graded by its meaning and not by its case.
+@checks = evaluate_ssh({
+    available => 1, source => 'config',
+    values => ssh_values(permitrootlogin => 'YES', passwordauthentication => 'No'),
+    ports => [22],
+});
+is((severity_of(\@checks, 'ssh.permit_root_login'))[0], 'critical',
+    'ssh: an uppercase Yes is still root login yes');
+is((severity_of(\@checks, 'ssh.password_authentication'))[0], 'pass',
+    'ssh: an uppercase No still turns password auth off');
+
+@checks = evaluate_ssh({ available => 0, source => '', values => {}, ports => [] });
+is(scalar @checks, 0, 'ssh: an unavailable source yields no checks');
+
+# ---------------------------------------------------------------------------
+# Sockets
+# ---------------------------------------------------------------------------
+
+my @listeners = @{
+    parse_ss_listeners(<<'SS')
+tcp   LISTEN 0      128    0.0.0.0:22        0.0.0.0:*         users:(("sshd",pid=1180,fd=3))
+tcp   LISTEN 0      5      192.168.1.7:5432  0.0.0.0:*         users:(("postgres",pid=900,fd=5))
+tcp   LISTEN 0      128    127.0.0.1:6379    0.0.0.0:*
+tcp   LISTEN 0      128    [::1]:6379        [::]:*
+tcp   LISTEN 0      128    [::]:80           [::]:*            users:(("nginx",pid=800,fd=6))
+udp   UNCONN 0      0      0.0.0.0:5353      0.0.0.0:*
+udp   UNCONN 0      0      [fe80::a7f4:eb68:1d07:aac3]%wlp1s0:3702  [::]:*  users:(("wsdd",pid=7,fd=13))
+tcp   ESTAB  0      0      192.168.1.7:22    192.168.1.2:51000
+SS
+};
+is(scalar @listeners, 7, 'ss: only LISTEN and UNCONN lines are sockets');
+is($listeners[0]{proto}, 'tcp', 'ss: the protocol');
+is($listeners[0]{port}, 22, 'ss: the port');
+is($listeners[0]{loopback}, 0, 'ss: a wildcard v4 socket is not loopback');
+is($listeners[0]{process}, 'sshd', 'ss: the process name');
+is($listeners[1]{loopback}, 0, 'ss: a specific address is not loopback');
+is($listeners[2]{loopback}, 1, 'ss: 127.0.0.1 is loopback');
+is($listeners[3]{loopback}, 1, 'ss: [::1] is loopback');
+is($listeners[3]{address}, '::1', 'ss: the brackets go');
+is($listeners[4]{address}, '::', 'ss: a v6 wildcard');
+is($listeners[5]{proto}, 'udp', 'ss: a udp socket is kept');
+is($listeners[6]{address}, 'fe80::a7f4:eb68:1d07:aac3',
+    'ss: the scope suffix and the brackets both go');
+
+is((split_listener_address('127.0.0.53%lo:53'))[0], '127.0.0.53', 'address: a v4 scope suffix');
+is((split_listener_address('garbage'))[0], undef, 'address: no port means no socket');
+is(is_loopback_address('127.255.0.1'), 1, 'address: the whole 127/8 is loopback');
+is(is_loopback_address('0.0.0.0'), 0, 'address: the wildcard is not loopback');
+is(is_wildcard_address('*'), 1, 'address: ss writes * for a v6 wildcard');
+is(is_wildcard_address('192.168.1.7'), 0, 'address: a specific address');
+is(parse_process_field('users:(("sshd",pid=1180,fd=3))'), 'sshd', 'process: the name');
+is(parse_process_field(''), '', 'process: nothing to read');
+
+# ---------------------------------------------------------------------------
+# firewalld
+# ---------------------------------------------------------------------------
+
+my @xml_ports = parse_service_xml(<<'XML');
+<?xml version="1.0" encoding="utf-8"?>
+<service>
+  <short>SSH</short>
+  <description>Secure Shell</description>
+  <port port="22" protocol="tcp"/>
+</service>
+XML
+is(join(',', @xml_ports), '22/tcp', 'service xml: port first');
+
+@xml_ports = parse_service_xml('<service><port protocol="udp" port="5353"/><port port="6000-6009" protocol="tcp"/></service>');
+is(join(',', @xml_ports), '5353/udp,6000-6009/tcp', 'service xml: attribute order varies and ranges pass');
+
+@xml_ports = parse_service_xml('<service><description>no ports</description></service>');
+is(scalar @xml_ports, 0, 'service xml: a service without ports');
+
+is(join('|', parse_active_zones("FedoraWorkstation (default)\n  interfaces: wlp1s0\n")),
+    'FedoraWorkstation', 'zones: the decoration is not part of the name');
+is(join('|', parse_active_zones("public\n  interfaces: eth0\nwork\n  interfaces: eth1\n")),
+    'public|work', 'zones: two zones, the second undecorated');
+
+my $info = parse_info_zone(<<'ZONE');
+FedoraWorkstation (default, active)
+  target: default
+  ingress-priority: 0
+  interfaces: wlp1s0
+  sources:
+  services: dhcpv6-client samba-client ssh
+  ports: 1025-65535/udp 1025-65535/tcp
+  rich rules:
+ZONE
+is($info->{name}, 'FedoraWorkstation (default, active)', 'info zone: the name line');
+is($info->{target}, 'default', 'info zone: the target');
+is(join('|', @{ $info->{services} }), 'dhcpv6-client|samba-client|ssh', 'info zone: the services');
+is(join('|', @{ $info->{ports} }), '1025-65535/udp|1025-65535/tcp', 'info zone: the ports');
+
+my $allowed = build_allowed([
+    {
+        ports         => ['8080/tcp', '53/udp'],
+        services      => ['ssh'],
+        service_ports => ['22/tcp'],
+        target        => 'default',
+    },
+]);
+check(port_allowed($allowed, 'tcp', 22), 'coverage: a service port is allowed');
+check(port_allowed($allowed, 'tcp', 8080), 'coverage: a listed port is allowed');
+check(port_allowed($allowed, 'udp', 53), 'coverage: the protocol matters');
+check(!port_allowed($allowed, 'tcp', 8081), 'coverage: the next port is not');
+check(!port_allowed($allowed, 'tcp', 53), 'coverage: udp 53 is not tcp 53');
+
+# --state answers on stdout only for a live daemon: a stopped firewalld is
+# installed but inactive, not absent.
+is(join(',', classify_firewalld(1, "running\n")), '1,1',
+    'firewalld: a running daemon');
+is(join(',', classify_firewalld(1, '')), '1,0',
+    'firewalld: installed but stopped is available and inactive');
+is(join(',', classify_firewalld(0, '')), '0,0',
+    'firewalld: no binary is unavailable');
+
+$allowed = build_allowed([ { ports => ['6000-6009/tcp'], services => [], service_ports => [] } ]);
+check(port_allowed($allowed, 'tcp', 6000), 'coverage: the start of a range');
+check(port_allowed($allowed, 'tcp', 6009), 'coverage: the end of a range');
+check(!port_allowed($allowed, 'tcp', 6010), 'coverage: past the end');
+
+# The exposure model: behind a filtering zone only allowed ports are exposed;
+# an ACCEPT target exposes everything; without a firewall the socket is exposed
+# unless it sits on loopback.
+sub firewall_fixture {
+    my (%override) = @_;
+    my %fw = (
+        available => 1, active => 1, default_zone => 'public',
+        zones => [ {
+            name => 'public', target => 'default',
+            ports => ['8080/tcp'], services => ['ssh'], service_ports => ['22/tcp'],
+        } ],
+        listeners => [
+            { proto => 'tcp', address => '0.0.0.0', port => 22,    loopback => 0, process => 'sshd' },
+            { proto => 'tcp', address => '0.0.0.0', port => 9999,  loopback => 0, process => '' },
+            { proto => 'tcp', address => '127.0.0.1', port => 6379, loopback => 1, process => 'redis' },
+        ],
+    );
+    $fw{$_} = $override{$_} for keys %override;
+    return \%fw;
+}
+
+my @fw_checks = evaluate_firewall(firewall_fixture());
+my $listeners_check = (grep { $_->{id} eq 'firewall.listeners' } @fw_checks)[0];
+like($listeners_check->{message}, qr/1 exposed/, 'firewall: one socket exposed behind a filtering zone');
+is($listeners_check->{detail}[0], 'tcp 0.0.0.0:22 exposed (sshd)', 'firewall: the exposed socket is the allowed one');
+is($listeners_check->{detail}[2], 'tcp 127.0.0.1:6379 local (redis)',
+    'firewall: a loopback listener is local, not filtered');
+is((severity_of(\@fw_checks, 'firewall.active'))[0], 'pass', 'firewall: running firewalld passes');
+is((severity_of(\@fw_checks, 'firewall.zone_target'))[0], 'pass', 'firewall: a filtering target passes');
+is((severity_of(\@fw_checks, 'firewall.allowed_no_listener'))[0], 'warn',
+    'firewall: 8080 allowed with nothing listening is stale');
+
+@fw_checks = evaluate_firewall(firewall_fixture(
+    zones => [ { name => 'home', target => 'accept', ports => [], services => ['ssh'], service_ports => ['22/tcp'] } ],
+));
+is((severity_of(\@fw_checks, 'firewall.zone_target'))[0], 'warn',
+    'firewall: an ACCEPT target zone is a warning');
+like((severity_of(\@fw_checks, 'firewall.listeners'))[0], qr/info/,
+    'firewall: an ACCEPT target exposes the unallowed socket without failing');
+is((grep { $_->{id} eq 'firewall.listeners' } @fw_checks)[0]{message} =~ /2 exposed/ ? 'two' : 'other',
+    'two', 'firewall: two sockets exposed under ACCEPT');
+
+@fw_checks = evaluate_firewall(firewall_fixture(
+    available => 0, active => 0, zones => [],
+));
+is((severity_of(\@fw_checks, 'firewall.active'))[0], 'critical',
+    'firewall: no firewall and exposed sockets is critical');
+
+@fw_checks = evaluate_firewall(firewall_fixture(
+    available => 0, active => 0, zones => [],
+    listeners => [ { proto => 'tcp', address => '127.0.0.1', port => 6379, loopback => 1, process => '' } ],
+));
+is((severity_of(\@fw_checks, 'firewall.active'))[0], 'warn',
+    'firewall: no firewall with loopback-only sockets is a warning');
+
+@fw_checks = evaluate_firewall(firewall_fixture(
+    available => 1, active => 0, zones => [],
+    listeners => undef,
+));
+is((severity_of(\@fw_checks, 'firewall.active'))[0], 'unknown',
+    'firewall: an inactive firewall and no inventory is unknown');
+is((severity_of(\@fw_checks, 'firewall.listeners'))[0], 'unknown',
+    'firewall: no ss means no inventory');
+
+@fw_checks = evaluate_firewall(firewall_fixture(zones => []));
+is((severity_of(\@fw_checks, 'firewall.zone_target'))[0], 'unknown',
+    'firewall: firewalld running without an active zone says so');
+
+# ---------------------------------------------------------------------------
+# SELinux
+# ---------------------------------------------------------------------------
+
+is(parse_selinux_config("# comment\nSELINUX=enforcing\n"), 'enforcing', 'selinux config: the value');
+is(parse_selinux_config("SELINUXTYPE=targeted\nSELINUX = permissive\n"), 'permissive',
+    'selinux config: spaces around the assignment');
+is(parse_selinux_config("SELINUXTYPE=targeted\n"), '', 'selinux config: no SELINUX key');
+
+@checks = evaluate_selinux({ available => 1, runtime => 'Enforcing', configured => 'enforcing' });
+is((severity_of(\@checks, 'selinux.runtime'))[0], 'pass', 'selinux: enforcing passes');
+is((severity_of(\@checks, 'selinux.config'))[0], 'pass', 'selinux: matching config passes');
+@checks = evaluate_selinux({ available => 1, runtime => 'Permissive', configured => 'enforcing' });
+is((severity_of(\@checks, 'selinux.runtime'))[0], 'warn', 'selinux: permissive is a warning');
+is((severity_of(\@checks, 'selinux.config'))[0], 'info', 'selinux: a future enforcement is noted');
+@checks = evaluate_selinux({ available => 1, runtime => 'Enforcing', configured => 'disabled' });
+is((severity_of(\@checks, 'selinux.config'))[0], 'warn',
+    'selinux: an enforcing runtime with a disabled config downgrades at boot');
+@checks = evaluate_selinux({ available => 1, runtime => 'Disabled', configured => 'enforcing' });
+is((severity_of(\@checks, 'selinux.config'))[0], 'warn',
+    'selinux: a disabled runtime with an enforcing config is a contradiction, not a promise');
+@checks = evaluate_selinux({ available => 1, runtime => 'Enforcing', configured => '' });
+is((severity_of(\@checks, 'selinux.config'))[0], 'unknown',
+    'selinux: no configuration file is unknown');
+@checks = evaluate_selinux({ available => 0, runtime => '', configured => '' });
+is(scalar @checks, 0, 'selinux: no tooling, no checks');
+
+# ---------------------------------------------------------------------------
+# Updates
+# ---------------------------------------------------------------------------
+
+is(count_security_updates(<<'DNF4'), 2, 'updateinfo: two dnf 4 advisory lines');
+FEDORA-2026-aaaaaa security kernel-6.12.4-200.fc41.noarch
+FEDORA-2026-bbbbbb security/important openssl-3.2.0-1.fc41.x86_64
+DNF4
+is(count_security_updates("FEDORA-2026-cccccc bugfix bash-5.2.0-1.fc41.x86_64\n"), 0,
+    'updateinfo: a bugfix line is not security');
+is(count_security_updates("Last metadata expiration check: 2:04:11 ago on Fri.\n"), 0,
+    'updateinfo: a progress line is not an advisory');
+
+is(parse_automatic_conf("[commands]\napply_updates = yes\n"), 'yes', 'automatic.conf: yes');
+is(parse_automatic_conf("[commands]\n# apply_updates = yes\napply_updates = no\n"), 'no',
+    'automatic.conf: the last assignment, comments skipped');
+is(parse_automatic_conf("[commands]\nupgrade_type = security\n"), '', 'automatic.conf: the key is absent');
+
+# On a dnf5 host dnf-automatic.timer is an alias whose target carries the
+# enablement, and "alias" itself names no state.
+is(join('|', pick_timer_unit({
+    'dnf5-automatic.timer'         => 'enabled',
+    'dnf-automatic-install.timer'  => 'not-found',
+    'dnf-automatic.timer'          => 'alias',
+})), 'dnf5-automatic.timer|enabled',
+    'timers: an alias defers to the dnf5 unit name');
+is(join('|', pick_timer_unit({
+    'dnf5-automatic.timer'         => 'not-found',
+    'dnf-automatic-install.timer'  => 'disabled',
+    'dnf-automatic.timer'          => 'disabled',
+})), 'dnf-automatic-install.timer|disabled',
+    'timers: the dnf4 install timer is still found');
+is(join('|', pick_timer_unit({
+    'dnf5-automatic.timer'         => 'not-found',
+    'dnf-automatic-install.timer'  => 'not-found',
+    'dnf-automatic.timer'          => 'alias',
+})), '|', 'timers: alias and not-found are no answer');
+
+# An absent apply_updates is the documented default: no, download only.
+@checks = evaluate_updates({
+    security_pending => 0, timer => 'enabled', timer_name => 'dnf5-automatic.timer',
+    apply_updates => 'no', apply_updates_defaulted => 1,
+    running_kernel => '6.12.4-200.fc44.x86_64', newest_kernel => '', reboot_required => 0,
+});
+is((severity_of(\@checks, 'updates.apply_updates'))[0], 'warn',
+    'updates: the default downloads without installing');
+like((severity_of(\@checks, 'updates.apply_updates'))[1], qr/no \(the default\)/,
+    'updates: a defaulted value says so');
+@checks = evaluate_updates({
+    timer => 'unknown', timer_name => '', apply_updates => undef,
+    security_pending => undef, pending_error => '', running_kernel => '',
+    newest_kernel => '', reboot_required => undef,
+});
+is((severity_of(\@checks, 'updates.apply_updates'))[0], 'unknown',
+    'updates: no readable configuration is unknown');
+
+# ---------------------------------------------------------------------------
+# Accounts
+# ---------------------------------------------------------------------------
+
+my $users = parse_passwd([
+    'root:x:0:0:root:/root:/bin/bash',
+    'petrbalvin:x:1000:1000:Petr:/home/petrbalvin:/bin/zsh',
+    'daemon:x:2:2:daemon:/sbin:/sbin/nologin',
+    'brokenline',
+]);
+is(scalar @$users, 3, 'passwd: a malformed line is skipped');
+is($users->[0]{uid}, 0, 'passwd: the uid');
+
+is(join(',', @{ empty_password_users(['root:', 'daemon:*', 'svc:!!']) }), 'root',
+    'shadow: an empty hash, a locked one and a bang one');
+# A real shadow line carries the ageing fields behind the hash, so the hash is
+# the second field and not everything after the name.
+is(join(',', @{ empty_password_users([
+    'svc::19997:0:99999:7:::',
+    'daemon:*:19997:0:99999:7:::',
+    'alice:$6$rounds=656000$ salted:19997:0:99999:7:::',
+    'root:',
+]) }), 'svc,root', 'shadow: the empty hash is the second field, ageing fields aside');
+
+my @principals = parse_sudoers_text(<<'SUDO');
+Defaults env_reset
+%wheel	ALL=(ALL)	ALL
+petrbalvin ALL=(ALL) NOPASSWD: ALL
+# %commented ALL=(ALL) NOPASSWD: ALL
+SUDO
+is(join('|', @principals), 'petrbalvin', 'sudoers: the NOPASSWD principal, comments skipped');
+
+@checks = evaluate_accounts({
+    uid_zero => ['root'], empty_passwords => undef, nopasswd => undef,
+    human_users => ['petrbalvin (1000)'], root_authorized_keys => undef,
+});
+is((severity_of(\@checks, 'accounts.uid_zero'))[0], 'pass', 'accounts: only root at uid 0');
+is((severity_of(\@checks, 'accounts.empty_passwords'))[0], 'unknown',
+    'accounts: shadow unreadable is unknown, not a pass');
+@checks = evaluate_accounts({
+    uid_zero => ['root', 'toor'], empty_passwords => ['svc'], nopasswd => ['%wheel'],
+    human_users => [], root_authorized_keys => 2,
+});
+is((severity_of(\@checks, 'accounts.uid_zero'))[0], 'critical', 'accounts: a second uid 0 is critical');
+is((severity_of(\@checks, 'accounts.empty_passwords'))[0], 'critical', 'accounts: an empty password is critical');
+is((severity_of(\@checks, 'accounts.nopasswd_sudo'))[0], 'warn', 'accounts: NOPASSWD is a warning');
+
+# ---------------------------------------------------------------------------
+# Services and the kernel sysctls
+# ---------------------------------------------------------------------------
+
+is((severity_of([evaluate_services([])], 'services.failed_units'))[0], 'pass', 'services: none failed');
+is((severity_of([evaluate_services([{ unit => 'sshd.service', state => 'failed' }])],
+    'services.failed_units'))[0], 'warn', 'services: a failed unit is a warning');
+is((severity_of([evaluate_services(undef)], 'services.failed_units'))[0], 'unknown',
+    'services: no systemctl is unknown');
+
+# The columns of `systemctl --failed --no-legend --plain` are unit, load,
+# active, sub, description: the report names the active state.
+my $failed_units = parse_failed_units(
+    "sshd.service        loaded failed failed OpenSSH server daemon\n" .
+    "dnf5-automatic.service not-found failed failed (bad unit)\n");
+is(scalar @$failed_units, 2, 'services: two failed lines parse');
+is($failed_units->[0]{state}, 'failed', 'services: the state is the active column, not the load');
+is($failed_units->[1]{unit}, 'dnf5-automatic.service', 'services: a not-found load state still parses');
+
+my %sysctl_ok = (
+    '/proc/sys/kernel/kptr_restrict' => '1',
+    '/proc/sys/kernel/dmesg_restrict' => '1',
+    '/proc/sys/kernel/unprivileged_bpf_disabled' => '2',
+    '/proc/sys/kernel/yama/ptrace_scope' => '1',
+    '/proc/sys/fs/protected_symlinks' => '1',
+    '/proc/sys/fs/protected_hardlinks' => '1',
+    '/proc/sys/fs/protected_fifos' => '1',
+    '/proc/sys/fs/protected_regular' => '2',
+    '/proc/sys/net/ipv4/tcp_syncookies' => '1',
+    '/proc/sys/kernel/randomize_va_space' => '2',
+);
+@checks = evaluate_kernel({ %sysctl_ok });
+my $pass_count = grep { $_->{severity} eq 'pass' } @checks;
+is($pass_count, 7, 'kernel: a hardened machine passes every check');
+
+my %sysctl_weak = (%sysctl_ok,
+    '/proc/sys/kernel/kptr_restrict' => '0',
+    '/proc/sys/kernel/randomize_va_space' => '1',
+);
+delete $sysctl_weak{'/proc/sys/kernel/yama/ptrace_scope'};
+@checks = evaluate_kernel({ %sysctl_weak });
+is((severity_of(\@checks, 'kernel.kptr_restrict'))[0], 'warn', 'kernel: a visible kptr is a warning');
+is((severity_of(\@checks, 'kernel.randomize_va_space'))[0], 'warn', 'kernel: reduced ASLR is a warning');
+is((severity_of(\@checks, 'kernel.yama_ptrace_scope'))[0], 'unknown', 'kernel: an absent sysctl is unknown');
+
+# ---------------------------------------------------------------------------
+# The deep scan evaluator
+# ---------------------------------------------------------------------------
+
+@checks = evaluate_files({
+    suid => ['/usr/bin/sudo', '/tmp/backdoor'],
+    world_writable_files => ['/var/tmp/junk'],
+    world_writable_dirs => [],
+    unowned => [],
+});
+is((severity_of(\@checks, 'files.suid_staging'))[0], 'critical',
+    'files: a SUID binary under /tmp is critical');
+like((severity_of(\@checks, 'files.world_writable'))[1], qr/1 world writable file/,
+    'files: the world writable count');
+
+@checks = evaluate_files({
+    suid => ['/usr/bin/sudo'],
+    world_writable_files => [], world_writable_dirs => [], unowned => [],
+});
+is((severity_of(\@checks, 'files.suid_staging'))[0], 'pass', 'files: a clean staging check');
+is((severity_of(\@checks, 'files.unowned'))[0], 'pass', 'files: nothing unowned');
+
+@checks = evaluate_files({
+    suid => [], world_writable_files => [], world_writable_dirs => ['/tmp'], unowned => ['x'],
+});
+is((severity_of(\@checks, 'files.world_writable'))[0], 'warn',
+    'files: a stickyless world writable directory is a warning');
+is((severity_of(\@checks, 'files.unowned'))[0], 'warn', 'files: an unowned file is a warning');
+
+# A scan that did not complete is unknown, never a clean pass: an interrupted
+# find leaves an undef slot behind.
+@checks = evaluate_files({
+    suid => undef, world_writable_files => [], world_writable_dirs => [], unowned => [],
+});
+is((severity_of(\@checks, 'files.suid_staging'))[0], 'unknown',
+    'files: an interrupted SUID scan is unknown');
+@checks = evaluate_files({
+    suid => [], world_writable_files => undef, world_writable_dirs => [], unowned => [],
+});
+is((severity_of(\@checks, 'files.world_writable'))[0], 'unknown',
+    'files: an interrupted world writable scan is unknown');
+@checks = evaluate_files({
+    suid => [], world_writable_files => [], world_writable_dirs => [], unowned => undef,
+});
+is((severity_of(\@checks, 'files.unowned'))[0], 'unknown',
+    'files: an interrupted unowned scan is unknown');
+
+# ---------------------------------------------------------------------------
+# Grade and findings
+# ---------------------------------------------------------------------------
+
+my $grade = compute_grade({});
+is($grade->{grade}, 'N/A', 'grade: nothing assessable is not graded');
+is($grade->{score}, undef, 'grade: no score');
+
+my %by_id;
+$by_id{"s.$_"} = {
+    id => "s.$_",
+    section => 's',
+    severity => $_ eq 'a' ? 'pass' : $_ eq 'b' ? 'warn' : $_ eq 'c' ? 'critical' : 'unknown',
+    weight => $_ eq 'd' ? 0 : 8,
+} for qw(a b c d e);
+$grade = compute_grade({ %by_id });
+# a: 8, b: 4, c: 0, d: weight 0 so not counted, e: unknown so out of the pool.
+is($grade->{maxima}{d}, undef, 'grade: a weightless check is not in the maxima');
+is($grade->{score}, 50, 'grade: 12 of the 24 remaining points');
+is($grade->{grade}, 'F', 'grade: the letter follows the thresholds');
+is($grade->{sections}{s}{possible}, 24, 'grade: the unknown check leaves the pool');
+is($grade->{skipped}{'s.e'}, 1, 'grade: the unknown check is named as skipped');
+
+%by_id = map {
+    ("sec.$_" => { id => "sec.$_", section => 'sec', severity => 'pass', weight => 10 });
+} qw(one two);
+$grade = compute_grade({ %by_id });
+is($grade->{score}, 100, 'grade: full marks');
+
+my $findings = findings_of(\%by_id);
+is(scalar @$findings, 0, 'findings: a clean set is empty');
+
+%by_id = (
+    'a.w' => { id => 'a.w', section => 'a', severity => 'warn', weight => 4, message => 'w' },
+    'a.c' => { id => 'a.c', section => 'a', severity => 'critical', weight => 4, message => 'c' },
+    'b.w' => { id => 'b.w', section => 'b', severity => 'warn', weight => 4, message => 'w2' },
+    'a.p' => { id => 'a.p', section => 'a', severity => 'pass', weight => 4, message => 'p' },
+);
+$findings = findings_of(\%by_id);
+is(join(',', map { $_->{id} } @$findings), 'a.c,a.w,b.w',
+    'findings: criticals first, then warnings by id, passes left out');
+
+# ---------------------------------------------------------------------------
+# JSON
+# ---------------------------------------------------------------------------
+
+like(json_encode({ root => 1, deep => 0 }), qr/"root": true/, 'json: a listed boolean path');
+like(json_encode({ sections => { firewall => { listeners => [ { loopback => 1, exposed => 0 } ] } } }),
+    qr/"loopback": true/, 'json: a listener boolean by shape');
+like(json_encode({ sections => { ssh => { available => 1 }, selinux => { available => 0 } } }),
+    qr/"available": true/, 'json: the section available flags are booleans');
+like(json_encode({ sections => { firewall => { listeners => [ { allowed => 1 } ] } } }),
+    qr/"allowed": true/, 'json: a listener allowed flag is a boolean');
+like(json_encode({ a => 'text', b => 3 }), qr/"b": 3/, 'json: a number stays a number');
+like(json_encode({ s => "quote\"end\ning" }), qr/"quote\\"end\\ning"/, 'json: the escapes');
+like(json_encode({}), qr/\{\}/, 'json: an empty object');
+like(json_encode([]), qr/\[\]/, 'json: an empty array');
+
+# ---------------------------------------------------------------------------
+# Arguments
+# ---------------------------------------------------------------------------
+
+my @saved = @ARGV;
+@ARGV = ('--json', '--strict', '--deep', '--section', 'ssh,firewall');
+my %args = parse_args();
+is($args{json}, 1, 'args: --json');
+is($args{strict}, 1, 'args: --strict');
+is($args{deep}, 1, 'args: --deep');
+is($args{section}, 'ssh,firewall', 'args: --section takes a list');
+@ARGV = ('--section=ssh');
+%args = parse_args();
+is($args{section}, 'ssh', 'args: --section=VALUE');
+@ARGV = ();
+%args = parse_args();
+is($args{deep}, 0, 'args: deep is off by default');
+@ARGV = @saved;
+
+# ---------------------------------------------------------------------------
+# Section selection and the exit status of the program
+# ---------------------------------------------------------------------------
+
+my ($resolved, $section_error) = resolve_sections('ssh,firewall', 0);
+is(join(',', @$resolved), 'ssh,firewall', 'sections: a plain list resolves');
+is($section_error, undef, 'sections: no error for a plain list');
+($resolved, $section_error) = resolve_sections('ssh,ssh', 0);
+is(join(',', @$resolved), 'ssh', 'sections: a repeated name runs once');
+($resolved, $section_error) = resolve_sections('ssh', 1);
+is(join(',', @$resolved), 'ssh,files', 'sections: --deep adds the file scan');
+($resolved, $section_error) = resolve_sections('', 0);
+is(scalar @$resolved, 7, 'sections: the default run is every section but files');
+($resolved, $section_error) = resolve_sections('nope', 0);
+is($resolved, undef, 'sections: an unknown name yields no list');
+like($section_error, qr/unknown section/, 'sections: an unknown name is reported');
+($resolved, $section_error) = resolve_sections('files', 0);
+like($section_error, qr/requires --deep/, 'sections: files without --deep is refused');
+
+# The validation runs before any collection, and a usage error exits 2 as the
+# usage text promises, not 1.
+my $exit_code = system($^X, "$root/security-audit.pl", '--section', 'nope') >> 8;
+is($exit_code, 2, 'cli: an unknown section is a usage error, exit 2');
+$exit_code = system($^X, "$root/security-audit.pl", '--section', 'files') >> 8;
+is($exit_code, 2, 'cli: files without --deep is a usage error, exit 2');
+
+# ---------------------------------------------------------------------------
+
+unlink("$tmp_dir/sshd_config", "$tmp_dir/50-audit.conf");
+rmdir($tmp_dir);
+
+print "\n" . ($failed ? "$failed FAILED of " . ($passed + $failed) : "all $passed checks passed") . "\n";
+exit($failed ? 1 : 0);
diff --git a/tests/server-setup.pl b/tests/server-setup.pl
new file mode 100644
index 0000000..0832026
--- /dev/null
+++ b/tests/server-setup.pl
@@ -0,0 +1,200 @@
+#!/usr/bin/env perl
+# Copyright (c) 2026 Petr Balvín <opensource@petrbalvin.org> (https://petrbalvin.org)
+# SPDX-License-Identifier: MIT
+
+# Checks for server-setup.pl: the dnf-automatic configuration renderer, the os-release
+# reader, the error text, the argument parsing, the command runner's wait-status
+# conversion and the EPEL enable path.
+#
+# Run from anywhere: perl tests/server-setup.pl
+
+use strict;
+use warnings;
+
+my $root = $0 =~ m{^(.*)/[^/]+$} ? "$1/.." : '..';
+$root = "./$root" if $root !~ m{^/};
+require "$root/server-setup.pl";
+
+my ($passed, $failed) = (0, 0);
+
+sub is {
+    my ($got, $want, $label) = @_;
+    $got = 'undef' unless defined $got;
+    $want = 'undef' unless defined $want;
+    if ($got eq $want) {
+        $passed++;
+        print "ok   $label\n";
+        return 1;
+    }
+    $failed++;
+    print "FAIL $label\n     got:  $got\n     want: $want\n";
+    return 0;
+}
+
+sub check {
+    my ($cond, $label) = @_;
+    return is($cond ? 1 : 0, 1, $label);
+}
+
+sub like {
+    my ($got, $re, $label) = @_;
+    my $matched = (defined $got && $got =~ $re) ? 1 : 0;
+    if ($matched) {
+        $passed++;
+        print "ok   $label\n";
+        return 1;
+    }
+    $failed++;
+    print "FAIL $label\n     got:  " . (defined $got ? $got : 'undef') . "\n     want: $re\n";
+    return 0;
+}
+
+# ---------------------------------------------------------------------------
+# dnf-automatic configuration
+# ---------------------------------------------------------------------------
+
+# The renderer returns the lines and whether it changed anything, which is how its
+# caller decides whether to write.
+my @order = qw(upgrade_type apply_updates);
+my ($rendered, $changed) = render_dnf_automatic_conf(
+    ["[commands]\n", "# a comment\n", "upgrade_type = security\n"],
+    \@order,
+    { upgrade_type => 'default', apply_updates => 'yes' },
+);
+my $text = join('', @$rendered);
+is($changed, 1, 'dnf-automatic: a change is reported');
+like($text, qr/^\[commands\]$/m, 'dnf-automatic: the section survives');
+like($text, qr/^upgrade_type = default$/m, 'dnf-automatic: an existing key is updated');
+like($text, qr/^apply_updates = yes$/m, 'dnf-automatic: a missing key is added');
+like($text, qr/^# a comment$/m, 'dnf-automatic: a comment survives');
+is(($text =~ /upgrade_type/g) + 0, 1, 'dnf-automatic: the key is written once');
+
+my ($again, $unchanged) = render_dnf_automatic_conf($rendered, \@order,
+    { upgrade_type => 'default', apply_updates => 'yes' });
+is($unchanged, 0, 'dnf-automatic: an already correct file is reported unchanged');
+is(join('', @$again), $text, 'dnf-automatic: an already correct file is reproduced exactly');
+
+my ($fresh, $fresh_changed) = render_dnf_automatic_conf([], \@order, { upgrade_type => 'default' });
+check(join('', @$fresh) !~ /^apply_updates = *$/m,
+    'dnf-automatic: a key with no desired value is not written empty');
+my $fresh_text = join('', @$fresh);
+is($fresh_changed, 1, 'dnf-automatic: a missing section is a change');
+like($fresh_text, qr/^\[commands\]$/m, 'dnf-automatic: a missing section is created');
+like($fresh_text, qr/^upgrade_type = default$/m, 'dnf-automatic: the key lands in it');
+
+my ($unterminated, $unterminated_changed) = render_dnf_automatic_conf(
+    ["[commands]\n", 'upgrade_type = security'],
+    \@order,
+    { apply_updates => 'yes' },
+);
+my $unterminated_text = join('', @$unterminated);
+is($unterminated_changed, 1, 'dnf-automatic: an appended key is a change');
+like($unterminated_text, qr/^apply_updates = yes$/m,
+    'dnf-automatic: an unterminated last line does not swallow the new key');
+check($unterminated_text !~ /securityapply_updates/,
+    'dnf-automatic: no key is glued onto another');
+
+# ---------------------------------------------------------------------------
+# os-release and error text
+# ---------------------------------------------------------------------------
+
+my $release = parse_os_release();
+is(ref($release), 'HASH', 'os-release: a hash reference');
+check(defined $release->{ID} && length $release->{ID}, 'os-release: the identifier is read');
+check(defined $release->{VERSION_ID}, 'os-release: the version is read');
+
+my $handle;
+open($handle, '<', '/nonexistent/for-the-test');
+my $error = os_error_text('/nonexistent/for-the-test');
+like($error, qr/^\[Errno \d+\] .+: '\/nonexistent\/for-the-test'$/,
+    'error text: the errno, the reason and the path');
+
+# ---------------------------------------------------------------------------
+# Arguments
+# ---------------------------------------------------------------------------
+
+my @saved = @ARGV;
+@ARGV = ('--dry-run', '--skip-firewall');
+my %args = parse_args();
+is($args{dry_run}, 1, 'args: --dry-run');
+is($args{skip_firewall}, 1, 'args: --skip-firewall');
+is($args{skip_packages}, 0, 'args: an unset skip stays off');
+@ARGV = ();
+my %defaults = parse_args();
+is($defaults{dry_run}, 0, 'args: dry run is off by default');
+@ARGV = @saved;
+
+# ---------------------------------------------------------------------------
+# The command runner
+# ---------------------------------------------------------------------------
+
+is(wait_status_rc(0), 0, 'runner: a clean exit is rc 0');
+is(wait_status_rc(2 << 8), 2, 'runner: the exit status is taken from bits 8-15');
+is(wait_status_rc(9), 137, 'runner: a child killed by SIGKILL is not read as rc 0');
+is(wait_status_rc(11), 139, 'runner: a child killed by a signal is never rc 0');
+
+my $killed = run(['sh', '-c', 'kill -9 $$']);
+is($killed->{rc}, 137, 'runner: run reports 128+signal for a killed child');
+my $exited = run(['sh', '-c', 'exit 3']);
+is($exited->{rc}, 3, 'runner: run reports the exit code of a child');
+
+# ---------------------------------------------------------------------------
+# EPEL: a present package with a disabled repository must be enabled, and a
+# silent no-op must not be reported as success
+# ---------------------------------------------------------------------------
+
+{
+    no warnings 'redefine';
+    my ($epel_enabled, $enable_works, @seen);
+
+    my $fake_run = sub {
+        my ($cmd) = @_;
+        my $line = join ' ', @$cmd;
+        push @seen, $line;
+        if ($line eq 'dnf repolist --enabled') {
+            my $out = "repo id\trepo name\n";
+            $out .= "epel\tExtra Packages for Enterprise Linux\n" if $epel_enabled;
+            return { rc => 0, out => $out, err => '' };
+        }
+        return { rc => 0, out => "epel-release-10-0.noarch\n", err => '' }
+            if $line eq 'rpm -q epel-release';
+        return { rc => 0, out => '', err => '' }
+            if $line eq 'dnf config-manager --set-enabled crb';
+        if ($line eq 'dnf config-manager --set-enabled epel') {
+            if ($enable_works) {
+                $epel_enabled = 1;
+                return { rc => 0, out => '', err => '' };
+            }
+            return { rc => 1, out => '', err => 'failed' };
+        }
+        # Installing an already-present package is a successful no-op that
+        # leaves the repository switched off, which made the old path a false
+        # success.
+        return { rc => 0, out => '', err => '' }
+            if $line eq 'dnf install -y epel-release';
+        return { rc => 1, out => '', err => "unexpected command: $line" };
+    };
+
+    local *run = $fake_run;
+
+    ($epel_enabled, $enable_works, @seen) = (0, 1);
+    my $ok_info = ensure_epel(0);
+    check(!$ok_info->{failed} && $epel_enabled,
+        'EPEL: a disabled repository is enabled when config-manager works');
+    check($ok_info->{installed}, 'EPEL: success is reported once the repository is enabled');
+    check((grep { /install / } @seen) == 0,
+        'EPEL: an installed package is enabled, not installed again');
+
+    ($epel_enabled, $enable_works, @seen) = (0, 0);
+    my $fail_info = ensure_epel(0);
+    check($fail_info->{failed} && !$epel_enabled,
+        'EPEL: a repository that stays disabled is a failure, not a success');
+
+    ($epel_enabled, $enable_works, @seen) = (0, 1);
+    ensure_epel(1);
+    check((grep { /set-enabled|install / } @seen) == 0,
+        'EPEL: a dry run issues no mutating command');
+}
+
+print "\n" . ($failed ? "$failed FAILED of " . ($passed + $failed) : "all $passed checks passed") . "\n";
+exit($failed ? 1 : 0);
diff --git a/tests/sglang-deploy.pl b/tests/sglang-deploy.pl
new file mode 100644
index 0000000..94eed00
--- /dev/null
+++ b/tests/sglang-deploy.pl
@@ -0,0 +1,268 @@
+#!/usr/bin/perl
+# Unit checks for sglang-deploy.pl: the pure helpers, against what they must produce.
+use strict;
+use warnings;
+
+my $root = $0 =~ m{^(.*)/[^/]+$} ? "$1/.." : '..';
+$root = "./$root" if $root !~ m{^/};
+require "$root/sglang-deploy.pl";
+
+my ($passed, $failed) = (0, 0);
+
+sub is {
+    my ($got, $want, $label) = @_;
+    $got = 'undef' unless defined $got;
+    $want = 'undef' unless defined $want;
+    if ($got eq $want) {
+        $passed++;
+        print "ok   $label\n";
+        return 1;
+    }
+    $failed++;
+    print "FAIL $label\n     got:  $got\n     want: $want\n";
+    return 0;
+}
+
+sub check {
+    my ($cond, $label) = @_;
+    return is($cond ? 1 : 0, 1, $label);
+}
+
+# The verdict of a match is forced into a boolean: in a sub argument list a failed match
+# yields the empty list, which shifts the label into the condition slot and turns the
+# failure into a silent pass.
+sub like {
+    my ($got, $re, $label) = @_;
+    $label = 'like without a label' unless defined $label;
+    my $matched = (defined $got && $got =~ $re) ? 1 : 0;
+    return is($matched, 1, $label);
+}
+
+sub check_unlike {
+    my ($got, $re, $label) = @_;
+    $label = 'check_unlike without a label' unless defined $label;
+    my $matched = (defined $got && $got !~ $re) ? 1 : 0;
+    return is($matched, 1, $label);
+}
+
+# ---- version_cmp ----------------------------------------------------------
+is(version_cmp('7.2.4', '7.2.0'), 1,  'version_cmp 7.2.4 > 7.2.0');
+is(version_cmp('7.2.0', '7.2.4'), -1, 'version_cmp 7.2.0 < 7.2.4');
+is(version_cmp('7.2', '7.2.0'), 0,    'version_cmp 7.2 == 7.2.0');
+is(version_cmp('10.0.0', '7.2.4'), 1, 'version_cmp 10.0.0 > 7.2.4');
+is(version_cmp('6.4.3', '7.0.0'), -1, 'version_cmp 6.4.3 < 7.0.0');
+is(version_cmp('7.10.0', '7.9.0'), 1, 'version_cmp 7.10.0 > 7.9.0 (numeric, not lexical)');
+
+# ---- select_rocm_flavour --------------------------------------------------
+is(select_rocm_flavour('7.2.4'), 'rocm724', 'flavour: host 7.2.4');
+is(select_rocm_flavour('7.2.5'), 'rocm724', 'flavour: host 7.2.5');
+is(select_rocm_flavour('7.2.3'), 'rocm720', 'flavour: host 7.2.3');
+is(select_rocm_flavour('7.2.0'), 'rocm720', 'flavour: host 7.2.0');
+is(select_rocm_flavour('7.1.0'), 'rocm700', 'flavour: host 7.1.0 falls back to rocm700');
+is(select_rocm_flavour('7.0.0'), 'rocm700', 'flavour: host 7.0.0');
+is(select_rocm_flavour('10.0.0'), 'rocm10', 'flavour: host 10.0.0');
+is(select_rocm_flavour('10.2.0'), 'rocm10', 'flavour: host 10.2.0');
+is(select_rocm_flavour('6.4.0'), undef,    'flavour: host 6.4.0 has no image');
+
+# ---- arch_variant / radeon_present ---------------------------------------
+my @mi300 = ('Advanced Micro Devices, Inc. [AMD/ATI] Instinct MI300X OAM [1002:74a1] (rev 01)');
+my @mi325 = ('Advanced Micro Devices, Inc. [AMD/ATI] Instinct MI325X [1002:74a1]');
+my @mi350 = ('Advanced Micro Devices, Inc. [AMD/ATI] Instinct MI350X [1002:75a0]');
+my @mi355 = ('Advanced Micro Devices, Inc. [AMD/ATI] Instinct MI355X [1002:75a3]');
+my @radeon = ('Advanced Micro Devices, Inc. [AMD/ATI] Navi 31 [Radeon RX 7900 XTX] [1002:744c]');
+my @strix = ('Advanced Micro Devices, Inc. [AMD/ATI] Strix Halo [Radeon 8060S] [1002:150e]');
+is(arch_variant(\@mi300), 'mi30x', 'arch: MI300X -> mi30x');
+is(arch_variant(\@mi325), 'mi30x', 'arch: MI325X -> mi30x');
+is(arch_variant(\@mi350), 'mi35x', 'arch: MI350X -> mi35x');
+is(arch_variant(\@mi355), 'mi35x', 'arch: MI355X -> mi35x');
+is(arch_variant(\@radeon), undef,  'arch: Radeon has no published image');
+is(arch_variant(\@strix), 'gfx1151', 'arch: Strix Halo maps to gfx1151');
+is(radeon_present(\@radeon), 1, 'radeon: Navi 31 detected');
+is(radeon_present(\@strix), 0, 'radeon: Strix Halo is served by AMD builds');
+is(radeon_present(\@mi300), 0, 'radeon: MI300X is not a Radeon card');
+
+# ---- resolve_image / model_display ---------------------------------------
+is(resolve_image('docker.io/lmsysorg/sglang', 'v0.5.19', 'mi30x', 'rocm10'),
+   'docker.io/lmsysorg/sglang:v0.5.19-rocm10-mi30x', 'image: resolved tag');
+is(resolve_image('docker.io/rocm/sgl-dev', 'v0.5.19', 'gfx1151', 'rocm724'),
+   'docker.io/rocm/sgl-dev:v0.5.19-rocm724-gfx1151', 'image: AMD dev repository for gfx1151');
+is(model_display('ZhipuAI/GLM-5.3'), 'GLM 5.3', 'display: known model');
+is(model_display('acme/unknown'), 'acme/unknown', 'display: unknown model passes through');
+
+# ---- the preset catalogue ------------------------------------------------
+# The menu is the owner's list in the owner's order, so the names are asserted
+# one by one, and each display name must resolve to the exact ModelScope
+# repository the engine will pull weights from.
+is(join('|', default_model_order()),
+   'GLM 5.3|GLM 5.3 Flash|Qwen 3.8 Max|Qwen 3.8 Flash|DeepSeek V4.1 Flash',
+   'presets: the menu order');
+is(model_display('ZhipuAI/GLM-5.3'), 'GLM 5.3', 'presets: GLM 5.3');
+is(default_model_repo('GLM 5.3'), 'ZhipuAI/GLM-5.3', 'presets: GLM 5.3 on ModelScope');
+is(default_model_repo('GLM 5.3 Flash'), 'ZhipuAI/GLM-5.3-Flash',
+   'presets: GLM 5.3 Flash on ModelScope, under ZhipuAI');
+is(default_model_repo('Qwen 3.8 Max'), 'Qwen/Qwen3.8-2.4T-A95B',
+   'presets: Qwen 3.8 Max under its weight name');
+is(default_model_repo('Qwen 3.8 Flash'), 'Qwen/Qwen3.8-Flash-Next',
+   'presets: Qwen 3.8 Flash under its weight name');
+is(default_model_repo('DeepSeek V4.1 Flash'), 'deepseek-ai/DeepSeek-V4.1-Flash',
+   'presets: DeepSeek V4.1 Flash');
+is(model_display('Qwen/Qwen3.8-2.4T-A95B'), 'Qwen 3.8 Max',
+   'display: the reverse lookup through a weight name');
+for my $id (map { default_model_repo($_) } default_model_order()) {
+    like($id, qr{^[A-Za-z0-9._-]+/[A-Za-z0-9._-]+$}, "presets: $id fits the model ID pattern");
+}
+
+# ---- base64url and key shape ---------------------------------------------
+is(encode_base64url('Man'), 'TWFu', 'base64url: Man -> TWFu');
+is(encode_base64url("\xfb\xff"), '-_8', 'base64url: FB FF -> -_8 (url alphabet)');
+is(encode_base64url('M'), 'TQ', 'base64url: one byte, no padding');
+my $key = generate_api_key();
+like($key, qr/^[A-Za-z0-9_-]{43}$/, 'key: 32 bytes -> 43 url-safe characters');
+my $key2 = generate_api_key();
+is($key eq $key2 ? 'same' : 'different', 'different', 'key: two calls differ');
+
+# ---- is_number ------------------------------------------------------------
+is((is_number('8000') ? 1 : 0), 1, 'is_number: 8000');
+is((is_number('0.90') ? 1 : 0), 1, 'is_number: 0.90');
+is((is_number('abc') ? 1 : 0), 0, 'is_number: abc');
+is((is_number('') ? 1 : 0), 0, 'is_number: empty');
+
+# ---- is_positive_int / valid_dir_path -------------------------------------
+is((is_positive_int('4') ? 1 : 0), 1, 'is_positive_int: 4');
+is((is_positive_int('0') ? 1 : 0), 0, 'is_positive_int: 0 is not positive');
+is((is_positive_int('8000.5') ? 1 : 0), 0, 'is_positive_int: a fractional port is refused');
+is((is_positive_int('1e2') ? 1 : 0), 0, 'is_positive_int: an exponent is refused');
+is((valid_dir_path('/opt/sglang') ? 1 : 0), 1, 'valid_dir_path: an absolute path passes');
+is((valid_dir_path('sglang') ? 1 : 0), 0, 'valid_dir_path: a relative path is refused');
+is((valid_dir_path('/opt/sg lang') ? 1 : 0), 0, 'valid_dir_path: whitespace is refused');
+is((valid_dir_path('/opt/%h/sglang') ? 1 : 0), 0,
+   'valid_dir_path: a systemd specifier is refused');
+is((valid_dir_path('/opt/x;/sglang') ? 1 : 0), 0,
+   'valid_dir_path: an nginx directive end is refused');
+
+# ---- run(): exit status, signals and timeout ------------------------------
+my $killed = run([$^X, '-e', 'kill 9, $$']);
+is($killed->{rc}, 137, 'run: a child killed by a signal reports 128+signal, not 0');
+my $exited = run([$^X, '-e', 'exit 3']);
+is($exited->{rc}, 3, 'run: the child exit code passes through');
+my $timedout = run([$^X, '-e', 'sleep 5'], timeout => 1);
+is($timedout->{rc}, 124, 'run: an expired timeout reports rc 124');
+
+# ---- family_is_fatal: --image overrides the GPU family --------------------
+is(family_is_fatal(undef, 0), 1, 'family: an unmatched card without --image is fatal');
+is(family_is_fatal(undef, 1), 0, 'family: --image overrides an unmatched card');
+is(family_is_fatal('mi30x', 0), 0, 'family: a published family is never fatal');
+
+# ---- radeon_env_for: the family decides, not any Radeon -------------------
+my @mixed = ('Instinct MI300X [1002:74a1]', 'Navi 31 [Radeon RX 7900 XTX] [1002:744c]');
+is(arch_variant(\@mixed), 'mi30x', 'env: a mixed host resolves the Instinct family');
+is(radeon_present(\@mixed), 1, 'env: a mixed host does carry a Radeon');
+is(scalar @{ radeon_env_for(arch_variant(\@mixed), radeon_present(\@mixed)) }, 0,
+   'env: a display Radeon does not switch an Instinct deployment to the Radeon defaults');
+is(scalar @{ radeon_env_for('gfx1151', 0) }, 2, 'env: gfx1151 carries the Radeon defaults');
+is(scalar @{ radeon_env_for(undef, 1) }, 2,
+   'env: a custom image on a Radeon-only host carries the Radeon defaults');
+is(scalar @{ radeon_env_for('mi30x', 0) }, 0, 'env: an Instinct host carries none');
+
+# ---- nginx config --------------------------------------------------------
+my $conf = nginx_conf_content(8000, '[::1]', '/etc/ssl/sglang');
+like($conf, qr/listen \[::\]:443 ssl;/, 'nginx: IPv6 listener on a dual-stack kernel');
+like($conf, qr/listen 443 ssl;/, 'nginx: IPv4 listener');
+like($conf, qr|ssl_certificate /etc/ssl/sglang/sglang\.crt;|, 'nginx: certificate path');
+like($conf, qr/ssl_certificate_key \/etc\/ssl\/sglang\/sglang\.key;/, 'nginx: key path');
+like($conf, qr|proxy_pass http://\[::1\]:8000;|, 'nginx: loopback upstream with the port');
+like($conf, qr/proxy_http_version 1\.1;/, 'nginx: HTTP/1.1 for streaming');
+like($conf, qr/proxy_buffering off;/, 'nginx: buffering off for streaming');
+like($conf, qr/proxy_set_header Host \$host;/, 'nginx: $host survives the heredoc');
+like($conf, qr/proxy_set_header X-Forwarded-For \$proxy_add_x_forwarded_for;/,
+     'nginx: $proxy_add_x_forwarded_for survives the heredoc');
+
+my $conf4 = nginx_conf_content(8000, '127.0.0.1', '/etc/ssl/sglang');
+is($conf4 =~ /\[::\]/ ? 'yes' : 'no',
+   (-e '/proc/net/if_inet6' ? 'yes' : 'no'), 'nginx: IPv6 listener follows the kernel');
+
+# ---- systemd unit --------------------------------------------------------
+my $unit = systemd_content({
+    model                  => 'ZhipuAI/GLM-5.3',
+    host                   => '::1',
+    port                   => 8000,
+    tensor_parallel        => 4,
+    max_model_len          => 32768,
+    gpu_memory_utilization => '0.9',
+    state_dir              => '/opt/sglang',
+    image                  => 'docker.io/lmsysorg/sglang:v0.5.19-rocm10-mi30x',
+    env_file               => '/etc/sysconfig/sglang',
+    radeon_env             => [],
+});
+like($unit, qr/Description=SGLang Inference Server \(ZhipuAI\/GLM-5\.3\)/, 'unit: description');
+like($unit, qr/EnvironmentFile=\/etc\/sysconfig\/sglang/, 'unit: EnvironmentFile');
+like($unit, qr/Environment=SGLANG_USE_MODELSCOPE=true/, 'unit: weights come from ModelScope');
+like($unit, qr/--network=host/, 'unit: host networking');
+like($unit, qr/--device=\/dev\/kfd --device=\/dev\/dri/, 'unit: GPU device nodes');
+like($unit, qr/--group-add video/, 'unit: video group');
+like($unit, qr/--ipc=host/, 'unit: IPC namespace');
+like($unit, qr/--cap-add=SYS_PTRACE/, 'unit: ptrace capability');
+like($unit, qr/--security-opt seccomp=unconfined/, 'unit: seccomp');
+like($unit, qr|--volume /opt/sglang/modelscope:/root/\.cache/modelscope:Z|,
+     'unit: ModelScope cache volume with SELinux relabel');
+like($unit, qr/--env MODELSCOPE_TOKEN/, 'unit: ModelScope token forwarded when set');
+like($unit, qr/--rm --replace --name sglang/, 'unit: container name and cleanup');
+like($unit, qr/--pull=missing/, 'unit: pull policy');
+like($unit, qr/docker\.io\/lmsysorg\/sglang:v0\.5\.19-rocm10-mi30x/, 'unit: image');
+like($unit, qr/python3 -m sglang\.launch_server/, 'unit: engine entry point');
+like($unit, qr/--model-path ZhipuAI\/GLM-5\.3/, 'unit: model path');
+like($unit, qr/--host ::1/, 'unit: loopback bind');
+like($unit, qr/--port 8000/, 'unit: port');
+like($unit, qr/--api-key \$\{SGLANG_API_KEY\}/, 'unit: API key from the environment file');
+is($unit =~ /sk-[A-Za-z0-9]/ ? 'yes' : 'no', 'no', 'unit: no literal API key');
+like($unit, qr/--tp-size 4/, 'unit: tensor parallel as --tp-size');
+like($unit, qr/--context-length 32768/, 'unit: context length');
+like($unit, qr/--mem-fraction-static 0\.9/, 'unit: static memory fraction');
+is($unit =~ /SGLANG_USE_AITER/ ? 'yes' : 'no', 'no',
+   'unit: no Radeon variables on a non-Radeon host');
+like($unit, qr/WantedBy=multi-user\.target/, 'unit: install section');
+like($unit, qr/Restart=on-failure/, 'unit: restart policy');
+
+my $unit_radeon = systemd_content({
+    model                  => 'ZhipuAI/GLM-5.3',
+    host                   => '::1',
+    port                   => 8000,
+    tensor_parallel        => 1,
+    max_model_len          => 4096,
+    gpu_memory_utilization => '0.9',
+    state_dir              => '/opt/sglang',
+    image                  => 'local/sglang-rocm:latest',
+    env_file               => '/etc/sysconfig/sglang',
+    radeon_env             => ['SGLANG_USE_AITER=false', 'SGLANG_ROCM_FUSED_DECODE_MLA=false'],
+});
+like($unit_radeon, qr/Environment=SGLANG_USE_AITER=false/, 'unit: AITER off on Radeon');
+like($unit_radeon, qr/Environment=SGLANG_ROCM_FUSED_DECODE_MLA=false/,
+     'unit: fused decode MLA off on Radeon');
+
+# ---- parse_os_release reads the host (smoke test) ------------------------
+my %release = parse_os_release();
+is(exists $release{ID} ? 'present' : 'absent', 'present', 'os-release: ID is parsed');
+
+# ---- arguments -----------------------------------------------------------
+my @ARGV_COPY = @ARGV;
+local @ARGV = ('--model', 'ZhipuAI/GLM-5.3', '--port=9000', '--tensor-parallel', '2');
+my %args = parse_args();
+is($args{model}, 'ZhipuAI/GLM-5.3', 'args: --model value');
+is($args{port}, '9000', 'args: --port=9000 inline form');
+is($args{tensor_parallel}, '2', 'args: --tensor-parallel value');
+is($args{service_name}, 'sglang', 'args: service name default');
+is($args{state_dir}, '/opt/sglang', 'args: state dir default');
+is($args{cert_dir}, '/etc/ssl/sglang', 'args: cert dir default');
+
+@ARGV = ('--dry-run', '--uninstall', '--rocm-flavour', 'rocm720');
+my %args2 = parse_args();
+is($args2{dry_run}, 1, 'args: --dry-run');
+is($args2{uninstall}, 1, 'args: --uninstall');
+is($args2{rocm_flavour}, 'rocm720', 'args: --rocm-flavour');
+
+@ARGV = @ARGV_COPY;
+
+print "\n" . ($failed
+    ? "$failed FAILED of " . ($passed + $failed)
+    : "all $passed checks passed") . "\n";
+exit($failed ? 1 : 0);
diff --git a/tests/system-diag.pl b/tests/system-diag.pl
new file mode 100644
index 0000000..5b30f28
--- /dev/null
+++ b/tests/system-diag.pl
@@ -0,0 +1,280 @@
+#!/usr/bin/env perl
+# Copyright (c) 2026 Petr Balvín <opensource@petrbalvin.org> (https://petrbalvin.org)
+# SPDX-License-Identifier: MIT
+
+# Checks for system-diag.pl: the JSON encoder, the calendar and formatting helpers,
+# the address validation and the section result reader.
+#
+# Run from anywhere: perl tests/system-diag.pl
+
+use strict;
+use warnings;
+
+my $root = $0 =~ m{^(.*)/[^/]+$} ? "$1/.." : '..';
+$root = "./$root" if $root !~ m{^/};
+require "$root/system-diag.pl";
+
+my ($passed, $failed) = (0, 0);
+
+sub is {
+    my ($got, $want, $label) = @_;
+    $got = 'undef' unless defined $got;
+    $want = 'undef' unless defined $want;
+    if ($got eq $want) {
+        $passed++;
+        print "ok   $label\n";
+        return 1;
+    }
+    $failed++;
+    print "FAIL $label\n     got:  $got\n     want: $want\n";
+    return 0;
+}
+
+sub check {
+    my ($cond, $label) = @_;
+    return is($cond ? 1 : 0, 1, $label);
+}
+
+sub like {
+    my ($got, $re, $label) = @_;
+    my $matched = (defined $got && $got =~ $re) ? 1 : 0;
+    if ($matched) {
+        $passed++;
+        print "ok   $label\n";
+        return 1;
+    }
+    $failed++;
+    print "FAIL $label\n     got:  " . (defined $got ? $got : 'undef') . "\n     want: $re\n";
+    return 0;
+}
+
+# ---------------------------------------------------------------------------
+# JSON
+# ---------------------------------------------------------------------------
+
+is(json_quote('plain'), '"plain"', 'json_quote: a plain word');
+is(json_quote("a\"b"), '"a\\"b"', 'json_quote: a double quote is escaped');
+is(json_quote("a\nb"), '"a\\nb"', 'json_quote: a newline is escaped');
+is(json_quote("a\tb"), '"a\\tb"', 'json_quote: a tab is escaped');
+is(json_quote('back\\slash'), '"back\\\\slash"', 'json_quote: a backslash is escaped');
+
+my $encoded = json_encode({ a => 1, b => 'x', c => [1, 2], d => undef, e => 1.5 });
+like($encoded, qr/"a": 1/, 'json_encode: an integer');
+like($encoded, qr/"b": "x"/, 'json_encode: a string');
+like($encoded, qr/"d": null/, 'json_encode: an undefined value');
+like($encoded, qr/"e": 1\.5/, 'json_encode: a float');
+like($encoded, qr/"c": \[\s*1,\s*2\s*\]/s, 'json_encode: an array');
+like($encoded, qr/\A\{\n/, 'json_encode: an object opens on its own line');
+like($encoded, qr/\}\n\z/, 'json_encode: the document ends with a newline');
+
+like(json_encode([1, 2, 3]), qr/\A\[\n/, 'json_encode: a top-level array');
+
+# ---------------------------------------------------------------------------
+# Calendar and time
+# ---------------------------------------------------------------------------
+
+is(_days_from_civil(1970, 1, 1), 0, 'calendar: the epoch is day zero');
+is(_days_from_civil(1970, 1, 2), 1, 'calendar: the next day');
+is(_days_from_civil(1969, 12, 31), -1, 'calendar: the day before the epoch');
+is(_days_from_civil(2000, 3, 1), 11017, 'calendar: the day after the leap day of 2000');
+# Cross-checked with the system's own calendar: timegm for that date over 86400.
+is(_days_from_civil(2026, 9, 17), 20713, 'calendar: a current date');
+
+local $ENV{TZ} = 'UTC';
+is(timestamp_fields(0), '1970-01-01T00:00:00+0000', 'timestamp: the epoch in UTC');
+is(timestamp_fields(86400), '1970-01-02T00:00:00+0000', 'timestamp: one day on');
+like(timestamp_fields(1787961600), qr/\A\d{4}-\d{2}-\d{2}T\d{2}:\d{2}:\d{2}[+-]\d{4}\z/,
+    'timestamp: the shape of a timestamp');
+like(utc_offset(time()), qr/\A[+-]\d{4}\z/, 'timestamp: the offset has a sign and four digits');
+
+like(uptime_human(90061), qr/1/, 'uptime: a day is reported');
+like(uptime_human(0), qr/\d/, 'uptime: zero still reads as a duration');
+
+# ---------------------------------------------------------------------------
+# Bars and percentages
+# ---------------------------------------------------------------------------
+
+# The bar carries colour codes around its cells and the percentage after them, so the
+# assertions strip the codes first.
+sub bar_plain {
+    my ($text) = @_;
+    $text =~ s/\e\[[0-9;]*m//g;
+    return $text;
+}
+
+is(bar_plain(_bar(50, 100, 10)), "\xe2\x96\x88" x 5 . "\xe2\x96\x91" x 5 . '  50%',
+    'bar: half of ten cells');
+is(bar_plain(_bar(100, 100, 10)), "\xe2\x96\x88" x 10 . '  100%', 'bar: a full bar');
+is(bar_plain(_bar(0, 100, 10)), "\xe2\x96\x91" x 10 . '  0%', 'bar: an empty bar');
+is(bar_plain(_bar(0, 0, 10)), "\xe2\x96\x91" x 10 . '  0%', 'bar: a zero maximum does not divide');
+# Colour is off when stdout is not a terminal, which is how the tests run, so the bar
+# is asserted plain here.
+
+# Deltas: 1000 jiffies in total, 800 of them idle and iowait, so 200 are busy.
+is(usage_percent([100, 0, 100, 800, 100], [200, 0, 200, 1600, 100]), '20.0',
+    'usage: a fifth of the delta is busy');
+is(usage_percent([0, 0, 0, 100, 0], [0, 0, 0, 200, 0]), '0.0', 'usage: an idle machine');
+is(usage_percent([0, 0, 0], [1, 1, 1]), '0.0', 'usage: a short sample is zero');
+
+# ---------------------------------------------------------------------------
+# Addresses and file systems
+# ---------------------------------------------------------------------------
+
+is(_valid_ipv6('::1'), 1, 'ipv6: loopback');
+is(_valid_ipv6('2001:db8::1'), 1, 'ipv6: a documentation prefix');
+is(_valid_ipv6('127.0.0.1'), 0, 'ipv6: an IPv4 address is not IPv6');
+is(_valid_ipv6('2001:db8::1::2'), 0, 'ipv6: two shorthands are invalid');
+is(_valid_ipv6('fe80::1%eth0'), 1, 'ipv6: a scope suffix is accepted');
+
+is(is_address('192.168.1.1'), 1, 'address: IPv4');
+is(is_address('::1'), 1, 'address: IPv6');
+is(is_address('not-an-address'), 0, 'address: a word is not an address');
+is(is_address(''), 0, 'address: an empty string is not an address');
+
+is(skip_filesystem('tmpfs', '/run'), 1, 'filesystem: tmpfs is skipped');
+is(skip_filesystem('overlay', '/'), 1, 'filesystem: overlay is skipped');
+is(skip_filesystem('ext4', '/dev/sda1'), 0, 'filesystem: ext4 is measured');
+is(skip_filesystem('xfs', '/dev/mapper/root'), 0, 'filesystem: xfs is measured');
+
+is(unescape_mount_point('/mnt/\\040data'), '/mnt/ data', 'mounts: an escaped space decodes');
+is(unescape_mount_point('/mnt/\\011tab'), "/mnt/\ttab", 'mounts: an escaped tab decodes');
+is(unescape_mount_point('/mnt/\\134back'), '/mnt/\\back', 'mounts: an escaped backslash decodes');
+is(unescape_mount_point('/plain/path'), '/plain/path', 'mounts: a plain path is untouched');
+
+# ---------------------------------------------------------------------------
+# Results read back from a section worker
+# ---------------------------------------------------------------------------
+
+is(perl_literal('42'), '42', 'literal: a whole number stays a number');
+is(perl_literal('08'), "'08'", 'literal: a leading zero is quoted, not octalised');
+is(perl_literal('010'), "'010'", 'literal: a leading zero with digits is quoted too');
+
+my $tmp = "/tmp/system-diag-test.$$";
+open(my $fh, '>', $tmp) or die "cannot write $tmp: $!\n";
+print {$fh} perl_literal({ cpu => { usage_pct => 12.5 }, host => 'node1', key => '18.0', zeroed => '08' });
+close($fh);
+
+my ($value, $error) = read_literal($tmp);
+is($error, '', 'literal: a written result reads back without error');
+is($value->{host}, 'node1', 'literal: a string survives the round trip');
+is($value->{cpu}{usage_pct}, 12.5, 'literal: a float survives the round trip');
+is($value->{key}, '18.0', 'literal: a numeric-looking string stays a string');
+is($value->{zeroed}, '08', 'literal: a leading-zero string survives the round trip');
+unlink($tmp);
+
+my ($missing, $missing_error) = read_literal("$tmp.does-not-exist");
+is($missing, undef, 'literal: a missing result file yields nothing');
+like($missing_error, qr/was not written/, 'literal: a missing result file says so');
+
+# ---------------------------------------------------------------------------
+# External tools, through fixture binaries on a private PATH
+# ---------------------------------------------------------------------------
+
+# A collector is exercised end to end by replacing its external tool with a Perl
+# fixture that prints a known answer, so the parsing is checked against the shape
+# of the real tool's output without needing the tool installed.
+sub install_fake_bin {
+    my ($dir, $name, $body) = @_;
+    open(my $fh, '>', "$dir/$name") or die "cannot write $dir/$name: $!\n";
+    print {$fh} "#!/usr/bin/env perl\n", $body;
+    close($fh);
+    chmod(0755, "$dir/$name") or die "cannot chmod $dir/$name: $!\n";
+    return;
+}
+
+my $bindir = "/tmp/system-diag-test-bin.$$";
+mkdir($bindir, 0700) or die "cannot create $bindir: $!\n";
+
+# The fixture PATH is scoped, so the rest of the checks see the real one.
+{
+    local $ENV{PATH} = "$bindir:$ENV{PATH}";
+
+    install_fake_bin($bindir, 'lspci', <<'FIXTURE');
+exit 0 if @ARGV && $ARGV[0] eq '-d';
+print "0000:01:00.0 VGA compatible controller: Intel Corporation UHD Graphics 730 (rev 01)\n";
+print "0000:02:00.0 3D controller: Huawei Technologies Co., Ltd. Ascend 910A\n";
+FIXTURE
+    my $gpu = lspci_gpu();
+    is($gpu->{cards}[0]{model}, 'Intel Corporation UHD Graphics 730 (rev 01)',
+        'lspci: the model is the description, not the whole line');
+    is($gpu->{cards}[0]{vendor}, 'Intel', 'lspci: Corporation does not read as AMD');
+    is($gpu->{cards}[1]{vendor}, 'Huawei', 'lspci: an Ascend card has its vendor');
+
+    install_fake_bin($bindir, 'systemctl', <<'FIXTURE');
+if (@ARGV && $ARGV[0] eq '--failed') {
+    print "nginx.service loaded failed failed A high performance web server\n";
+}
+FIXTURE
+    my $failed = failed_units();
+    is($failed->[0]{unit}, 'nginx.service', 'services: a failed unit is listed');
+    is($failed->[0]{state}, 'failed', 'services: the state is the unit state, not the load state');
+
+    install_fake_bin($bindir, 'iostat', <<'FIXTURE');
+print "Device            r/s     rkB/s   w/s     wkB/s\n";
+print "sda               4.00    2048.00 10.00   512.00\n\n";
+print "Device            r/s     rkB/s   w/s     wkB/s\n";
+print "sda               8.00    4096.00 20.00  1024.00\n";
+FIXTURE
+    my $io = disk_io_stats();
+    is($io->{devices}[0]{tps}, '28.00', 'iostat: the second report is the one measured');
+    is($io->{devices}[0]{read_mb_s}, '4.00', 'iostat: a kB/s column converts to MB/s');
+    is($io->{devices}[0]{write_mb_s}, '1.00', 'iostat: kB/s writes convert to MB/s');
+
+    # Older sysstat printed MB/s columns; dividing those again would report a value
+    # 1024 times too small.
+    install_fake_bin($bindir, 'iostat', <<'FIXTURE');
+print "Device:         rrqm/s   wrqm/s     r/s     w/s   rMB/s   wMB/s\n";
+print "sda               0.00     0.00    4.00   10.00   16.00    8.00\n";
+FIXTURE
+    $io = disk_io_stats();
+    is($io->{devices}[0]{read_mb_s}, '16.00', 'iostat: an MB/s column is not divided again');
+    is($io->{devices}[0]{write_mb_s}, '8.00', 'iostat: MB/s writes stay in MB/s');
+
+    # A machine with lspci and no GPU at all: collect_gpu answers undef, which is a
+    # result and must not reach the report as a collection failure.
+    install_fake_bin($bindir, 'lspci', <<'FIXTURE');
+exit 0 if @ARGV && $ARGV[0] eq '-d';
+print "00:1f.2 SATA controller: Intel Corporation 82801IR SATA [AHCI mode]\n";
+FIXTURE
+    my $collected = collect_all(['gpu'], 0);
+    check(!(ref($collected->{gpu}) eq 'HASH' && $collected->{gpu}{error}),
+        'collect: no GPU is a result, not a collection failure');
+}
+
+unlink(grep { -f } glob("$bindir/*"));
+rmdir($bindir);
+
+# ---------------------------------------------------------------------------
+# Health
+# ---------------------------------------------------------------------------
+
+my $health = compute_health({});
+is(ref($health), 'HASH', 'health: the verdict is a hash');
+is($health->{score}, undef, 'health: no data has no score');
+is($health->{grade}, 'N/A', 'health: no data is not graded');
+is($health->{max_score}, 100, 'health: the maximum is one hundred');
+# An ungraded run is the only verdict this test can construct, so the letter is not
+# asserted here: it depends on a populated collection, which the script's own run
+# exercises.  A check whose condition is a match must be forced into a boolean, since
+# in an argument list a failed match yields the empty list and shifts the label into
+# the condition slot.
+check(ref($health->{breakdown}) eq 'HASH', 'health: the breakdown is a hash');
+check(ref($health->{factors_skipped}) eq 'ARRAY', 'health: the skipped factors are listed');
+
+# ---------------------------------------------------------------------------
+# Arguments
+# ---------------------------------------------------------------------------
+
+my @saved = @ARGV;
+@ARGV = ('--json', '--section', 'cpu,memory');
+my %args = parse_args();
+is($args{json}, 1, 'args: --json');
+is($args{section}, 'cpu,memory', 'args: --section takes a list');
+@ARGV = ();
+my %defaults = parse_args();
+is($defaults{json}, 0, 'args: json is off by default');
+is($defaults{section}, '', 'args: every section by default');
+@ARGV = @saved;
+
+print "\n" . ($failed ? "$failed FAILED of " . ($passed + $failed) : "all $passed checks passed") . "\n";
+exit($failed ? 1 : 0);
diff --git a/tests/system-optimise.pl b/tests/system-optimise.pl
new file mode 100644
index 0000000..cd17639
--- /dev/null
+++ b/tests/system-optimise.pl
@@ -0,0 +1,325 @@
+#!/usr/bin/env perl
+# Copyright (c) 2026 Petr Balvín <opensource@petrbalvin.org> (https://petrbalvin.org)
+# SPDX-License-Identifier: MIT
+
+# Checks for system-optimise.pl: the version comparison against rpm's own
+# implementation, the pure helpers and the JSON decoder.
+#
+# Run from anywhere: perl tests/system-optimise.pl
+
+use strict;
+use warnings;
+
+my $root = $0 =~ m{^(.*)/[^/]+$} ? "$1/.." : '..';
+$root = "./$root" if $root !~ m{^/};
+require "$root/system-optimise.pl";
+
+my ($passed, $failed) = (0, 0);
+
+sub is {
+    my ($got, $want, $label) = @_;
+    $got = 'undef' unless defined $got;
+    $want = 'undef' unless defined $want;
+    if ($got eq $want) {
+        $passed++;
+        print "ok   $label\n";
+        return 1;
+    }
+    $failed++;
+    print "FAIL $label\n     got:  $got\n     want: $want\n";
+    return 0;
+}
+
+sub check {
+    my ($cond, $label) = @_;
+    return is($cond ? 1 : 0, 1, $label);
+}
+
+sub like {
+    my ($got, $re, $label) = @_;
+    my $matched = (defined $got && $got =~ $re) ? 1 : 0;
+    if ($matched) {
+        $passed++;
+        print "ok   $label\n";
+        return 1;
+    }
+    $failed++;
+    print "FAIL $label\n     got:  " . (defined $got ? $got : 'undef') . "\n     want: $re\n";
+    return 0;
+}
+
+# ---------------------------------------------------------------------------
+# Version comparison, against rpm itself
+# ---------------------------------------------------------------------------
+#
+# rpm carries the definition of its own ordering, so the comparison is checked
+# against rpm's implementation rather than against an expectation written here
+# by hand.  The corpus is fixed: the same pairs every run.  No pair may carry
+# a dash or a colon: the oracle below parses its arguments as
+# [epoch:]version[-release] and would split on them, so those shapes belong to
+# the EVR corpus further down.
+
+my @VERSION_PAIRS = (
+    ['1.0', '1.1'],
+    ['1.1', '1.0'],
+    ['1.0', '1.0'],
+    ['1.09', '1.9'],
+    ['1.0', '1.0.0'],
+    ['1.0a', '1.0'],
+    ['1.0a', '1.0b'],
+    ['1.0', '1.0~rc1'],
+    ['1.0~rc1', '1.0~rc2'],
+    ['1.0~rc1', '1.0~rc1'],
+    ['1.0^post1', '1.0'],
+    ['1.0^post1', '1.0^post2'],
+    ['2.0', '10.0'],
+    ['1.2.3', '1.2.3'],
+    ['1.2.3.4', '1.2.3'],
+    ['5.14.0', '5.14.0.1'],
+    ['0.9', '1.0'],
+    ['1.0', '1.0b'],
+    ['2024.1', '2024.10'],
+    ['1.0.rc1', '1.0'],
+    ['1.0^post1', '1.0b'],
+    ['1.0', '1.0^'],
+    ['1.0.~rc1', '1.0~rc1'],
+    ['1.0^x', '1.0~x'],
+    ['1.0.1', '1.0^post1'],
+);
+
+sub rpm_vercmp_oracle {
+    my ($pairs) = @_;
+    # rpm's macro parser counts braces, so the lua body below carries none: the corpus
+    # travels as one flat string, and the pattern splits it back into pairs.
+    my $spec = join(';', map { "$_->[0],$_->[1]" } @$pairs) . ';';
+    # a comma or a semicolon would silently shift the pairing, so both travel
+    # with the characters that break the lua literal
+    return undef if grep { m{["\\{};,]} } map { @$_ } @$pairs;
+    my $lua = '%{lua: local s="' . $spec . '";'
+        . q{ for l,r in s:gmatch("([^,]+),([^;]+);") do io.write(rpm.vercmp(l,r), "\n") end};
+    $lua .= '}';
+    my $fh;
+    open($fh, '-|', 'rpm', '--eval', $lua) or return undef;
+    my @out = <$fh>;
+    close($fh);
+    return undef unless $? == 0;
+    chomp @out;
+    return \@out;
+}
+
+my $oracle = rpm_vercmp_oracle(\@VERSION_PAIRS);
+if (!defined $oracle) {
+    print "skip version comparison: rpm is not installed (the oracle)\n";
+}
+else {
+    my $i = 0;
+    for my $pair (@VERSION_PAIRS) {
+        $i++;
+        my ($left, $right) = @$pair;
+        my $mine = rpmvercmp($left, $right);
+        my $sign = $mine <=> 0;
+        is($sign, $oracle->[$i - 1], "rpmvercmp($left, $right) matches rpm");
+    }
+}
+
+is(rpmvercmp('1.0', '1.0'), 0, 'rpmvercmp: equal versions');
+check(rpmvercmp('1.0~rc1', '1.0') < 0, 'rpmvercmp: a tilde sorts before the release');
+check(rpmvercmp('1.0^post1', '1.0') > 0, 'rpmvercmp: a caret sorts after the release');
+
+# ---------------------------------------------------------------------------
+# EVR comparison
+# ---------------------------------------------------------------------------
+
+is(rpm_evr_cmp('1:1.0-1', '1:1.0-2'), -1, 'evr: release decides');
+is(rpm_evr_cmp('1:1.0-1', '2:1.0-1'), -1, 'evr: epoch decides');
+is(rpm_evr_cmp('1:1.0-1', '1:1.0-1'), 0, 'evr: identical');
+check(rpm_evr_cmp('2:1.0-1', '1:9.9-9') > 0, 'evr: an epoch outranks any version');
+is(rpm_evr_cmp('1.0-1', '1:1.0-1'), -1, 'evr: a missing epoch is zero');
+
+# The same oracle drives the EVR comparison, now with dashes and colons:
+# rpm.vercmp parses its arguments as [epoch:]version[-release] and compares
+# field by field, which is exactly the contract of rpm_evr_cmp.  The pairs
+# below are the shapes the kernel query produces, plus the cases where
+# comparing version and release as one string would order differently.
+my @EVR_PAIRS = (
+    ['1.0-2', '1.0.1-1'],
+    ['1.0', '1.0-1'],
+    ['1.0-1-2', '1.0-1'],
+    ['2:1.0-1', '1.0-1'],
+    ['0:1.0', '1.0'],
+    ['1.0~rc1-1', '1.0-1'],
+    ['0:6.9.5-100.fc40.x86_64', '0:6.9.6-50.fc40.x86_64'],
+    ['0:6.9.5-100.fc40.x86_64', '0:6.9.5-200.fc40.x86_64'],
+);
+my $evr_oracle = rpm_vercmp_oracle(\@EVR_PAIRS);
+if (!defined $evr_oracle) {
+    print "skip EVR comparison: rpm is not installed (the oracle)\n";
+}
+else {
+    my $j = 0;
+    for my $pair (@EVR_PAIRS) {
+        $j++;
+        my ($left, $right) = @$pair;
+        my $mine = rpm_evr_cmp($left, $right);
+        my $sign = $mine <=> 0;
+        is($sign, $evr_oracle->[$j - 1], "rpm_evr_cmp($left, $right) matches rpm");
+    }
+}
+
+# ---------------------------------------------------------------------------
+# Formatting and small helpers
+# ---------------------------------------------------------------------------
+
+is(format_size(0), '0 B', 'format_size: zero');
+is(format_size(512), '512 B', 'format_size: under a kilobyte');
+is(format_size(1024), '1.0 KB', 'format_size: one kilobyte');
+is(format_size(1536), '1.5 KB', 'format_size: fraction of a kilobyte');
+is(format_size(1048576), '1.0 MB', 'format_size: one megabyte');
+is(format_size(1073741824), '1.00 GB', 'format_size: one gigabyte');
+is(format_size(-1), '0 B', 'format_size: negative is clamped');
+
+is(kernel_pkg_name('fedora'), 'kernel-core', 'kernel_pkg_name: Fedora');
+is(kernel_pkg_name('openeuler'), 'kernel', 'kernel_pkg_name: openEuler');
+is(kernel_pkg_name('centos'), 'kernel-core', 'kernel_pkg_name: CentOS Stream');
+
+is(last_lines("a\nb\nc\nd\n", 2), 'c | d', 'last_lines: the last two lines, joined');
+is(last_lines("1\n2\n3\n4\n", 10), '1 | 2 | 3 | 4', 'last_lines: a count above the line number');
+is(last_lines("\n\n", 3), 'no error output', 'last_lines: blank input is named as no output');
+
+my ($gone, $left) = split_by_presence(['a', 'b', 'c'], ['b', 'd']);
+is(join(',', @$gone), 'a,c', 'split_by_presence: gone holds what vanished');
+is(join(',', @$left), 'b', 'split_by_presence: left holds the survivors');
+
+# ---------------------------------------------------------------------------
+# JSON decoder
+# ---------------------------------------------------------------------------
+
+my $decoded = json_decode('{"a":1,"b":[true,false,null],"c":"x\\ny","d":{"e":2.5}}');
+is(ref($decoded), 'HASH', 'json: an object decodes to a hash');
+is($decoded->{a}, 1, 'json: an integer');
+is(ref($decoded->{b}), 'ARRAY', 'json: an array decodes to an array');
+is($decoded->{b}[0], 1, 'json: true is truthy');
+is($decoded->{b}[1], 0, 'json: false is falsey');
+is($decoded->{b}[2], undef, 'json: null is undef');
+is($decoded->{c}, "x\ny", 'json: an escaped newline');
+is($decoded->{d}{e}, 2.5, 'json: a nested float');
+
+my $escaped = json_decode('{"s":"a\"b\\\\c\/d\te"}');
+is($escaped->{s}, "a\"b\\c/d\te", 'json: quotes, backslashes, a solidus and a tab');
+
+my $unicode = json_decode('{"s":"\u0041\u00e9"}');
+is($unicode->{s}, "A\xc3\xa9", 'json: a unicode escape becomes UTF-8 bytes');
+
+my $empty = json_decode('[]');
+is(ref($empty), 'ARRAY', 'json: an empty array');
+is(scalar(@$empty), 0, 'json: an empty array has no elements');
+
+# The decoder dies on malformed input rather than returning a sentinel, so a caller
+# that cannot trust its input wraps the call; the test asserts that contract.
+my $died = eval { json_decode('not json'); 1 } ? 0 : 1;
+is($died, 1, 'json: malformed input dies rather than returning a value');
+like($@, qr/unrecognised token/, 'json: the death names the reason');
+
+# ---------------------------------------------------------------------------
+# Arguments
+# ---------------------------------------------------------------------------
+
+# parse_args reads the program's arguments, so a test sets them the way a caller does.
+my @saved = @ARGV;
+@ARGV = ('--dry-run', '--skip-journal');
+my %args = parse_args();
+is($args{dry_run}, 1, 'args: --dry-run sets the flag');
+is($args{skip_journal}, 1, 'args: --skip-journal sets the flag');
+is($args{skip_tmp}, 0, 'args: an unset skip stays off');
+@ARGV = ();
+my %defaults = parse_args();
+is($defaults{dry_run}, 0, 'args: dry run defaults to off');
+@ARGV = @saved;
+
+# ---------------------------------------------------------------------------
+# Temp cleanup, end to end
+# ---------------------------------------------------------------------------
+#
+# clean_temp_dir drives the real find(1), so the age filter, the deletion and
+# the verification of what went away are exercised together here, against a
+# directory this test owns.
+
+if (!defined find_exe('find')) {
+    print "skip temp cleanup: find is not installed\n";
+}
+else {
+    my $dir = "/tmp/system-optimise-test.$$";
+    mkdir($dir, 0700) or die "cannot create $dir: $!\n";
+    my $aged = "$dir/aged.txt";
+    my $fresh = "$dir/fresh.txt";
+    for my $file ($aged, $fresh) {
+        open(my $fh, '>', $file) or die "cannot create $file: $!\n";
+        print {$fh} "test\n";
+        close($fh);
+    }
+    my $old_time = time() - 30 * 86400;
+    utime($old_time, $old_time, $aged);
+
+    my @warnings;
+    my @errors;
+    my ($count, $bytes) = clean_temp_dir($dir, 10,
+        dry_run => 1, warnings => \@warnings, errors => \@errors);
+    is($count, 1, 'temp: dry run counts the one aged file');
+    check(-e $aged, 'temp: dry run leaves the aged file in place');
+    is(scalar(@errors), 0, 'temp: dry run reports no errors');
+
+    ($count, $bytes) = clean_temp_dir($dir, 10,
+        dry_run => 0, warnings => \@warnings, errors => \@errors);
+    is($count, 1, 'temp: the real run reports the aged file as removed');
+    check(!-e $aged, 'temp: the aged file is gone');
+    check(-e $fresh, 'temp: the fresh file survives');
+    check($bytes > 0, 'temp: the freed size is above zero');
+    is(scalar(@errors), 0, 'temp: the real run reports no errors');
+
+    my ($again) = clean_temp_dir($dir, 10,
+        dry_run => 0, warnings => \@warnings, errors => \@errors);
+    is($again, 0, 'temp: a second run finds nothing to remove');
+
+    unlink($fresh);
+    rmdir($dir);
+}
+
+# ---------------------------------------------------------------------------
+# The command runner and the scratch directory
+# ---------------------------------------------------------------------------
+
+# A file that cannot be exec'd: the runner must report 126 and name the
+# binary, rather than swallowing the reason the exec failed.
+my $bad_exe = "/tmp/system-optimise-test-noexec.$$";
+if (open(my $fh, '>', $bad_exe)) {
+    print {$fh} "#!/nonexistent/interpreter\n";
+    close($fh);
+    chmod(0755, $bad_exe);
+    my $result = run([$bad_exe]);
+    is($result->{rc}, 126, 'run: a failed exec reports 126');
+    like($result->{err}, qr/cannot execute/, 'run: the failure names the binary');
+    unlink($bad_exe);
+}
+else {
+    print "skip runner: cannot write $bad_exe\n";
+}
+
+# An empty TMPDIR must fall back to /tmp rather than placing the scratch
+# directory at the filesystem root.
+my $empty_tmpdir = eval {
+    remove_scratch();   # the cached directory would bypass the fallback
+    local $ENV{TMPDIR} = '';
+    my $scratch = scratch_dir();
+    remove_scratch();
+    return $scratch;
+};
+if (defined $empty_tmpdir) {
+    like($empty_tmpdir, qr{^/tmp/system-optimise\.},
+        'scratch_dir: an empty TMPDIR falls back to /tmp');
+}
+else {
+    print "skip scratch_dir: cannot create a scratch directory\n";
+}
+
+print "\n" . ($failed ? "$failed FAILED of " . ($passed + $failed) : "all $passed checks passed") . "\n";
+exit($failed ? 1 : 0);
diff --git a/tests/workstation-setup.pl b/tests/workstation-setup.pl
new file mode 100644
index 0000000..05039b0
--- /dev/null
+++ b/tests/workstation-setup.pl
@@ -0,0 +1,243 @@
+#!/usr/bin/env perl
+# Copyright (c) 2026 Petr Balvín <opensource@petrbalvin.org> (https://petrbalvin.org)
+# SPDX-License-Identifier: MIT
+
+# Checks for workstation-setup.pl: the JSON decoder, the architecture mapping, the
+# checksum file reader, the atomic writer, the runner and user command helpers,
+# the Brave repo pin, the IDE launcher links and the supported system set.
+#
+# Run from anywhere: perl tests/workstation-setup.pl
+
+use strict;
+use warnings;
+
+my $root = $0 =~ m{^(.*)/[^/]+$} ? "$1/.." : '..';
+$root = "./$root" if $root !~ m{^/};
+require "$root/workstation-setup.pl";
+
+my ($passed, $failed) = (0, 0);
+
+sub is {
+    my ($got, $want, $label) = @_;
+    $got = 'undef' unless defined $got;
+    $want = 'undef' unless defined $want;
+    if ($got eq $want) {
+        $passed++;
+        print "ok   $label\n";
+        return 1;
+    }
+    $failed++;
+    print "FAIL $label\n     got:  $got\n     want: $want\n";
+    return 0;
+}
+
+sub check {
+    my ($cond, $label) = @_;
+    return is($cond ? 1 : 0, 1, $label);
+}
+
+# ---------------------------------------------------------------------------
+# JSON
+# ---------------------------------------------------------------------------
+
+my $decoded = json_decode('{"a":1,"b":[true,false,null],"c":"x\\ny","d":{"e":2.5}}');
+is(ref($decoded), 'HASH', 'json: an object decodes to a hash');
+is($decoded->{a}, 1, 'json: an integer');
+is($decoded->{b}[0], 1, 'json: true is truthy');
+is($decoded->{b}[1], 0, 'json: false is falsey');
+is($decoded->{b}[2], undef, 'json: null is undef');
+is($decoded->{c}, "x\ny", 'json: an escaped newline');
+is($decoded->{d}{e}, 2.5, 'json: a nested float');
+
+my $strings = json_decode('{"s":"a\"b\\\\c\/d\te","u":"\u0041\u00e9"}');
+is($strings->{s}, "a\"b\\c/d\te", 'json: quotes, backslashes, a solidus and a tab');
+is($strings->{u}, "A\xc3\xa9", 'json: a unicode escape becomes UTF-8 bytes');
+
+my $numbers = json_decode('{"i":-12,"f":1e3,"z":0,"n":-0.5}');
+is($numbers->{i}, -12, 'json: a negative integer');
+is($numbers->{f}, 1000, 'json: an exponent');
+is($numbers->{z}, 0, 'json: zero');
+is($numbers->{n}, -0.5, 'json: a negative float');
+
+my $empty = json_decode('[]');
+is(ref($empty), 'ARRAY', 'json: an empty array');
+is(scalar(@$empty), 0, 'json: an empty array has no elements');
+
+my $whitespace = json_decode("  {\n  \"a\" :  1\n}  ");
+is($whitespace->{a}, 1, 'json: whitespace around and inside is skipped');
+
+# Malformed input dies with the offset, so a caller that cannot trust its input wraps
+# the call; the test asserts that contract rather than a sentinel value.
+for my $bad ('', '{', '[1,]', 'nope', '{"a":}') {
+    my $died = eval { json_decode($bad); 1 } ? 0 : 1;
+    is($died, 1, "json: malformed input dies (" . ($bad eq '' ? 'empty' : $bad) . ")");
+}
+my $reason = eval { json_decode('nope'); '' } || $@;
+check($reason =~ /offset 0/, 'json: the death names the offset');
+
+# ---------------------------------------------------------------------------
+# Architecture
+# ---------------------------------------------------------------------------
+
+my $arch = go_arch();
+check(!defined $arch || $arch =~ /^(amd64|arm64)$/,
+    'arch: the machine maps to a Go architecture or to nothing');
+
+my $tmp = "/tmp/workstation-test.$$";
+
+my $sums = "$tmp.sums";
+open(my $fh, '>', $sums) or die "cannot write $sums: $!\n";
+print {$fh} 'a' x 64 . "  ./tool.tar.gz\n";
+print {$fh} 'b' x 64 . "  other.tar.gz\n";
+close($fh);
+is(sha256_from_sums($sums, 'other.tar.gz'), 'b' x 64, 'sums: a name is found in the file');
+is(sha256_from_sums($sums, 'missing.tar.gz'), undef, 'sums: a name that is absent yields nothing');
+is(sha256_from_sums($sums, './tool.tar.gz'), 'a' x 64, 'sums: the name as listed is matched');
+is(sha256_from_sums($sums, 'tool.tar.gz'), undef, 'sums: a name that is listed differently is not matched');
+unlink($sums);
+is(sha256_from_sums("$tmp.nothing", 'x'), undef, 'sums: a missing file yields nothing');
+
+# ---------------------------------------------------------------------------
+# Atomic writes
+# ---------------------------------------------------------------------------
+
+# atomic_write settles the owner, which for a new file is root, so it needs root to
+# run; as an ordinary user the write is refused and the check is skipped rather than
+# pretended.  The container runs exercise the real path.
+my $target = "$tmp.target";
+# The contract is a death on failure and no value on success, which is how every
+# caller uses it: eval { atomic_write(...); 1 }.
+if ($> == 0) {
+    my $written = eval { atomic_write($target, "one\n"); 1 } ? 1 : 0;
+    is($written, 1, 'atomic_write: a new file is written');
+    is(slurp($target), "one\n", 'atomic_write: the content is there');
+    $written = eval { atomic_write($target, "two\n"); 1 } ? 1 : 0;
+    is($written, 1, 'atomic_write: an existing file is replaced');
+    is(slurp($target), "two\n", 'atomic_write: the new content is there');
+    check(!-e "$target.$$" . '.tmp', 'atomic_write: no temporary file is left behind');
+    unlink($target);
+}
+else {
+    my $died = eval { atomic_write($target, "one\n"); 1 } ? 0 : 1;
+    is($died, 1, 'atomic_write: dies when it cannot own the target, as an ordinary user');
+    check(!-e "$target.$$" . '.tmp', 'atomic_write: the temporary file is cleaned up');
+}
+
+# ---------------------------------------------------------------------------
+# Arguments
+# ---------------------------------------------------------------------------
+
+my @saved = @ARGV;
+@ARGV = ('--dry-run', '--skip-rpm', '--skip-go');
+my %args = parse_args();
+is($args{dry_run}, 1, 'args: --dry-run');
+is($args{skip_rpm}, 1, 'args: --skip-rpm');
+is($args{skip_go}, 1, 'args: --skip-go');
+is($args{skip_update}, 0, 'args: an unset skip stays off');
+@ARGV = ();
+my %defaults = parse_args();
+is($defaults{dry_run}, 0, 'args: dry run is off by default');
+@ARGV = @saved;
+
+# ---------------------------------------------------------------------------
+# Command composition for the real user
+# ---------------------------------------------------------------------------
+
+{
+    local $ENV{SUDO_USER};
+    delete $ENV{SUDO_USER};
+    is(join(' ', @{ user_command(['flatpak', 'info', '--user', 'org.example.App']) }),
+        'flatpak info --user org.example.App',
+        'user_command: without SUDO_USER the command itself is the whole list');
+    my $direct = run_as_user(['/bin/echo', 'as-user']);
+    is($direct->{out}, "as-user\n",
+        'run_as_user: without SUDO_USER the command runs directly');
+    $ENV{SUDO_USER} = 'someuser';
+    is(join(' ', @{ user_command(['flatpak', 'uninstall', '-y', 'org.example.App']) }),
+        'sudo -u someuser flatpak uninstall -y org.example.App',
+        'user_command: SUDO_USER becomes a sudo -u prefix before the command');
+    is(join(' ', @{ user_command(['rustup-init', '-y'],
+            { RUSTUP_HOME => '/h', CARGO_HOME => '/c' }) }),
+        'sudo -u someuser env CARGO_HOME=/c RUSTUP_HOME=/h rustup-init -y',
+        'user_command: env assignments come sorted between env(1) and the command');
+}
+
+# ---------------------------------------------------------------------------
+# Runner exit codes
+# ---------------------------------------------------------------------------
+
+is(run(['perl', '-e', 'exit 7'])->{rc}, 7, 'run: an exit code passes through');
+is(run(['perl', '-e', q{kill 9, $$}])->{rc}, 137,
+    'run: a child killed by a signal reports 128+signal, not success');
+
+# ---------------------------------------------------------------------------
+# Repo gpgkey pinning
+# ---------------------------------------------------------------------------
+
+my $repo_file = "$tmp.repo";
+my $key_file = "$tmp.key";
+open(my $key_out, '>', $key_file) or die "cannot write $key_file: $!\n";
+print {$key_out} "verified key material\n";
+close($key_out);
+open(my $repo_out, '>', $repo_file) or die "cannot write $repo_file: $!\n";
+print {$repo_out} "[brave-browser]\nbaseurl=https://example.com/brave/x86_64/\n"
+    . "\ngpgkey=https://example.com/brave-core.asc\nenabled=1\n";
+close($repo_out);
+is(pin_brave_repo_gpgkey($repo_file, $key_file), 1,
+    'pin: a URL gpgkey is pinned to the local key file');
+my $pinned_content = slurp($repo_file);
+check(index($pinned_content, "gpgkey=file://$key_file") >= 0,
+    'pin: the gpgkey line points at the key file');
+check(index($pinned_content, 'baseurl=https://example.com/brave/x86_64/') >= 0,
+    'pin: the untouched lines survive the rewrite');
+check($pinned_content =~ /\n\n/, 'pin: a blank line survives the rewrite');
+is(pin_brave_repo_gpgkey($repo_file, $key_file), 1,
+    'pin: an already pinned file is left as it is');
+unlink($repo_file);
+is(pin_brave_repo_gpgkey($repo_file, $key_file), 0,
+    'pin: a missing repo file fails without dying');
+unlink($key_file);
+
+# ---------------------------------------------------------------------------
+# JetBrains launcher links
+# ---------------------------------------------------------------------------
+
+my $ide_home = "$tmp.ide";
+my $ide_bin = "$ide_home/bin";
+my $ide_desktop = "$ide_home/applications";
+make_dirs($ide_bin) or die "cannot create $ide_bin\n";
+for my $dir ("$ide_home/GoLand-2026.1", "$ide_home/GoLand-2026.2") {
+    make_dirs("$dir/bin") or die "cannot create $dir/bin\n";
+    my $launcher = "$dir/bin/goland.sh";
+    open(my $launch_out, '>', $launcher) or die "cannot write $launcher: $!\n";
+    close($launch_out);
+    chmod(0755, $launcher);
+}
+is(jetbrains_links('GoLand', "$ide_home/GoLand-2026.1", $ide_bin, $ide_desktop), 1,
+    'ide links: an install with a launcher gets its links');
+is(readlink("$ide_bin/goland") // '', "$ide_home/GoLand-2026.1/bin/goland.sh",
+    'ide links: the symlink points at the launcher');
+is(jetbrains_links('GoLand', "$ide_home/GoLand-2026.2", $ide_bin, $ide_desktop), 1,
+    'ide links: a newer install repoints the symlink');
+is(readlink("$ide_bin/goland") // '', "$ide_home/GoLand-2026.2/bin/goland.sh",
+    'ide links: the symlink follows the newer launcher');
+is(jetbrains_links('GoLand', "$ide_home/GoLand-0.0.0", $ide_bin, $ide_desktop), 0,
+    'ide links: a missing launcher fails the links');
+if ($> == 0) {
+    my $entry = slurp("$ide_desktop/jetbrains-goland.desktop");
+    check(index($entry, "Exec=\"$ide_home/GoLand-2026.2/bin/goland.sh\"") >= 0,
+        'ide links: the menu entry names the launcher');
+}
+remove_tree($ide_home);
+
+# ---------------------------------------------------------------------------
+# Supported systems
+# ---------------------------------------------------------------------------
+
+# The supported set is a lexical in the script, so its contract is checked
+# through the usage text the set builds: Fedora advertised, nothing else.
+check(index(usage(), 'workstation setup for Fedora') >= 0 && index(usage(), 'openEuler') < 0,
+    'usage: only Fedora is advertised');
+
+print "\n" . ($failed ? "$failed FAILED of " . ($passed + $failed) : "all $passed checks passed") . "\n";
+exit($failed ? 1 : 0);
diff --git a/workstation-setup.pl b/workstation-setup.pl
new file mode 100644
index 0000000..182935d
--- /dev/null
+++ b/workstation-setup.pl
@@ -0,0 +1,2394 @@
+#!/usr/bin/env perl
+# Copyright (c) 2026 Petr Balvín <opensource@petrbalvin.org> (https://petrbalvin.org)
+# SPDX-License-Identifier: MIT
+
+# Idempotent workstation setup for Fedora: development tools, editors
+# and multimedia.
+#
+# Every operation checks the current state before acting, so running the script
+# again produces the same result with no errors and no repeated work.
+#
+# Supply-chain posture:
+# - Go: the latest stable tarball from go.dev, SHA-256 verified against the
+#   checksum published in go.dev's official download API.
+# - JetBrains IDEs: the latest release tarballs from download.jetbrains.com,
+#   SHA-256 verified against the release's published checksum.
+# - Brave: the repo signing key is fingerprint-verified against the official
+#   fingerprints from https://brave.com/signing-keys/ before rpm --import.
+#
+# Perl builtins only: no module has to be installed.  Three pieces of work Perl
+# does not carry as builtins are written out here:
+#
+#   * the command runners, which fork and keep stdout and stderr apart in the
+#     scratch directory;
+#   * a JSON decoder, for the go.dev download API and the JetBrains releases API;
+#   * SHA-256, which has no builtin and is therefore read from sha256sum.  The
+#     digest is the same either way; only the transport differs.
+#
+# External binaries used: dnf, rpm, curl, tar, sha256sum, gpg, flatpak, systemctl,
+# getenforce, setenforce, sudo, sync, rm and uname.
+#
+# Usage:
+#     workstation-setup.pl                    # full setup
+#     workstation-setup.pl --dry-run          # preview without changes
+#     workstation-setup.pl --skip-update      # skip system update
+#     workstation-setup.pl --skip-rpm         # skip RPM package installation
+#     workstation-setup.pl --skip-flatpak     # skip Flatpak apps
+#     workstation-setup.pl --skip-repos       # skip adding third-party repos
+#     workstation-setup.pl --skip-remove      # skip removing pre-installed apps
+#     workstation-setup.pl --skip-go          # skip Go toolchain
+#     workstation-setup.pl --skip-rust        # skip Rust toolchain
+#     workstation-setup.pl --skip-jetbrains   # skip JetBrains IDE installation
+#     workstation-setup.pl --skip-firewall    # skip firewall setup
+#     workstation-setup.pl --skip-selinux     # skip SELinux setup
+#     workstation-setup.pl --version
+
+use strict;
+use warnings;
+
+my $VERSION = '2.0.0';
+
+my $BOLD   = "\033[1m";
+my $RED    = "\033[31m";
+my $GREEN  = "\033[32m";
+my $YELLOW = "\033[33m";
+my $DIM    = "\033[2m";
+my $RESET  = "\033[0m";
+
+# dnf transactions, and a fresh install downloading hundreds of packages, need far
+# more than a generic 60-second timeout.
+my $DNF_TIMEOUT        = 1800;
+my $DNF_UPDATE_TIMEOUT = 3600;
+
+# Go comes from the official go.dev tarball, not the Fedora RPM, which lags behind.
+# The download API returns the latest stable release with per-file SHA-256 sums.
+my $GO_DL_API_URL       = 'https://go.dev/dl/?mode=json';
+my $GO_TARBALL_BASE_URL = 'https://go.dev/dl/';
+my $GO_INSTALL_DIR      = '/usr/local/go';
+my @GO_BASHRC_LINES     = ('export PATH="/usr/local/go/bin:$PATH"');
+
+# JetBrains IDEs come from the latest release tarball, resolved through the official
+# releases API, installed system-wide under /opt with a launcher and a menu entry.
+my $JETBRAINS_RELEASES_URL  = 'https://data.services.jetbrains.com/products/releases';
+my $JETBRAINS_INSTALL_ROOT  = '/opt';
+my $JETBRAINS_BIN_DIR       = '/usr/local/bin';
+my $JETBRAINS_DESKTOP_DIR   = '/usr/local/share/applications';
+
+# The IDE set, in the order the sections report them.
+my @JETBRAINS_ORDER = ('GO');
+my %JETBRAINS_IDES = (
+    GO => 'GoLand',
+);
+
+my $BRAVE_REPO_URL  = 'https://brave-browser-rpm-release.s3.brave.com/brave-browser.repo';
+my $BRAVE_KEY_URL   = 'https://brave-browser-rpm-release.s3.brave.com/brave-core.asc';
+my $BRAVE_REPO_FILE = '/etc/yum.repos.d/brave-browser.repo';
+my $BRAVE_KEY_FILE  = '/etc/pki/rpm-gpg/RPM-GPG-KEY-brave-browser';
+
+# Primary-key fingerprints of the official Brave "Linux Package Repositories, Release
+# Channel" keys, from https://brave.com/signing-keys/ (the 2023 key plus the 2025
+# rotations).  If Brave rotates again, verification fails loudly: update this set
+# from the same page rather than weakening the check.
+my %BRAVE_KEY_FINGERPRINTS = map { $_ => 1 } (
+    'DBF1A116C220B8C7164F98230686B78420038257',   # Brave Linux Release (2023)
+    '47D32A74E9A9E013A4B4926C68D513D36A73CD96',   # Brave Linux Release (2025, _mrk)
+    'B2A3DCA350E67256740DF904DE4EC67BE4B0DCA0',   # Brave Linux Release (2025, _v2)
+);
+
+# Supported systems, in the order the messages list them.  The workstation is a
+# Fedora desktop; the server-facing scripts are the ones that carry the other
+# systems.
+my @SUPPORTED_ORDER = ('fedora');
+my %SUPPORTED_OS = (
+    fedora => 'Fedora',
+);
+
+# Pre-installed packages to remove, skipped when already absent.
+my @REMOVE_PACKAGES = qw(firefox gnome-system-monitor yelp mediawriter);
+
+# RPM packages to install.  Go is deliberately absent: the toolchain comes from the
+# official go.dev tarball instead.
+my @RPM_PACKAGES = qw(brave-browser git rustup just);
+
+# Flatpak applications to install.
+my @FLATPAK_APPS = qw(
+    org.remmina.Remmina org.telegram.desktop fr.handbrake.ghb com.rustdesk.RustDesk
+    org.gimp.GIMP net.mediaarea.MediaInfo net.nokyan.Resources app.drey.EarTag
+    org.bunkus.mkvtoolnix-gui org.fedoraproject.MediaWriter org.gnome.Firmware
+);
+
+# RPM counterparts of the Flatpak apps we install: when such an RPM is present it is
+# removed first, so each application has a single source of truth.  Apps without an
+# official Fedora RPM counterpart (net.nokyan.Resources, app.drey.EarTag) are absent
+# on purpose.
+my @FLATPAK_RPM_ORDER = qw(
+    org.remmina.Remmina org.telegram.desktop fr.handbrake.ghb com.rustdesk.RustDesk
+    org.gimp.GIMP net.mediaarea.MediaInfo org.bunkus.mkvtoolnix-gui
+    org.fedoraproject.MediaWriter org.gnome.Firmware
+);
+my %FLATPAK_RPM_ALTERNATIVES = (
+    'org.remmina.Remmina'          => 'remmina',
+    'org.telegram.desktop'         => 'telegram-desktop',
+    'fr.handbrake.ghb'             => 'HandBrake-gui',
+    'com.rustdesk.RustDesk'        => 'rustdesk',
+    'org.gimp.GIMP'                => 'gimp',
+    'net.mediaarea.MediaInfo'      => 'mediainfo',
+    'org.bunkus.mkvtoolnix-gui'    => 'mkvtoolnix-gui',
+    'org.fedoraproject.MediaWriter' => 'mediawriter',
+    'org.gnome.Firmware'           => 'gnome-firmware',
+);
+
+# Flatpak counterparts of the RPM packages we install: uninstalled first.
+my %RPM_FLATPAK_ALTERNATIVES = (
+    'brave-browser' => 'com.brave.Browser',
+);
+
+# The optional clock, loaded once and guarded where it is used.
+my $HAVE_HIRES = eval { require Time::HiRes; 1 } ? 1 : 0;
+
+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;
+}
+
+sub _info {
+    my ($msg) = @_;
+    print STDERR "  ${DIM}$msg$RESET\n";
+    return;
+}
+
+sub _warn {
+    my ($msg) = @_;
+    print STDERR "  ${YELLOW}⚠ $msg$RESET\n";
+    return;
+}
+
+sub _ok {
+    my ($msg) = @_;
+    print STDERR "  ${GREEN}✓ $msg$RESET\n";
+    return;
+}
+
+sub _fail {
+    my ($msg) = @_;
+    print STDERR "  ${RED}✗ $msg$RESET\n";
+    return;
+}
+
+# ---------------------------------------------------------------------------
+# Commands, files and small helpers
+# ---------------------------------------------------------------------------
+
+sub now {
+    return $HAVE_HIRES ? Time::HiRes::time() : time();
+}
+
+# A hand-rolled which(1), so that the lookup itself needs no external binary.
+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/workstation-setup.$$" . ($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;
+    # Only the process that created the directory may remove it: a forked child
+    # inherits the END block.
+    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 parsing.  A timeout, a missing binary
+# and a failed exec become rc 124, 127 and 126 rather than exceptions, so callers
+# always have a result to inspect.  With use_sudo the command is run through sudo.
+sub run {
+    my ($cmd, %opt) = @_;
+    my $timeout = $opt{timeout} // 60;
+    my @full = $opt{use_sudo} ? ('sudo', @$cmd) : @$cmd;
+
+    my $exe = find_exe($full[0]);
+    return { rc => 127, out => '', err => "command not found: $full[0]" } 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 } @full;
+        }
+        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 {
+        # A child killed by a signal must not look like success: $? >> 8 is 0
+        # for a signalled exit, so the signal becomes a shell-style 128+n code.
+        my $signal = $? & 127;
+        $rc = $signal ? 128 + $signal : ($? >> 8);
+    }
+
+    my $out = slurp($out_file);
+    my $err = slurp($err_file);
+    unlink($out_file, $err_file);
+    return {
+        rc  => $rc,
+        out => $out,
+        err => $timed_out ? "timed out after ${timeout}s" : $err,
+    };
+}
+
+# The command list that reaches the target command as the real user: the sudo
+# prefix with optional env(1) assignments, then the command itself as one flat
+# list.  Building the list separately is what keeps the command's arguments out
+# of the runner's option hash.
+sub user_command {
+    my ($cmd, $env) = @_;
+    my $sudo_user = $ENV{SUDO_USER} // '';
+    return [@$cmd] unless length $sudo_user;
+    my @full = ('sudo', '-u', $sudo_user);
+    if ($env && %$env) {
+        push @full, 'env', map { "$_=$env->{$_}" } sort keys %$env;
+    }
+    push @full, @$cmd;
+    return \@full;
+}
+
+# Run a command as the original user rather than as root, when the script was
+# started through sudo.  Extra environment variables go through env(1) so they
+# survive sudo's environment reset.
+sub run_as_user {
+    my ($cmd, %opt) = @_;
+    return run(user_command($cmd, $opt{env}), timeout => $opt{timeout} // 60);
+}
+
+# ---------------------------------------------------------------------------
+# OS detection
+# ---------------------------------------------------------------------------
+
+sub parse_os_release {
+    my %release;
+    open(my $fh, '<', '/etc/os-release') or return \%release;
+    while (my $line = <$fh>) {
+        $line =~ s/^\s+//;
+        $line =~ s/\s+$//;
+        next unless length $line;
+        next if index($line, '#') == 0;
+        next unless index($line, '=') >= 0;
+        my ($key, $value) = split /=/, $line, 2;
+        $value = '' unless defined $value;
+        for my $quote ('"', "'") {
+            $value =~ s/^\Q$quote\E+//;
+            $value =~ s/\Q$quote\E+$//;
+        }
+        $release{$key} = $value;
+    }
+    close($fh);
+    return \%release;
+}
+
+sub detect_os {
+    my $release = parse_os_release();
+    my $os_id = lc($release->{ID} // '');
+    my $version_id = $release->{VERSION_ID} // 'unknown';
+
+    if (!exists $SUPPORTED_OS{$os_id}) {
+        print STDERR "${RED}${BOLD}Error:$RESET Unsupported operating system: "
+            . "'" . ($release->{ID} // 'unknown') . "' (detected from /etc/os-release).\n";
+        print STDERR "  Supported systems: "
+            . join(', ', map { $SUPPORTED_OS{$_} } @SUPPORTED_ORDER) . "\n";
+        exit 1;
+    }
+    return ($os_id, $SUPPORTED_OS{$os_id}, $version_id);
+}
+
+# ---------------------------------------------------------------------------
+# Section helpers
+# ---------------------------------------------------------------------------
+
+sub rpm_installed {
+    my ($pkg) = @_;
+    return run(['rpm', '-q', $pkg])->{rc} == 0;
+}
+
+sub have_flatpak {
+    my ($app) = @_;
+    return run(['flatpak', 'info', $app])->{rc} == 0;
+}
+
+sub flatpak_scopes {
+    my ($app) = @_;
+    my @found;
+    push @found, 'system' if run(['flatpak', 'info', $app])->{rc} == 0;
+    push @found, 'user' if run_as_user(['flatpak', 'info', '--user', $app])->{rc} == 0;
+    return @found;
+}
+
+sub remove_conflicting_rpm {
+    my ($app, $dry_run) = @_;
+    my $rpm_name = $FLATPAK_RPM_ALTERNATIVES{$app};
+    return undef unless defined $rpm_name;
+    return undef unless rpm_installed($rpm_name);
+    _warn("$app: also installed as RPM '$rpm_name', removing it to avoid a duplicate");
+    if ($dry_run) {
+        _info("Would remove RPM package: $rpm_name");
+        return $rpm_name;
+    }
+    my $result = run(['dnf', 'remove', '-y', $rpm_name], timeout => $DNF_TIMEOUT, use_sudo => 1);
+    if ($result->{rc} == 0) {
+        _ok("Removed RPM package: $rpm_name");
+        return $rpm_name;
+    }
+    _fail("Failed to remove RPM package $rpm_name");
+    return undef;
+}
+
+sub remove_conflicting_flatpak {
+    my ($pkg, $dry_run) = @_;
+    my $app_id = $RPM_FLATPAK_ALTERNATIVES{$pkg};
+    return undef unless defined $app_id;
+    my $removed = 0;
+    for my $scope (flatpak_scopes($app_id)) {
+        _warn("$pkg: also installed as Flatpak '$app_id' ($scope), removing it to avoid a duplicate");
+        if ($dry_run) {
+            _info("Would uninstall Flatpak app: $app_id ($scope)");
+            $removed = 1;
+            next;
+        }
+        my $result = $scope eq 'user'
+            ? run_as_user(['flatpak', 'uninstall', '-y', '--user', $app_id], timeout => 300)
+            : run(['flatpak', 'uninstall', '-y', $app_id], timeout => 300, use_sudo => 1);
+        if ($result->{rc} == 0) {
+            _ok("Uninstalled Flatpak app: $app_id ($scope)");
+            $removed = 1;
+        }
+        else {
+            _fail("Failed to uninstall Flatpak app $app_id ($scope)");
+        }
+    }
+    return $removed ? $app_id : undef;
+}
+
+# The passwd entry of the real, non-root user: nothing to drop to means the script
+# runs in a real root shell, or SUDO_USER does not resolve.
+sub real_user {
+    my $sudo_user = $ENV{SUDO_USER} // '';
+    if (length $sudo_user) {
+        my ($name, $passwd, $uid, $gid, $quota, $comment, $gcos, $dir) = getpwnam($sudo_user);
+        return undef unless defined $uid;
+        return { name => $name, uid => $uid, gid => $gid, dir => $dir };
+    }
+    return undef if $> == 0;
+    my ($name, $passwd, $uid, $gid, $quota, $comment, $gcos, $dir) = getpwuid($>);
+    return undef unless defined $uid;
+    return { name => $name, uid => $uid, gid => $gid, dir => $dir };
+}
+
+# The errno, the reason and the path, so a failure message names all three.
+sub os_error_text {
+    my ($path) = @_;
+    return "[Errno " . (0 + $!) . "] $!: '$path'";
+}
+
+sub fsync_path {
+    my ($path) = @_;
+    my $sync = find_exe('sync');
+    return unless defined $sync;
+    system { $sync } $sync, $path;
+    return;
+}
+
+# Replace a file with new content, preserving its mode and owner.
+#
+# /etc/selinux/config must never be left truncated by a crash mid-write: the content
+# goes into a temporary file beside the target, which is then renamed over it.  Perl's
+# builtins expose no fsync, so that barrier is delegated to sync(1) where it exists.
+sub atomic_write {
+    my ($path, $content) = @_;
+    my ($mode, $uid, $gid) = (0644, 0, 0);
+    my @st = stat($path);
+    if (@st) {
+        $mode = $st[2] & 07777;
+        $uid  = $st[4];
+        $gid  = $st[5];
+    }
+    my $tmp = "$path.$$.tmp";
+    my $ok = eval {
+        open(my $fh, '>', $tmp) or die os_error_text($tmp) . "\n";
+        print {$fh} $content or die os_error_text($tmp) . "\n";
+        close($fh) or die os_error_text($tmp) . "\n";
+        fsync_path($tmp);
+        chmod($mode, $tmp) or die os_error_text($tmp) . "\n";
+        chown($uid, $gid, $tmp) or die os_error_text($tmp) . "\n";
+        rename($tmp, $path) or die "[Errno " . (0 + $!) . "] $!: '$tmp' -> '$path'\n";
+        1;
+    };
+    if (!$ok) {
+        my $error = $@ || 'unknown error';
+        unlink($tmp);
+        die $error;
+    }
+    return;
+}
+
+sub real_home {
+    my $real = real_user();
+    return $real->{dir} if $real;
+    my $home = $ENV{HOME} // '';
+    return length $home ? $home : '/root';
+}
+
+sub chown_user {
+    my ($path) = @_;
+    my $real = real_user();
+    return unless $real;
+    chown($real->{uid}, $real->{gid}, $path);
+    return;
+}
+
+# Absolute path to a tool: PATH first, then the user's home locations.
+sub tool_path {
+    my ($name, @home_rel) = @_;
+    my $found = find_exe($name);
+    return $found if defined $found;
+    my $home = real_home();
+    for my $rel (@home_rel) {
+        my $candidate = "$home/$rel";
+        return $candidate if -f $candidate && -x _;
+    }
+    return undef;
+}
+
+sub probe_version {
+    my ($cmd, %opt) = @_;
+    my $as_user = exists $opt{as_user} ? $opt{as_user} : 1;
+    my $result = $as_user ? run_as_user($cmd) : run($cmd);
+    return 'unknown' if $result->{rc} != 0;
+    my $out = $result->{out};
+    $out =~ s/^\s+//;
+    $out =~ s/\s+$//;
+    return 'unknown' unless length $out;
+    my ($first) = split /\n/, $out;
+    return $first;
+}
+
+sub download {
+    my ($url, $dest, %opt) = @_;
+    my $timeout = $opt{timeout} // 300;
+    return run(['curl', '-fsSL', '-o', $dest, $url], timeout => $timeout, use_sudo => 1)->{rc} == 0;
+}
+
+# The SHA-256 digest of a file.  Builtins have none, so sha256sum is the transport and
+# the digest is compared exactly as before.
+sub sha256_file {
+    my ($path) = @_;
+    my $result = run(['sha256sum', '--', $path], timeout => 900);
+    return '' if $result->{rc} != 0;
+    my @fields = split ' ', $result->{out};
+    return @fields ? lc $fields[0] : '';
+}
+
+sub sha256_from_sums {
+    my ($sums_file, $filename) = @_;
+    open(my $fh, '<', $sums_file) or return undef;
+    while (my $line = <$fh>) {
+        my @parts = split ' ', $line;
+        next unless @parts == 2;
+        my $name = $parts[1];
+        $name =~ s/^\*//;
+        $name =~ s/\s+$//;
+        if ($name eq $filename) {
+            close($fh);
+            return lc $parts[0];
+        }
+    }
+    close($fh);
+    return undef;
+}
+
+# Fingerprints of the primary keys in an ASCII-armoured key file, through gpg.  Only
+# the fpr record that directly follows a pub record counts: subkey fingerprints are
+# ignored, so the result compares against a set of primary keys.
+sub asc_fingerprints {
+    my ($key_file) = @_;
+    return () unless defined find_exe('gpg');
+    my $result = run(['gpg', '--show-keys', '--with-colons', $key_file]);
+    return () unless $result->{rc} == 0;
+    my (@fingerprints, $last_record);
+    for my $line (split /\n/, $result->{out}) {
+        my @parts = split /:/, $line, -1;
+        next if @parts < 10;
+        if ($parts[0] eq 'pub' || $parts[0] eq 'sub') {
+            $last_record = $parts[0];
+        }
+        elsif ($parts[0] eq 'fpr' && ($last_record // '') eq 'pub' && length $parts[9]) {
+            push @fingerprints, uc $parts[9];
+        }
+    }
+    return @fingerprints;
+}
+
+# Copy a file with builtins, replacing the destination.
+sub copy_file {
+    my ($from, $to) = @_;
+    my $content = slurp($from);
+    my $ok = eval {
+        open(my $fh, '>', $to) or die os_error_text($to) . "\n";
+        print {$fh} $content or die os_error_text($to) . "\n";
+        close($fh) or die os_error_text($to) . "\n";
+        1;
+    };
+    die $@ unless $ok;
+    return;
+}
+
+# A directory removed with everything under it.
+sub remove_tree {
+    my ($path) = @_;
+    return unless -d $path;
+    if (opendir(my $dh, $path)) {
+        for my $entry (readdir($dh)) {
+            next if $entry eq '.' || $entry eq '..';
+            my $full = "$path/$entry";
+            if (-l $full) { unlink($full) }
+            elsif (-d $full) { remove_tree($full) }
+            else { unlink($full) }
+        }
+        closedir($dh);
+    }
+    rmdir($path);
+    return;
+}
+
+sub make_dirs {
+    my ($path, $mode) = @_;
+    $mode = 0755 unless defined $mode;
+    my @parts = split m{/}, $path;
+    my $current = '';
+    for my $part (@parts) {
+        next unless length $part;
+        $current .= "/$part";
+        next if -d $current;
+        mkdir($current, $mode) or return 0;
+    }
+    return 1;
+}
+
+# A temporary directory removed when the block ends, wherever it lives.
+sub make_temp_dir {
+    my (%opt) = @_;
+    my $base = $opt{dir} // ($ENV{TMPDIR} // '/tmp');
+    my $prefix = $opt{prefix} // 'workstation-setup-';
+    for my $attempt (0 .. 9) {
+        my $dir = "$base/${prefix}$$.$attempt";
+        return $dir if mkdir($dir, 0700);
+    }
+    return undef;
+}
+
+# ---------------------------------------------------------------------------
+# JSON, written by hand
+# ---------------------------------------------------------------------------
+#
+# The go.dev download API and the JetBrains releases API both answer in JSON, and no
+# JSON module may be assumed.  The decoder covers the grammar the format allows.
+
+sub json_decode {
+    my ($text) = @_;
+    $text = '' unless defined $text;
+    my $pos = 0;
+    my $value = json_parse_value($text, \$pos);
+    json_skip_space($text, \$pos);
+    die "trailing data at offset $pos\n" if $pos < length $text;
+    return $value;
+}
+
+sub json_skip_space {
+    my ($text, $pos_ref) = @_;
+    my $length = length $text;
+    while ($$pos_ref < $length && substr($text, $$pos_ref, 1) =~ /[ \t\r\n]/) {
+        $$pos_ref++;
+    }
+    return;
+}
+
+sub json_parse_value {
+    my ($text, $pos_ref) = @_;
+    json_skip_space($text, $pos_ref);
+    die "unexpected end of input at offset $$pos_ref\n" if $$pos_ref >= length $text;
+    my $char = substr($text, $$pos_ref, 1);
+    return json_parse_object($text, $pos_ref) if $char eq '{';
+    return json_parse_array($text, $pos_ref)  if $char eq '[';
+    return json_parse_string($text, $pos_ref) if $char eq '"';
+    return json_parse_number($text, $pos_ref) if $char =~ /[-0-9]/;
+    for my $literal (['true', 1], ['false', 0], ['null', undef]) {
+        my ($word, $value) = @$literal;
+        if (substr($text, $$pos_ref, length $word) eq $word) {
+            $$pos_ref += length $word;
+            return $value;
+        }
+    }
+    die "unrecognised token at offset $$pos_ref\n";
+}
+
+sub json_parse_object {
+    my ($text, $pos_ref) = @_;
+    my %object;
+    $$pos_ref++;
+    json_skip_space($text, $pos_ref);
+    if (substr($text, $$pos_ref, 1) eq '}') {
+        $$pos_ref++;
+        return \%object;
+    }
+    while (1) {
+        json_skip_space($text, $pos_ref);
+        die "expected a key at offset $$pos_ref\n" unless substr($text, $$pos_ref, 1) eq '"';
+        my $key = json_parse_string($text, $pos_ref);
+        json_skip_space($text, $pos_ref);
+        die "expected a colon at offset $$pos_ref\n" unless substr($text, $$pos_ref, 1) eq ':';
+        $$pos_ref++;
+        $object{$key} = json_parse_value($text, $pos_ref);
+        json_skip_space($text, $pos_ref);
+        my $next = substr($text, $$pos_ref, 1);
+        if ($next eq ',') { $$pos_ref++; next }
+        if ($next eq '}') { $$pos_ref++; last }
+        die "expected a comma or a closing brace at offset $$pos_ref\n";
+    }
+    return \%object;
+}
+
+sub json_parse_array {
+    my ($text, $pos_ref) = @_;
+    my @items;
+    $$pos_ref++;
+    json_skip_space($text, $pos_ref);
+    if (substr($text, $$pos_ref, 1) eq ']') {
+        $$pos_ref++;
+        return \@items;
+    }
+    while (1) {
+        push @items, json_parse_value($text, $pos_ref);
+        json_skip_space($text, $pos_ref);
+        my $next = substr($text, $$pos_ref, 1);
+        if ($next eq ',') { $$pos_ref++; next }
+        if ($next eq ']') { $$pos_ref++; last }
+        die "expected a comma or a closing bracket at offset $$pos_ref\n";
+    }
+    return \@items;
+}
+
+sub json_parse_string {
+    my ($text, $pos_ref) = @_;
+    $$pos_ref++;
+    my $out = '';
+    my $length = length $text;
+    my %simple = ('"' => '"', '\\' => '\\', '/' => '/', 'b' => "\b", 'f' => "\f",
+                  'n' => "\n", 'r' => "\r", 't' => "\t");
+    while ($$pos_ref < $length) {
+        my $char = substr($text, $$pos_ref, 1);
+        if ($char eq '"') {
+            $$pos_ref++;
+            return $out;
+        }
+        if ($char ne '\\') {
+            $out .= $char;
+            $$pos_ref++;
+            next;
+        }
+        $$pos_ref++;
+        my $escape = substr($text, $$pos_ref, 1);
+        if (exists $simple{$escape}) {
+            $out .= $simple{$escape};
+            $$pos_ref++;
+            next;
+        }
+        die "unrecognised escape at offset $$pos_ref\n" unless $escape eq 'u';
+        my $hex = substr($text, $$pos_ref + 1, 4);
+        die "malformed \\u escape at offset $$pos_ref\n" unless $hex =~ /^[0-9a-fA-F]{4}$/;
+        my $code = hex $hex;
+        $$pos_ref += 5;
+        if ($code >= 0xd800 && $code <= 0xdbff && substr($text, $$pos_ref, 2) eq '\\u') {
+            my $low_hex = substr($text, $$pos_ref + 2, 4);
+            if ($low_hex =~ /^[0-9a-fA-F]{4}$/) {
+                my $low = hex $low_hex;
+                if ($low >= 0xdc00 && $low <= 0xdfff) {
+                    $code = 0x10000 + (($code - 0xd800) << 10) + ($low - 0xdc00);
+                    $$pos_ref += 6;
+                }
+            }
+        }
+        my $bytes = pack('U', $code);
+        utf8::encode($bytes);
+        $out .= $bytes;
+    }
+    die "unterminated string\n";
+}
+
+sub json_parse_number {
+    my ($text, $pos_ref) = @_;
+    my $length = length $text;
+    my $start = $$pos_ref;
+    $$pos_ref++ if substr($text, $$pos_ref, 1) eq '-';
+    $$pos_ref++ while $$pos_ref < $length && substr($text, $$pos_ref, 1) =~ /[0-9]/;
+    if ($$pos_ref < $length && substr($text, $$pos_ref, 1) eq '.') {
+        $$pos_ref++;
+        $$pos_ref++ while $$pos_ref < $length && substr($text, $$pos_ref, 1) =~ /[0-9]/;
+    }
+    if ($$pos_ref < $length && substr($text, $$pos_ref, 1) =~ /[eE]/) {
+        $$pos_ref++;
+        $$pos_ref++ if substr($text, $$pos_ref, 1) =~ /[-+]/;
+        $$pos_ref++ while $$pos_ref < $length && substr($text, $$pos_ref, 1) =~ /[0-9]/;
+    }
+    my $literal = substr($text, $start, $$pos_ref - $start);
+    unless ($literal =~ /^-?(?:0|[1-9][0-9]*)(?:\.[0-9]+)?(?:[eE][-+]?[0-9]+)?$/) {
+        die "malformed number at offset $start\n";
+    }
+    return $literal + 0;
+}
+
+# ---------------------------------------------------------------------------
+# 1. System update
+# ---------------------------------------------------------------------------
+
+sub system_update {
+    my ($dry_run) = @_;
+    my %info = (updated => 0, skipped => 0, would_update => 0, error => 0);
+
+    _status('Checking for system updates');
+    my $check_result = run(['dnf', 'check-update'], timeout => 300, use_sudo => 1);
+    # dnf check-update: 0 means no updates, 100 means updates are available, anything
+    # else is an error.
+    if ($check_result->{rc} == 0) {
+        _status_done('already up to date');
+        $info{skipped} = 1;
+        return \%info;
+    }
+    if ($check_result->{rc} != 100) {
+        _status_done('check failed');
+        my $error = $check_result->{err};
+        $error =~ s/^\s+//;
+        $error =~ s/\s+$//;
+        $error = 'unknown error' unless length $error;
+        _fail("dnf check-update failed: $error");
+        $info{error} = 1;
+        return \%info;
+    }
+
+    _status_done('updates available');
+
+    if ($dry_run) {
+        _info('Would run: dnf update -y');
+        $info{would_update} = 1;
+        return \%info;
+    }
+
+    _status('Applying system updates');
+    my $update_result = run(['dnf', 'update', '-y'], timeout => $DNF_UPDATE_TIMEOUT, use_sudo => 1);
+    if ($update_result->{rc} == 0) {
+        _status_done();
+        $info{updated} = 1;
+    }
+    else {
+        _status_done('failed');
+        _fail('System update returned non-zero exit code');
+        $info{error} = 1;
+    }
+    return \%info;
+}
+
+# ---------------------------------------------------------------------------
+# 2. Remove pre-installed apps
+# ---------------------------------------------------------------------------
+
+sub remove_packages {
+    my ($dry_run) = @_;
+    my (@removed, @skipped);
+
+    for my $pkg (@REMOVE_PACKAGES) {
+        _status("Checking $pkg");
+        if (!rpm_installed($pkg)) {
+            _status_done('not installed, skipping');
+            push @skipped, $pkg;
+            next;
+        }
+        if ($dry_run) {
+            _status_done('would remove');
+            push @removed, $pkg;
+            next;
+        }
+        my $result = run(['dnf', 'remove', '-y', $pkg], timeout => $DNF_TIMEOUT, use_sudo => 1);
+        if ($result->{rc} == 0) {
+            _status_done('removed');
+            push @removed, $pkg;
+        }
+        else {
+            _status_done('failed');
+            _fail("Failed to remove $pkg");
+        }
+    }
+
+    return { removed => \@removed, skipped => \@skipped };
+}
+
+# ---------------------------------------------------------------------------
+# 3. Third-party RPM repos
+# ---------------------------------------------------------------------------
+
+# Download the Brave signing key, verify its fingerprints, import it, and keep the
+# verified bytes beside the repo file.
+sub do_import_brave_key {
+    if (!defined find_exe('gpg')) {
+        _fail('gpg not found, cannot verify the Brave signing key');
+        return 0;
+    }
+    my $tmp = make_temp_dir();
+    return 0 unless defined $tmp;
+    my $key_file = "$tmp/brave-core.asc";
+    my $failed = 0;
+
+    if (!download($BRAVE_KEY_URL, $key_file, timeout => 60)) {
+        _fail('Failed to download the Brave signing key');
+        $failed = 1;
+    }
+
+    my @fingerprints = $failed ? () : asc_fingerprints($key_file);
+    if (!$failed && !@fingerprints) {
+        _fail('No keys found in the downloaded Brave key file');
+        $failed = 1;
+    }
+    # Every fingerprint in the file has to be one of the published keys.
+    my @unknown = grep { !$BRAVE_KEY_FINGERPRINTS{$_} } @fingerprints;
+    if (!$failed && @unknown) {
+        my @expected = sort keys %BRAVE_KEY_FINGERPRINTS;
+        _fail('Brave signing key fingerprint mismatch, expected one of: '
+            . join(', ', @expected) . '; got: ' . join(', ', sort @fingerprints));
+        $failed = 1;
+    }
+
+    if (!$failed) {
+        _ok('Brave signing key fingerprint verified');
+        # Persist the verified bytes: the repo file's gpgkey= is pinned to this local
+        # copy, so dnf can only import exactly these keys.
+        my $key_dir = $BRAVE_KEY_FILE;
+        $key_dir =~ s{/[^/]+$}{};
+        if (make_dirs($key_dir)) {
+            my $copied = eval { copy_file($key_file, $BRAVE_KEY_FILE); 1 };
+            if ($copied) {
+                chmod(0644, $BRAVE_KEY_FILE);
+            }
+            else {
+                my $error = $@;
+                $error =~ s/\s+\z//;
+                # A half-written copy must not become the pinned gpgkey= target.
+                unlink($BRAVE_KEY_FILE);
+                _warn("Could not store the verified key at $BRAVE_KEY_FILE: $error");
+            }
+        }
+        my $import = run(['rpm', '--import', $key_file], use_sudo => 1);
+        if ($import->{rc} != 0) {
+            _fail('rpm --import failed for the Brave signing key');
+            $failed = 1;
+        }
+    }
+
+    remove_tree($tmp);
+    return $failed ? 0 : 1;
+}
+
+# Pin the repo file's gpgkey= line to the local copy of the verified key.  The
+# paths are parameters so the rewrite can be exercised away from /etc.
+sub pin_brave_repo_gpgkey {
+    my ($repo_file, $key_file) = @_;
+    $repo_file //= $BRAVE_REPO_FILE;
+    $key_file //= $BRAVE_KEY_FILE;
+    my $read_ok = open(my $repo_fh, '<', $repo_file);
+    my $read_error = $read_ok ? '' : os_error_text($repo_file);
+    my $content;
+    if ($read_ok) {
+        $content = do { local $/ = undef; <$repo_fh> };
+        close($repo_fh);
+    }
+    if (!$read_ok || !defined $content) {
+        _warn("Cannot read $repo_file: $read_error");
+        return 0;
+    }
+    my $pinned = "gpgkey=file://$key_file";
+    return 1 if index($content, $pinned) >= 0;
+    if (!-f $key_file) {
+        _warn("$key_file not found, leaving the repo gpgkey= unpinned");
+        return 0;
+    }
+    my (@new_lines, $changed);
+    $changed = 0;
+    for my $line (split /\n/, $content, -1) {
+        if (!length $line) {
+            push @new_lines, $line;
+            next;
+        }
+        my $stripped = $line;
+        $stripped =~ s/^\s+//;
+        if (index($stripped, 'gpgkey=') == 0) {
+            $line = $pinned;
+            $changed = 1;
+        }
+        push @new_lines, $line;
+    }
+    if (!$changed) {
+        _warn("No gpgkey= line found in $repo_file");
+        return 0;
+    }
+    my $ok = eval { atomic_write($repo_file, join("\n", @new_lines) . "\n"); 1 };
+    if (!$ok) {
+        my $error = $@;
+        $error =~ s/\s+\z//;
+        _warn("Cannot update $repo_file: $error");
+        return 0;
+    }
+    return 1;
+}
+
+# The Brave repo, with the config-manager syntax the installed dnf understands.
+sub add_brave_repo {
+    my @cmd = defined find_exe('dnf5')
+        ? ('dnf', 'config-manager', 'addrepo', "--from-repofile=$BRAVE_REPO_URL")
+        : ('dnf', 'config-manager', '--add-repo', $BRAVE_REPO_URL);
+    my $result = run(\@cmd, timeout => 120, use_sudo => 1);
+    if ($result->{rc} != 0) {
+        _fail('Failed to add the Brave repo (on dnf4 systems this requires '
+            . 'the dnf-plugins-core package)');
+        return 0;
+    }
+    return 1;
+}
+
+sub setup_repos {
+    my ($dry_run) = @_;
+    my (@added, @skipped);
+    my $repo_name = 'brave-browser';
+
+    _status("Checking $repo_name repo");
+    if (-e $BRAVE_REPO_FILE) {
+        _status_done('already present');
+        if (!$dry_run) {
+            if (!-f $BRAVE_KEY_FILE) {
+                # The repo predates this script's key pinning: fetch, verify and
+                # import the key so gpgkey= can be pinned to a real file.
+                do_import_brave_key();
+            }
+            pin_brave_repo_gpgkey();
+        }
+        push @skipped, $repo_name;
+    }
+    elsif ($dry_run) {
+        _status_done('would verify + import GPG key, would add repo');
+        push @added, $repo_name;
+    }
+    else {
+        if (do_import_brave_key() && add_brave_repo()) {
+            pin_brave_repo_gpgkey();
+            _status_done('added');
+            push @added, $repo_name;
+        }
+        else {
+            _status_done('failed');
+        }
+    }
+
+    return { added => \@added, skipped => \@skipped };
+}
+
+# ---------------------------------------------------------------------------
+# 4. RPM packages
+# ---------------------------------------------------------------------------
+
+sub install_rpm_packages {
+    my ($dry_run) = @_;
+    my (@installed, @skipped, @failed, @to_install);
+
+    _status('Checking RPM packages');
+    for my $pkg (@RPM_PACKAGES) {
+        if (rpm_installed($pkg)) { push @skipped, $pkg }
+        else                     { push @to_install, $pkg }
+    }
+
+    my $already = scalar @skipped;
+    my $missing = scalar @to_install;
+    my $total = scalar @RPM_PACKAGES;
+    _status_done("$already/$total already installed");
+
+    # Flatpak counterparts of the requested RPM packages go first, so the RPM becomes
+    # the single source of truth.
+    my @removed_flatpak;
+    for my $pkg (@RPM_PACKAGES) {
+        my $app_id = remove_conflicting_flatpak($pkg, $dry_run);
+        push @removed_flatpak, $app_id if defined $app_id;
+    }
+
+    if (!@to_install) {
+        _ok('All RPM packages already present');
+        return {
+            installed       => \@installed,
+            skipped         => \@skipped,
+            failed          => \@failed,
+            removed_flatpak => \@removed_flatpak,
+        };
+    }
+
+    _info('Installing ' . $missing . ' package(s): ' . join(' ', @to_install));
+
+    if ($dry_run) {
+        for my $pkg (@to_install) {
+            _info("  Would install: $pkg");
+            push @installed, $pkg;
+        }
+        return {
+            installed       => \@installed,
+            skipped         => \@skipped,
+            failed          => \@failed,
+            removed_flatpak => \@removed_flatpak,
+        };
+    }
+
+    _status("Installing $missing package(s)");
+    my $batch = run(['dnf', 'install', '-y', @to_install], timeout => $DNF_TIMEOUT, use_sudo => 1);
+    if ($batch->{rc} == 0) {
+        _status_done();
+        push @installed, @to_install;
+        return {
+            installed       => \@installed,
+            skipped         => \@skipped,
+            failed          => \@failed,
+            removed_flatpak => \@removed_flatpak,
+        };
+    }
+
+    _status_done('batch failed, retrying one by one');
+    for my $pkg (@to_install) {
+        _status("Installing $pkg");
+        my $result = run(['dnf', 'install', '-y', $pkg], timeout => $DNF_TIMEOUT, use_sudo => 1);
+        if ($result->{rc} == 0) {
+            _status_done();
+            push @installed, $pkg;
+        }
+        else {
+            _status_done('failed');
+            _fail("Failed to install $pkg");
+            push @failed, $pkg;
+        }
+    }
+
+    return {
+        installed       => \@installed,
+        skipped         => \@skipped,
+        failed          => \@failed,
+        removed_flatpak => \@removed_flatpak,
+    };
+}
+
+# ---------------------------------------------------------------------------
+# 5. Shell PATH exports
+# ---------------------------------------------------------------------------
+
+# Append export lines to ~/.bashrc unless each is already present.  Matching on the
+# export line content rather than on the surrounding block means a block written by an
+# upstream installer is recognised too.  Returns true when a block was appended.
+sub add_bashrc_lines {
+    my ($lines, $comment) = @_;
+    my $home = real_home();
+    my $bashrc = "$home/.bashrc";
+    if (!-e $bashrc) {
+        # A missing bashrc must not silently drop the PATH exports: create it owned by
+        # the real user, so the lines land where bash reads them.  The handle is
+        # declared before the test, because one declared inside it is scoped to that
+        # block and invisible afterwards.
+        my $create;
+        if (!open($create, '>>', $bashrc)) {
+            _warn("Cannot create $bashrc, PATH setup has to be done manually");
+            return 0;
+        }
+        close($create);
+        chown_user($bashrc);
+    }
+    my $content = slurp($bashrc);
+    my $all_present = 1;
+    for my $line (@$lines) {
+        $all_present = 0 unless index($content, $line) >= 0;
+    }
+    return 0 if $all_present;
+    my $append;
+    if (!open($append, '>>', $bashrc)) {
+        _warn("Cannot append to $bashrc, PATH setup has to be done manually");
+        return 0;
+    }
+    print {$append} "\n# $comment\n" . join("\n", @$lines) . "\n";
+    close($append);
+    return 1;
+}
+
+# ---------------------------------------------------------------------------
+# 6. Go toolchain
+# ---------------------------------------------------------------------------
+
+# The architecture in Go's naming, or undef when it is not supported.
+sub go_arch {
+    my $machine = uname_m();
+    return 'amd64' if $machine eq 'x86_64';
+    return 'arm64' if $machine eq 'aarch64';
+    return undef;
+}
+
+my $UNAME_M;
+sub uname_m {
+    return $UNAME_M if defined $UNAME_M;
+    my $result = run(['uname', '-m'], timeout => 5);
+    my $machine = $result->{out};
+    $machine =~ s/^\s+//;
+    $machine =~ s/\s+$//;
+    $UNAME_M = $machine;
+    return $UNAME_M;
+}
+
+# The latest stable release for this architecture: (version, filename, sha256).
+sub latest_go {
+    my $arch = go_arch();
+    if (!defined $arch) {
+        _fail('Unsupported architecture for Go: ' . uname_m());
+        return undef;
+    }
+    my $result = run(['curl', '-fsSL', $GO_DL_API_URL], timeout => 120);
+    return undef if $result->{rc} != 0;
+    my $releases = eval { json_decode($result->{out}) };
+    return undef if $@ || ref $releases ne 'ARRAY';
+    for my $release (@$releases) {
+        next unless ref $release eq 'HASH' && $release->{stable};
+        my $files = $release->{files};
+        next unless ref $files eq 'ARRAY';
+        for my $artifact (@$files) {
+            next unless ref $artifact eq 'HASH';
+            next unless ($artifact->{os} // '') eq 'linux';
+            next unless ($artifact->{arch} // '') eq $arch;
+            next unless ($artifact->{kind} // '') eq 'archive';
+            return (
+                "$release->{version}",
+                "$artifact->{filename}",
+                lc "$artifact->{sha256}",
+            );
+        }
+    }
+    return undef;
+}
+
+# The installed Go version (for example go1.27.0), or undef when absent.
+sub installed_go_version {
+    my $go = find_exe('go');
+    if (!defined $go && -f "$GO_INSTALL_DIR/bin/go") {
+        $go = "$GO_INSTALL_DIR/bin/go";
+    }
+    return undef unless defined $go;
+    my $result = run([$go, 'version']);
+    return undef if $result->{rc} != 0;
+    # The output looks like: "go version go1.27.0 linux/amd64"
+    for my $token (split ' ', $result->{out}) {
+        return $token if index($token, 'go1.') == 0;
+    }
+    return undef;
+}
+
+sub setup_go {
+    my ($dry_run) = @_;
+    my %info = (installed => 0, version => '', planned => 0);
+
+    _status('Checking Go');
+    my ($go_version, $filename, $sha256) = latest_go();
+    if (!defined $go_version) {
+        _status_done('failed');
+        _fail('Could not determine the latest Go release from go.dev');
+        return \%info;
+    }
+
+    my $installed = installed_go_version();
+    if (defined $installed && $installed eq $go_version) {
+        _status_done($installed);
+        $info{installed} = 1;
+        $info{version} = $installed;
+        if ($dry_run) {
+            _info('Would add the Go PATH to ~/.bashrc if missing');
+        }
+        elsif (add_bashrc_lines(\@GO_BASHRC_LINES, 'Go')) {
+            _info('Added Go PATH to ~/.bashrc');
+        }
+        return \%info;
+    }
+    _status_done(defined $installed
+        ? "$installed installed (latest: $go_version)"
+        : 'not installed');
+
+    if ($dry_run) {
+        _info('Would remove RPM package: golang') if rpm_installed('golang');
+        _info("Would download $filename from go.dev, verify SHA-256, "
+            . "and install to $GO_INSTALL_DIR");
+        $info{planned} = 1;
+        return \%info;
+    }
+
+    if (rpm_installed('golang')) {
+        _warn('Removing the golang RPM: the official toolchain becomes the only Go');
+        my $removed = run(['dnf', 'remove', '-y', 'golang'], timeout => $DNF_TIMEOUT, use_sudo => 1);
+        if ($removed->{rc} != 0) {
+            _fail('Failed to remove the golang RPM');
+            return \%info;
+        }
+    }
+
+    _status("Installing $go_version");
+    my $tmp = make_temp_dir();
+    if (!defined $tmp) {
+        _status_done('failed');
+        _fail('Could not create a temporary directory');
+        return \%info;
+    }
+    my $tarball = "$tmp/$filename";
+    if (!download("$GO_TARBALL_BASE_URL$filename", $tarball, timeout => 900)) {
+        _status_done('download failed');
+        _fail("Failed to download $filename from go.dev");
+        remove_tree($tmp);
+        return \%info;
+    }
+    my $actual = sha256_file($tarball);
+    if ($actual ne $sha256) {
+        _status_done('failed');
+        _fail("SHA-256 mismatch for $filename: expected $sha256, got $actual");
+        remove_tree($tmp);
+        return \%info;
+    }
+    _info('SHA-256 checksum verified');
+    # The official install procedure replaces the whole directory: removing it first
+    # stops old binaries from shadowing the new tree.
+    my $wipe = run(['rm', '-rf', $GO_INSTALL_DIR], use_sudo => 1);
+    if ($wipe->{rc} != 0) {
+        _status_done('failed');
+        _fail("Failed to remove the existing $GO_INSTALL_DIR");
+        remove_tree($tmp);
+        return \%info;
+    }
+    my $extract = run(['tar', '-C', '/usr/local', '-xzf', $tarball], timeout => 600, use_sudo => 1);
+    remove_tree($tmp);
+    if ($extract->{rc} != 0) {
+        _status_done('failed');
+        _fail("Failed to extract $filename to /usr/local");
+        return \%info;
+    }
+
+    if (add_bashrc_lines(\@GO_BASHRC_LINES, 'Go')) {
+        _info('Added Go PATH to ~/.bashrc');
+    }
+    my $version = installed_go_version();
+    _status_done(defined $version ? $version : 'installed');
+    if (defined $version) {
+        $info{installed} = 1;
+        $info{version} = $version;
+    }
+    else {
+        _fail('Go binary not usable after installation');
+    }
+    return \%info;
+}
+
+# ---------------------------------------------------------------------------
+# 7. Rust toolchain
+# ---------------------------------------------------------------------------
+
+sub setup_rust {
+    my ($dry_run) = @_;
+    my %info = (installed => 0, version => '', planned => 0);
+
+    _status('Checking Rust');
+    my $rustc = tool_path('rustc', '.cargo/bin/rustc');
+    if (defined $rustc) {
+        $info{version} = probe_version([$rustc, '--version']);
+        _status_done($info{version});
+        $info{installed} = 1;
+        return \%info;
+    }
+
+    _status_done('not installed');
+
+    if ($dry_run) {
+        _info('Would run: rustup-init -y');
+        $info{planned} = 1;
+        return \%info;
+    }
+
+    my $rustup_init = tool_path('rustup-init');
+    if (!defined $rustup_init) {
+        _fail("rustup-init not found, install the 'rustup' RPM first "
+            . '(or do not pass --skip-rpm)');
+        return \%info;
+    }
+
+    _status('Installing Rust toolchain');
+    my $result = run_as_user([$rustup_init, '-y'], timeout => 300);
+    if ($result->{rc} == 0) {
+        $info{version} = probe_version([real_home() . '/.cargo/bin/rustc', '--version']);
+        _status_done($info{version});
+        $info{installed} = 1;
+    }
+    else {
+        _status_done('failed');
+        _fail('Rust installation returned non-zero exit code');
+    }
+
+    return \%info;
+}
+
+# ---------------------------------------------------------------------------
+# 8. JetBrains IDEs
+# ---------------------------------------------------------------------------
+
+# The downloads-API key for this machine's architecture.
+sub jetbrains_download_key {
+    return uname_m() eq 'aarch64' ? 'linuxARM64' : 'linux';
+}
+
+# The latest release entry for a product code, from the releases API.
+sub latest_jetbrains {
+    my ($code) = @_;
+    my $url = "$JETBRAINS_RELEASES_URL?code=$code&latest=true&type=release";
+    my $result = run(['curl', '-fsSL', $url], timeout => 120);
+    return undef if $result->{rc} != 0;
+    my $releases = eval { json_decode($result->{out}) };
+    return undef if $@ || ref $releases ne 'HASH';
+    my $entries = $releases->{$code};
+    return undef unless ref $entries eq 'ARRAY' && @$entries;
+    return $entries->[0];
+}
+
+# Existing installation directories for an IDE under /opt.
+sub jetbrains_install_dirs {
+    my ($name) = @_;
+    return () unless -d $JETBRAINS_INSTALL_ROOT;
+    my @entries;
+    if (opendir(my $dh, $JETBRAINS_INSTALL_ROOT)) {
+        @entries = sort grep { $_ ne '.' && $_ ne '..' } readdir($dh);
+        closedir($dh);
+    }
+    my @dirs;
+    for my $entry (@entries) {
+        next unless index($entry, "$name-") == 0;
+        push @dirs, "$JETBRAINS_INSTALL_ROOT/$entry" if -d "$JETBRAINS_INSTALL_ROOT/$entry";
+    }
+    return @dirs;
+}
+
+# The icon file shipped in the IDE's bin/ directory, if there is one.
+sub jetbrains_icon {
+    my ($install_dir, $name) = @_;
+    my $bin_dir = "$install_dir/bin";
+    my $lower = lc $name;
+    for my $candidate ("$lower.svg", "$lower.png") {
+        my $path = "$bin_dir/$candidate";
+        return $path if -f $path;
+    }
+    if (opendir(my $dh, $bin_dir)) {
+        my @entries = sort grep { $_ ne '.' && $_ ne '..' } readdir($dh);
+        closedir($dh);
+        for my $entry (@entries) {
+            return "$bin_dir/$entry" if $entry =~ /\.svg$/;
+        }
+    }
+    return undef;
+}
+
+# A menu entry pointing at the verified launcher path.
+sub write_jetbrains_desktop_entry {
+    my ($name, $install_dir, $launcher, $icon, $desktop_dir) = @_;
+    $desktop_dir //= $JETBRAINS_DESKTOP_DIR;
+    my $lower = lc $name;
+    my $path = "$desktop_dir/jetbrains-$lower.desktop";
+    my @lines = (
+        '[Desktop Entry]',
+        'Version=1.0',
+        'Type=Application',
+        "Name=$name",
+        "Exec=\"$launcher\" %f",
+    );
+    push @lines, "Icon=$icon" if defined $icon;
+    push @lines,
+        "Comment=$name by JetBrains",
+        'Categories=Development;IDE;',
+        'Terminal=false',
+        "StartupWMClass=jetbrains-$lower",
+        'StartupNotify=true';
+    if (!make_dirs($desktop_dir)) {
+        _warn("Could not write $path");
+        return 0;
+    }
+    my $ok = eval { atomic_write($path, join("\n", @lines) . "\n"); 1 };
+    if (!$ok) {
+        my $error = $@;
+        $error =~ s/\s+\z//;
+        _warn("Could not write $path: $error");
+        return 0;
+    }
+    chmod(0644, $path);
+    return 1;
+}
+
+# The command-line symlink and the menu entry, ensured on every run: an earlier
+# interrupted run between the directory move and the links is healed by the next
+# one.  The directories are parameters so the links can be exercised away from
+# /usr/local.
+sub jetbrains_links {
+    my ($name, $install_dir, $bin_dir, $desktop_dir) = @_;
+    $bin_dir //= $JETBRAINS_BIN_DIR;
+    $desktop_dir //= $JETBRAINS_DESKTOP_DIR;
+    my $lower = lc $name;
+    my $launcher = "$install_dir/bin/$lower.sh";
+    if (!-f $launcher) {
+        _fail("Launcher not found: $launcher");
+        return 0;
+    }
+    my $bin_link = "$bin_dir/$lower";
+    if (-l $bin_link) {
+        my $target = readlink($bin_link) // '';
+        if ($target ne $launcher) {
+            unlink($bin_link)
+                and symlink($launcher, $bin_link)
+                or _warn("Could not repoint the $bin_link symlink: $!");
+        }
+    }
+    elsif (!-e $bin_link) {
+        symlink($launcher, $bin_link)
+            or _warn("Could not create the $bin_link symlink: $!");
+    }
+    else {
+        _warn("$bin_link already exists and is not a symlink, left in place");
+    }
+
+    write_jetbrains_desktop_entry($name, $install_dir, $launcher,
+        jetbrains_icon($install_dir, $name), $desktop_dir);
+    return 1;
+}
+
+# Install the latest release of one IDE system-wide.
+sub setup_jetbrains_ide {
+    my ($code, $name, $dry_run) = @_;
+    my %info = (installed => 0, version => '', planned => 0);
+
+    _status("Checking $name");
+    my $release = latest_jetbrains($code);
+    if (!defined $release) {
+        _status_done('failed');
+        _fail("Could not determine the latest $name release from JetBrains");
+        return \%info;
+    }
+    my $version = "$release->{version}";
+    my $downloads = ref $release->{downloads} eq 'HASH' ? $release->{downloads} : {};
+    my $key = jetbrains_download_key();
+    my $download = ref $downloads->{$key} eq 'HASH' ? $downloads->{$key} : {};
+    my $link = "$download->{link}";
+    my $checksum_link = "$download->{checksumLink}";
+    if (!length($release->{version} // '') || !length($download->{link} // '')
+        || !length($download->{checksumLink} // '')) {
+        _status_done('failed');
+        _fail("Incomplete $name release metadata from JetBrains");
+        return \%info;
+    }
+
+    my $install_dir = "$JETBRAINS_INSTALL_ROOT/$name-$version";
+    my @existing = jetbrains_install_dirs($name);
+    if (grep { $_ eq $install_dir } @existing) {
+        # Already at the latest release: the links are re-checked so an earlier
+        # interrupted run does not leave the IDE without a launcher.
+        if (jetbrains_links($name, $install_dir)) {
+            _status_done($version);
+            $info{installed} = 1;
+            $info{version} = $version;
+        }
+        else {
+            _status_done('broken install, the launcher is missing');
+        }
+        return \%info;
+    }
+    _status_done(@existing ? "older build present (latest: $version)" : 'not installed');
+
+    if ($dry_run) {
+        my $tar_name = $link;
+        $tar_name =~ s{.*/}{};
+        _info("Would download $tar_name, verify SHA-256, and install to $install_dir");
+        $info{planned} = 1;
+        return \%info;
+    }
+
+    _status("Installing $name $version");
+    my $tar_name = $link;
+    $tar_name =~ s{.*/}{};
+    my $tmp = make_temp_dir();
+    if (!defined $tmp) {
+        _status_done('failed');
+        _fail('Could not create a temporary directory');
+        return \%info;
+    }
+    my $tarball = "$tmp/$tar_name";
+    if (!download($link, $tarball, timeout => 1800)) {
+        _status_done('download failed');
+        _fail("Failed to download $tar_name");
+        remove_tree($tmp);
+        return \%info;
+    }
+    my $sums_path = "$tmp/checksums.sha256";
+    if (!download($checksum_link, $sums_path, timeout => 60)) {
+        _status_done('failed');
+        _fail("Failed to download the $name SHA-256 checksum");
+        remove_tree($tmp);
+        return \%info;
+    }
+    my $expected = sha256_from_sums($sums_path, $tar_name);
+    if (!defined $expected) {
+        _status_done('failed');
+        _fail("No checksum for $tar_name in the published SHA-256 file");
+        remove_tree($tmp);
+        return \%info;
+    }
+    my $actual = sha256_file($tarball);
+    if ($actual ne $expected) {
+        _status_done('failed');
+        _fail("SHA-256 mismatch for $tar_name: expected $expected, got $actual");
+        remove_tree($tmp);
+        return \%info;
+    }
+    _info('SHA-256 checksum verified');
+
+    # Extract into a staging directory first: a failure then never leaves a
+    # half-installed IDE in /opt, and the top-level directory is moved to its
+    # canonical name afterwards.
+    make_dirs($JETBRAINS_INSTALL_ROOT);
+    my $staging = make_temp_dir(dir => $JETBRAINS_INSTALL_ROOT, prefix => ".$name-stage-");
+    if (!defined $staging) {
+        _status_done('failed');
+        _fail("Could not create a staging directory in $JETBRAINS_INSTALL_ROOT");
+        remove_tree($tmp);
+        return \%info;
+    }
+    my $extract = run(['tar', '-C', $staging, '-xzf', $tarball], timeout => 1200, use_sudo => 1);
+    remove_tree($tmp);
+    if ($extract->{rc} != 0) {
+        _status_done('failed');
+        _fail("Failed to extract $tar_name");
+        remove_tree($staging);
+        return \%info;
+    }
+    my @entries;
+    if (opendir(my $dh, $staging)) {
+        @entries = sort grep { $_ ne '.' && $_ ne '..' } readdir($dh);
+        closedir($dh);
+    }
+    if (@entries != 1 || !-d "$staging/$entries[0]") {
+        _status_done('failed');
+        _fail("Unexpected archive layout in $tar_name: " . join(', ', @entries));
+        remove_tree($staging);
+        return \%info;
+    }
+    remove_tree($install_dir) if -e $install_dir;
+    if (!rename("$staging/$entries[0]", $install_dir)) {
+        _status_done('failed');
+        _fail("Could not move the extracted $name into place: $!");
+        remove_tree($staging);
+        return \%info;
+    }
+    remove_tree($staging);
+
+    # Older versions go, so the latest release is the only one in /opt.
+    for my $old_dir (@existing) {
+        next if $old_dir eq $install_dir;
+        next unless -d $old_dir;
+        _warn("Removing previous $name install: $old_dir");
+        remove_tree($old_dir);
+    }
+
+    if (!jetbrains_links($name, $install_dir)) {
+        return \%info;
+    }
+
+    _status_done();
+    $info{installed} = 1;
+    $info{version} = $version;
+    return \%info;
+}
+
+sub setup_jetbrains {
+    my ($dry_run) = @_;
+    my %results;
+    for my $code (@JETBRAINS_ORDER) {
+        $results{$code} = setup_jetbrains_ide($code, $JETBRAINS_IDES{$code}, $dry_run);
+    }
+    return \%results;
+}
+
+# ---------------------------------------------------------------------------
+# 9. Flatpak apps
+# ---------------------------------------------------------------------------
+
+# Names of the configured system-wide remotes, matched exactly rather than by
+# substring.
+sub flatpak_remote_names {
+    my $result = run(['flatpak', 'remotes']);
+    my %names;
+    for my $line (split /\n/, $result->{out}) {
+        my @tokens = split ' ', $line;
+        next unless @tokens;
+        next if $tokens[0] eq 'Name';   # the table header
+        $names{ $tokens[0] } = 1;
+    }
+    return %names;
+}
+
+sub setup_flatpak {
+    my ($dry_run) = @_;
+    my (@installed, @skipped, @failed, @removed_rpm);
+    my $remote_added = 0;
+
+    _status('Checking Flathub remote');
+    my %remotes = flatpak_remote_names();
+    if ($remotes{flathub}) {
+        _status_done('already present');
+    }
+    elsif ($dry_run) {
+        _status_done('would add');
+        $remote_added = 1;
+    }
+    else {
+        my $result = run(
+            ['flatpak', 'remote-add', '--if-not-exists', 'flathub',
+             'https://flathub.org/repo/flathub.flatpakrepo'],
+            timeout => 120, use_sudo => 1,
+        );
+        if ($result->{rc} == 0) {
+            _status_done('added');
+            $remote_added = 1;
+        }
+        else {
+            _status_done('failed');
+            _fail('Failed to add Flathub remote');
+        }
+    }
+
+    for my $app (@FLATPAK_APPS) {
+        my $rpm_name = remove_conflicting_rpm($app, $dry_run);
+        push @removed_rpm, $rpm_name if defined $rpm_name;
+        _status("Checking $app");
+        if (have_flatpak($app)) {
+            _status_done('already installed');
+            push @skipped, $app;
+            next;
+        }
+        if ($dry_run) {
+            _status_done('would install');
+            push @installed, $app;
+            next;
+        }
+        my $result = run(['flatpak', 'install', '-y', 'flathub', $app],
+            timeout => 300, use_sudo => 1);
+        if ($result->{rc} == 0) {
+            _status_done('installed');
+            push @installed, $app;
+        }
+        else {
+            _status_done('failed');
+            _fail("Failed to install $app");
+            push @failed, $app;
+        }
+    }
+
+    return {
+        remote_added => $remote_added,
+        installed    => \@installed,
+        skipped      => \@skipped,
+        failed       => \@failed,
+        removed_rpm  => \@removed_rpm,
+    };
+}
+
+# ---------------------------------------------------------------------------
+# 10. Firewall
+# ---------------------------------------------------------------------------
+
+# Ensure firewalld is installed, enabled and running.  Unlike the server setup this
+# does NOT change the default zone: the workstation default is left as it is.
+sub setup_firewall {
+    my ($dry_run) = @_;
+    my %info = (installed => 0, enabled => 0, running => 0);
+
+    _status('Checking firewalld');
+    if (!rpm_installed('firewalld')) {
+        _status_done('not installed');
+        if ($dry_run) {
+            _info('Would install: firewalld');
+        }
+        else {
+            my $result = run(['dnf', 'install', '-y', 'firewalld'],
+                timeout => $DNF_TIMEOUT, use_sudo => 1);
+            if ($result->{rc} == 0) {
+                _ok('Installed firewalld');
+                $info{installed} = 1;
+            }
+            else {
+                _fail('Failed to install firewalld');
+                return \%info;
+            }
+        }
+    }
+    else {
+        _status_done('installed');
+        $info{installed} = 1;
+    }
+
+    _status('Enabling firewalld service');
+    my $enabled = run(['systemctl', 'is-enabled', 'firewalld.service']);
+    if ($enabled->{rc} != 0) {
+        if ($dry_run) {
+            _status_done('would enable');
+        }
+        else {
+            my $result = run(['systemctl', 'enable', 'firewalld.service'], use_sudo => 1);
+            if ($result->{rc} == 0) {
+                _status_done('enabled');
+            }
+            else {
+                _status_done('failed');
+                my $error = $result->{err};
+                $error =~ s/^\s+//;
+                $error =~ s/\s+$//;
+                _fail("Failed to enable firewalld: $error");
+            }
+        }
+    }
+    else {
+        _status_done('already enabled');
+    }
+
+    _status('Starting firewalld service');
+    my $active = run(['systemctl', 'is-active', 'firewalld.service']);
+    if ($active->{rc} != 0) {
+        if ($dry_run) {
+            _status_done('would start');
+        }
+        else {
+            my $result = run(['systemctl', 'start', 'firewalld.service'], use_sudo => 1);
+            if ($result->{rc} == 0) {
+                _status_done('started');
+            }
+            else {
+                _status_done('failed');
+                my $error = $result->{err};
+                $error =~ s/^\s+//;
+                $error =~ s/\s+$//;
+                _fail("Failed to start firewalld: $error");
+            }
+        }
+    }
+    else {
+        _status_done('already running');
+    }
+
+    # Reflect the real probed state, never an assumed success.
+    if (!$dry_run) {
+        $info{enabled} = run(['systemctl', 'is-enabled', 'firewalld.service'])->{rc} == 0 ? 1 : 0;
+        $info{running} = run(['systemctl', 'is-active', 'firewalld.service'])->{rc} == 0 ? 1 : 0;
+    }
+
+    return \%info;
+}
+
+# ---------------------------------------------------------------------------
+# 11. SELinux
+# ---------------------------------------------------------------------------
+
+# Ensure SELinux is enforcing.  A disabled SELinux cannot be switched at runtime, so
+# only the configuration is fixed and a reboot warning is printed.
+sub setup_selinux {
+    my ($dry_run) = @_;
+    my %info = (mode_changed => 0, config_changed => 0, current_mode => 'unknown',
+                reboot_required => 0);
+
+    _status('Checking SELinux mode');
+    my $mode_result = run(['getenforce']);
+    my $current_mode = $mode_result->{out};
+    $current_mode =~ s/^\s+//;
+    $current_mode =~ s/\s+$//;
+    $current_mode = 'unknown' unless length $current_mode;
+    $info{current_mode} = $current_mode;
+    _status_done($current_mode);
+
+    if ($current_mode eq 'Permissive') {
+        if ($dry_run) {
+            _info('Would set SELinux to enforcing mode');
+        }
+        else {
+            _status('Setting SELinux to enforcing');
+            my $result = run(['setenforce', '1'], use_sudo => 1);
+            if ($result->{rc} == 0) {
+                _status_done();
+                $info{mode_changed} = 1;
+            }
+            else {
+                _status_done('failed');
+                my $error = $result->{err};
+                $error =~ s/^\s+//;
+                $error =~ s/\s+$//;
+                _fail("setenforce 1 failed: $error");
+            }
+        }
+    }
+    elsif ($current_mode eq 'Disabled') {
+        _warn('SELinux is disabled, it cannot be enabled at runtime. '
+            . 'Setting SELINUX=enforcing in the config; a REBOOT is required.');
+        $info{reboot_required} = 1;
+    }
+
+    _status('Checking /etc/selinux/config');
+    my $read_ok = open(my $config_fh, '<', '/etc/selinux/config');
+    my $read_error = $read_ok ? '' : os_error_text('/etc/selinux/config');
+    my $content;
+    if ($read_ok) {
+        $content = do { local $/ = undef; <$config_fh> };
+        close($config_fh);
+    }
+    if (!$read_ok || !defined $content) {
+        _status_done('error');
+        _warn("Cannot read/write /etc/selinux/config: $read_error");
+        return \%info;
+    }
+
+    my @lines = split /\n/, $content, -1;
+    pop @lines if @lines && $lines[-1] eq '';
+    my $has_enforcing = 0;
+    for my $line (@lines) {
+        my $stripped = $line;
+        $stripped =~ s/^\s+//;
+        $stripped =~ s/\s+$//;
+        if (index($stripped, 'SELINUX=') == 0 && index($stripped, '#') != 0) {
+            my (undef, $value) = split /=/, $stripped, 2;
+            $value = '' unless defined $value;
+            $value =~ s/^\s+//;
+            $value =~ s/\s+$//;
+            $has_enforcing = 1 if lc($value) eq 'enforcing';
+            last;
+        }
+    }
+
+    if (!$has_enforcing) {
+        if ($dry_run) {
+            _status_done('would update to SELINUX=enforcing');
+        }
+        else {
+            my (@new_lines, $found);
+            $found = 0;
+            for my $line (@lines) {
+                my $stripped = $line;
+                $stripped =~ s/^\s+//;
+                $stripped =~ s/\s+$//;
+                if (index($stripped, 'SELINUX=') == 0 && index($stripped, '#') != 0) {
+                    if (!$found) {
+                        push @new_lines, 'SELINUX=enforcing';
+                        $found = 1;
+                    }
+                    # Any duplicate active SELINUX= line is dropped.
+                    next;
+                }
+                push @new_lines, $line;
+            }
+            push @new_lines, 'SELINUX=enforcing' unless $found;
+            my $ok = eval { atomic_write('/etc/selinux/config', join("\n", @new_lines) . "\n"); 1 };
+            if (!$ok) {
+                my $error = $@;
+                $error =~ s/\s+\z//;
+                _status_done('error');
+                _warn("Cannot read/write /etc/selinux/config: $error");
+                return \%info;
+            }
+            _status_done('updated to enforcing');
+            $info{config_changed} = 1;
+        }
+    }
+    else {
+        _status_done('already enforcing');
+    }
+
+    return \%info;
+}
+
+# ---------------------------------------------------------------------------
+# Summary
+# ---------------------------------------------------------------------------
+
+# In dry-run mode nothing is phrased as accomplished: only would-be actions.
+sub print_summary {
+    my ($os_display, $version_id, $results, $warnings, $elapsed, $dry_run) = @_;
+    my $bar = "═" x 60;
+
+    print STDERR "\n${BOLD}══ Setup Summary ══$RESET\n";
+    print STDERR "  OS: $os_display $version_id\n";
+
+    my $update = $results->{update} // {};
+    if ($update->{error}) {
+        _fail('System update failed');
+    }
+    elsif ($update->{would_update}) {
+        _info('Would apply system updates');
+    }
+    elsif ($update->{updated}) {
+        _ok('System updated');
+    }
+    elsif ($update->{skipped}) {
+        _info('System already up to date');
+    }
+    elsif (%$update) {
+        _info('System update skipped');
+    }
+
+    my $remove = $results->{remove} // {};
+    if (%$remove) {
+        my $removed = scalar @{ $remove->{removed} // [] };
+        my $skipped = scalar @{ $remove->{skipped} // [] };
+        if ($dry_run) {
+            _info("Remove: would remove $removed, $skipped already absent");
+        }
+        elsif ($removed) {
+            _ok("Removed: $removed package(s), $skipped already absent");
+        }
+        else {
+            _info("Remove: $skipped package(s) already absent");
+        }
+    }
+
+    my $repos = $results->{repos} // {};
+    if (%$repos) {
+        my $added = scalar @{ $repos->{added} // [] };
+        my $skipped = scalar @{ $repos->{skipped} // [] };
+        if ($dry_run) {
+            _info("Repos: would add $added, $skipped already present");
+        }
+        else {
+            _ok("Repos: $added added, $skipped already present");
+        }
+    }
+
+    my $rpm = $results->{rpm} // {};
+    if (%$rpm) {
+        my $installed = scalar @{ $rpm->{installed} // [] };
+        my $skipped = scalar @{ $rpm->{skipped} // [] };
+        my $failed = scalar @{ $rpm->{failed} // [] };
+        if ($dry_run) {
+            _info("RPM packages: would install $installed, $skipped already present");
+        }
+        else {
+            _ok("RPM packages: $skipped already present, $installed installed");
+        }
+        _fail("  $failed package(s) failed to install") if $failed;
+        my $removed = scalar @{ $rpm->{removed_flatpak} // [] };
+        if ($removed) {
+            if ($dry_run) {
+                _info("  Would uninstall $removed duplicate Flatpak app(s)");
+            }
+            else {
+                _ok("  Uninstalled $removed duplicate Flatpak app(s)");
+            }
+        }
+    }
+
+    # Tools fetched by curl or packaged
+    for my $item (['go', 'Go'], ['rust', 'Rust']) {
+        my ($section, $label) = @$item;
+        my $tool = $results->{$section} // {};
+        next unless %$tool;
+        if ($tool->{version}) {
+            _ok("$label: $tool->{version}");
+        }
+        elsif ($tool->{planned}) {
+            _info("$label: would be installed");
+        }
+        elsif ($tool->{installed}) {
+            _ok("$label: installed");
+        }
+        else {
+            _info("$label: not installed");
+        }
+    }
+
+    my $jetbrains = $results->{jetbrains} // {};
+    for my $code (@JETBRAINS_ORDER) {
+        my $tool = $jetbrains->{$code};
+        next unless defined $tool;
+        my $name = $JETBRAINS_IDES{$code};
+        if ($tool->{version}) {
+            _ok("$name: $tool->{version}");
+        }
+        elsif ($tool->{planned}) {
+            _info("$name: would be installed");
+        }
+        else {
+            _fail("$name: not installed");
+        }
+    }
+
+    my $flatpak = $results->{flatpak} // {};
+    if (%$flatpak) {
+        my $installed = scalar @{ $flatpak->{installed} // [] };
+        my $skipped = scalar @{ $flatpak->{skipped} // [] };
+        my $failed = scalar @{ $flatpak->{failed} // [] };
+        if ($dry_run) {
+            _info("Flatpak: would install $installed, $skipped already present");
+        }
+        else {
+            _ok("Flatpak: $skipped already present, $installed installed");
+        }
+        _fail("  $failed app(s) failed to install") if $failed;
+        my $removed = scalar @{ $flatpak->{removed_rpm} // [] };
+        if ($removed) {
+            if ($dry_run) {
+                _info("  Would remove $removed duplicate RPM package(s)");
+            }
+            else {
+                _ok("  Removed $removed duplicate RPM package(s)");
+            }
+        }
+    }
+
+    my $firewall = $results->{firewall} // {};
+    if (%$firewall) {
+        if ($dry_run) {
+            _info('Firewall: would ensure firewalld is installed, enabled and running');
+        }
+        elsif ($firewall->{running}) {
+            _ok('Firewall: installed & running');
+        }
+        else {
+            _fail('Firewall: not running');
+        }
+    }
+
+    my $selinux = $results->{selinux} // {};
+    if (%$selinux) {
+        my $mode = $selinux->{current_mode} // '?';
+        if ($selinux->{reboot_required}) {
+            _warn("SELinux: mode=$mode, config set to enforcing, REBOOT required");
+        }
+        else {
+            _ok("SELinux: mode=$mode");
+        }
+    }
+
+    if (@$warnings) {
+        print STDERR "\n";
+        _warn($_) for @$warnings;
+    }
+
+    print STDERR "\n${BOLD}${bar}$RESET\n";
+    printf STDERR "  %sTotal time: %.1fs%s\n", $BOLD, $elapsed, $RESET;
+    print STDERR "${BOLD}${bar}$RESET\n\n";
+    return;
+}
+
+# ---------------------------------------------------------------------------
+# Command line
+# ---------------------------------------------------------------------------
+
+sub usage {
+    my $name = $0;
+    $name =~ s{.*/}{};
+    my $systems = join(' and ', map { $SUPPORTED_OS{$_} } @SUPPORTED_ORDER);
+    return <<"USAGE";
+Usage: $name [options]
+
+Idempotent workstation setup for $systems
+
+Options:
+  --dry-run        Print what would be done without making changes
+  --skip-update    Skip system update
+  --skip-rpm       Skip RPM package installation
+  --skip-flatpak   Skip Flatpak apps
+  --skip-repos     Skip adding third-party repos
+  --skip-remove    Skip removing pre-installed apps
+  --skip-go        Skip Go toolchain installation
+  --skip-rust      Skip Rust toolchain installation
+  --skip-jetbrains Skip JetBrains IDE installation
+  --skip-firewall  Skip firewall setup
+  --skip-selinux   Skip SELinux setup
+  --version        Show the version and exit
+  -h, --help       Show this help and exit
+USAGE
+}
+
+sub parse_args {
+    my %opt = (
+        dry_run        => 0,
+        skip_update    => 0,
+        skip_rpm       => 0,
+        skip_flatpak   => 0,
+        skip_repos     => 0,
+        skip_remove    => 0,
+        skip_go        => 0,
+        skip_rust      => 0,
+        skip_jetbrains => 0,
+        skip_firewall  => 0,
+        skip_selinux   => 0,
+    );
+    my %flag_for = (
+        '--dry-run'       => 'dry_run',
+        '--skip-update'   => 'skip_update',
+        '--skip-rpm'      => 'skip_rpm',
+        '--skip-flatpak'  => 'skip_flatpak',
+        '--skip-repos'    => 'skip_repos',
+        '--skip-remove'   => 'skip_remove',
+        '--skip-go'       => 'skip_go',
+        '--skip-rust'     => 'skip_rust',
+        '--skip-jetbrains' => 'skip_jetbrains',
+        '--skip-firewall' => 'skip_firewall',
+        '--skip-selinux'  => 'skip_selinux',
+    );
+    my @argv = @ARGV;
+    while (defined(my $arg = shift @argv)) {
+        if (exists $flag_for{$arg}) { $opt{ $flag_for{$arg} } = 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 $start_time = now();
+    my @warnings;
+    my %results;
+
+    # Arguments first, so --help and --version work anywhere.
+    my %opt = parse_args();
+
+    my ($os_id, $os_display, $version_id) = detect_os();
+
+    my $bar = "═" x 60;
+    print STDERR "\n${BOLD}${bar}$RESET\n";
+    print STDERR "${BOLD}  Workstation Setup  v$VERSION  ($os_display $version_id)$RESET\n";
+    print STDERR "${BOLD}${bar}$RESET\n";
+    if ($opt{dry_run}) {
+        print STDERR "\n  ${YELLOW}${BOLD}DRY RUN: no changes will be made$RESET\n";
+    }
+    print STDERR "\n";
+
+    # 1. System update
+    print STDERR "\n${BOLD}── System Update ──$RESET\n";
+    if (!$opt{skip_update}) {
+        $results{update} = system_update($opt{dry_run});
+    }
+    else {
+        _info('System update: skipped (--skip-update)');
+    }
+
+    # 2. Remove pre-installed apps
+    print STDERR "\n${BOLD}── Remove Pre-installed Apps ──$RESET\n";
+    if (!$opt{skip_remove}) {
+        $results{remove} = remove_packages($opt{dry_run});
+    }
+    else {
+        _info('Remove apps: skipped (--skip-remove)');
+    }
+
+    # 3. Third-party repos
+    print STDERR "\n${BOLD}── Repositories ──$RESET\n";
+    if (!$opt{skip_repos}) {
+        $results{repos} = setup_repos($opt{dry_run});
+    }
+    else {
+        _info('Repos: skipped (--skip-repos)');
+    }
+
+    # 4. RPM packages
+    print STDERR "\n${BOLD}── RPM Packages ──$RESET\n";
+    if (!$opt{skip_rpm}) {
+        $results{rpm} = install_rpm_packages($opt{dry_run});
+        if (@{ $results{rpm}{failed} }) {
+            push @warnings, 'Some RPM packages failed to install: '
+                . join(', ', @{ $results{rpm}{failed} });
+        }
+    }
+    else {
+        _info('RPM packages: skipped (--skip-rpm)');
+    }
+
+    # 5. Go toolchain
+    print STDERR "\n${BOLD}── Go Toolchain ──$RESET\n";
+    if (!$opt{skip_go}) {
+        $results{go} = setup_go($opt{dry_run});
+    }
+    else {
+        _info('Go: skipped (--skip-go)');
+    }
+
+    # 6. Rust toolchain
+    print STDERR "\n${BOLD}── Rust Toolchain ──$RESET\n";
+    if (!$opt{skip_rust}) {
+        $results{rust} = setup_rust($opt{dry_run});
+    }
+    else {
+        _info('Rust: skipped (--skip-rust)');
+    }
+
+    # 7. JetBrains IDEs
+    print STDERR "\n${BOLD}── JetBrains IDEs ──$RESET\n";
+    if (!$opt{skip_jetbrains}) {
+        $results{jetbrains} = setup_jetbrains($opt{dry_run});
+        my @failed_ides;
+        for my $code (@JETBRAINS_ORDER) {
+            my $tool = $results{jetbrains}{$code};
+            next unless defined $tool;
+            push @failed_ides, $JETBRAINS_IDES{$code}
+                unless $tool->{installed} || $tool->{planned};
+        }
+        push @warnings, 'Some JetBrains IDEs failed to install: ' . join(', ', @failed_ides)
+            if @failed_ides;
+    }
+    else {
+        _info('JetBrains IDEs: skipped (--skip-jetbrains)');
+    }
+
+    # 8. Flatpak apps
+    print STDERR "\n${BOLD}── Flatpak Apps ──$RESET\n";
+    if (!$opt{skip_flatpak}) {
+        $results{flatpak} = setup_flatpak($opt{dry_run});
+        if (@{ $results{flatpak}{failed} }) {
+            push @warnings, 'Some Flatpak apps failed to install: '
+                . join(', ', @{ $results{flatpak}{failed} });
+        }
+    }
+    else {
+        _info('Flatpak: skipped (--skip-flatpak)');
+    }
+
+    # 9. Firewall
+    print STDERR "\n${BOLD}── Firewall ──$RESET\n";
+    if (!$opt{skip_firewall}) {
+        $results{firewall} = setup_firewall($opt{dry_run});
+    }
+    else {
+        _info('Firewall: skipped (--skip-firewall)');
+    }
+
+    # 10. SELinux
+    print STDERR "\n${BOLD}── SELinux ──$RESET\n";
+    if (!$opt{skip_selinux}) {
+        $results{selinux} = setup_selinux($opt{dry_run});
+    }
+    else {
+        _info('SELinux: skipped (--skip-selinux)');
+    }
+
+    my $elapsed = now() - $start_time;
+    print_summary($os_display, $version_id, \%results, \@warnings, $elapsed, $opt{dry_run});
+    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;