#!/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;