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