2351 lines
82 KiB
Perl
2351 lines
82 KiB
Perl
|
#!/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;
|