220 lines
9.0 KiB
Perl
220 lines
9.0 KiB
Perl
#!/usr/bin/env perl
|
|
# Copyright (c) 2026 Petr Balvín <opensource@petrbalvin.org> (https://petrbalvin.org)
|
|
# SPDX-License-Identifier: MIT
|
|
|
|
# Checks for server-setup.pl: the dnf-automatic configuration renderer, the os-release
|
|
# reader, the error text, the argument parsing, the command runner's wait-status
|
|
# conversion and the EPEL enable path.
|
|
#
|
|
# Run from anywhere: perl tests/server-setup.pl
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
my $root = $0 =~ m{^(.*)/[^/]+$} ? "$1/.." : '..';
|
|
$root = "./$root" if $root !~ m{^/};
|
|
require "$root/server-setup.pl";
|
|
|
|
my ($passed, $failed) = (0, 0);
|
|
|
|
sub is {
|
|
my ($got, $want, $label) = @_;
|
|
$got = 'undef' unless defined $got;
|
|
$want = 'undef' unless defined $want;
|
|
if ($got eq $want) {
|
|
$passed++;
|
|
print "ok $label\n";
|
|
return 1;
|
|
}
|
|
$failed++;
|
|
print "FAIL $label\n got: $got\n want: $want\n";
|
|
return 0;
|
|
}
|
|
|
|
sub check {
|
|
my ($cond, $label) = @_;
|
|
return is($cond ? 1 : 0, 1, $label);
|
|
}
|
|
|
|
sub like {
|
|
my ($got, $re, $label) = @_;
|
|
my $matched = (defined $got && $got =~ $re) ? 1 : 0;
|
|
if ($matched) {
|
|
$passed++;
|
|
print "ok $label\n";
|
|
return 1;
|
|
}
|
|
$failed++;
|
|
print "FAIL $label\n got: " . (defined $got ? $got : 'undef') . "\n want: $re\n";
|
|
return 0;
|
|
}
|
|
|
|
# ---------------------------------------------------------------------------
|
|
# dnf-automatic configuration
|
|
# ---------------------------------------------------------------------------
|
|
|
|
# The renderer returns the lines and whether it changed anything, which is how its
|
|
# caller decides whether to write.
|
|
my @order = qw(upgrade_type apply_updates);
|
|
my ($rendered, $changed) = render_dnf_automatic_conf(
|
|
["[commands]\n", "# a comment\n", "upgrade_type = security\n"],
|
|
\@order,
|
|
{ upgrade_type => 'default', apply_updates => 'yes' },
|
|
);
|
|
my $text = join('', @$rendered);
|
|
is($changed, 1, 'dnf-automatic: a change is reported');
|
|
like($text, qr/^\[commands\]$/m, 'dnf-automatic: the section survives');
|
|
like($text, qr/^upgrade_type = default$/m, 'dnf-automatic: an existing key is updated');
|
|
like($text, qr/^apply_updates = yes$/m, 'dnf-automatic: a missing key is added');
|
|
like($text, qr/^# a comment$/m, 'dnf-automatic: a comment survives');
|
|
is(($text =~ /upgrade_type/g) + 0, 1, 'dnf-automatic: the key is written once');
|
|
|
|
my ($again, $unchanged) = render_dnf_automatic_conf($rendered, \@order,
|
|
{ upgrade_type => 'default', apply_updates => 'yes' });
|
|
is($unchanged, 0, 'dnf-automatic: an already correct file is reported unchanged');
|
|
is(join('', @$again), $text, 'dnf-automatic: an already correct file is reproduced exactly');
|
|
|
|
my ($fresh, $fresh_changed) = render_dnf_automatic_conf([], \@order, { upgrade_type => 'default' });
|
|
check(join('', @$fresh) !~ /^apply_updates = *$/m,
|
|
'dnf-automatic: a key with no desired value is not written empty');
|
|
my $fresh_text = join('', @$fresh);
|
|
is($fresh_changed, 1, 'dnf-automatic: a missing section is a change');
|
|
like($fresh_text, qr/^\[commands\]$/m, 'dnf-automatic: a missing section is created');
|
|
like($fresh_text, qr/^upgrade_type = default$/m, 'dnf-automatic: the key lands in it');
|
|
|
|
my ($unterminated, $unterminated_changed) = render_dnf_automatic_conf(
|
|
["[commands]\n", 'upgrade_type = security'],
|
|
\@order,
|
|
{ apply_updates => 'yes' },
|
|
);
|
|
my $unterminated_text = join('', @$unterminated);
|
|
is($unterminated_changed, 1, 'dnf-automatic: an appended key is a change');
|
|
like($unterminated_text, qr/^apply_updates = yes$/m,
|
|
'dnf-automatic: an unterminated last line does not swallow the new key');
|
|
check($unterminated_text !~ /securityapply_updates/,
|
|
'dnf-automatic: no key is glued onto another');
|
|
|
|
# ---------------------------------------------------------------------------
|
|
# os-release and error text
|
|
# ---------------------------------------------------------------------------
|
|
|
|
my $release = parse_os_release();
|
|
is(ref($release), 'HASH', 'os-release: a hash reference');
|
|
check(defined $release->{ID} && length $release->{ID}, 'os-release: the identifier is read');
|
|
check(defined $release->{VERSION_ID}, 'os-release: the version is read');
|
|
|
|
my $handle;
|
|
open($handle, '<', '/nonexistent/for-the-test');
|
|
my $error = os_error_text('/nonexistent/for-the-test');
|
|
like($error, qr/^\[Errno \d+\] .+: '\/nonexistent\/for-the-test'$/,
|
|
'error text: the errno, the reason and the path');
|
|
|
|
# ---------------------------------------------------------------------------
|
|
# Arguments
|
|
# ---------------------------------------------------------------------------
|
|
|
|
my @saved = @ARGV;
|
|
@ARGV = ('--dry-run', '--skip-firewall');
|
|
my %args = parse_args();
|
|
is($args{dry_run}, 1, 'args: --dry-run');
|
|
is($args{skip_firewall}, 1, 'args: --skip-firewall');
|
|
is($args{skip_packages}, 0, 'args: an unset skip stays off');
|
|
@ARGV = ();
|
|
my %defaults = parse_args();
|
|
is($defaults{dry_run}, 0, 'args: dry run is off by default');
|
|
@ARGV = @saved;
|
|
|
|
# ---------------------------------------------------------------------------
|
|
# The base package catalogue
|
|
# ---------------------------------------------------------------------------
|
|
|
|
# The proxy of the collection is caddy everywhere; nginx left the baseline when
|
|
# sglang-deploy.pl moved to Caddy, and the name survives only in its own legacy
|
|
# clean-up.
|
|
check((grep { $_ eq 'caddy' } base_packages()) == 1, 'packages: caddy is a base package');
|
|
check((grep { $_ eq 'nginx' } base_packages()) == 0, 'packages: nginx is not');
|
|
is(join('|', base_packages()),
|
|
'nano|curl|wget|htop|tmux|rsync|caddy|openssl|jq|fastfetch',
|
|
'packages: the whole list, in order');
|
|
my %openeuler_gaps = unpackaged_for('openeuler');
|
|
is(exists $openeuler_gaps{caddy} ? 'yes' : 'no', 'yes',
|
|
'packages: the openEuler gap is named in the unpackaged map');
|
|
is(scalar(unpackaged_for('fedora')) // 0, 0, 'packages: Fedora has no unpackaged entry');
|
|
is(scalar(unpackaged_for('centos')) // 0, 0,
|
|
'packages: CentOS Stream has no unpackaged entry, EPEL carries caddy');
|
|
|
|
# ---------------------------------------------------------------------------
|
|
# The command runner
|
|
# ---------------------------------------------------------------------------
|
|
|
|
is(wait_status_rc(0), 0, 'runner: a clean exit is rc 0');
|
|
is(wait_status_rc(2 << 8), 2, 'runner: the exit status is taken from bits 8-15');
|
|
is(wait_status_rc(9), 137, 'runner: a child killed by SIGKILL is not read as rc 0');
|
|
is(wait_status_rc(11), 139, 'runner: a child killed by a signal is never rc 0');
|
|
|
|
my $killed = run(['sh', '-c', 'kill -9 $$']);
|
|
is($killed->{rc}, 137, 'runner: run reports 128+signal for a killed child');
|
|
my $exited = run(['sh', '-c', 'exit 3']);
|
|
is($exited->{rc}, 3, 'runner: run reports the exit code of a child');
|
|
|
|
# ---------------------------------------------------------------------------
|
|
# EPEL: a present package with a disabled repository must be enabled, and a
|
|
# silent no-op must not be reported as success
|
|
# ---------------------------------------------------------------------------
|
|
|
|
{
|
|
no warnings 'redefine';
|
|
my ($epel_enabled, $enable_works, @seen);
|
|
|
|
my $fake_run = sub {
|
|
my ($cmd) = @_;
|
|
my $line = join ' ', @$cmd;
|
|
push @seen, $line;
|
|
if ($line eq 'dnf repolist --enabled') {
|
|
my $out = "repo id\trepo name\n";
|
|
$out .= "epel\tExtra Packages for Enterprise Linux\n" if $epel_enabled;
|
|
return { rc => 0, out => $out, err => '' };
|
|
}
|
|
return { rc => 0, out => "epel-release-10-0.noarch\n", err => '' }
|
|
if $line eq 'rpm -q epel-release';
|
|
return { rc => 0, out => '', err => '' }
|
|
if $line eq 'dnf config-manager --set-enabled crb';
|
|
if ($line eq 'dnf config-manager --set-enabled epel') {
|
|
if ($enable_works) {
|
|
$epel_enabled = 1;
|
|
return { rc => 0, out => '', err => '' };
|
|
}
|
|
return { rc => 1, out => '', err => 'failed' };
|
|
}
|
|
# Installing an already-present package is a successful no-op that
|
|
# leaves the repository switched off, which made the old path a false
|
|
# success.
|
|
return { rc => 0, out => '', err => '' }
|
|
if $line eq 'dnf install -y epel-release';
|
|
return { rc => 1, out => '', err => "unexpected command: $line" };
|
|
};
|
|
|
|
local *run = $fake_run;
|
|
|
|
($epel_enabled, $enable_works, @seen) = (0, 1);
|
|
my $ok_info = ensure_epel(0);
|
|
check(!$ok_info->{failed} && $epel_enabled,
|
|
'EPEL: a disabled repository is enabled when config-manager works');
|
|
check($ok_info->{installed}, 'EPEL: success is reported once the repository is enabled');
|
|
check((grep { /install / } @seen) == 0,
|
|
'EPEL: an installed package is enabled, not installed again');
|
|
|
|
($epel_enabled, $enable_works, @seen) = (0, 0);
|
|
my $fail_info = ensure_epel(0);
|
|
check($fail_info->{failed} && !$epel_enabled,
|
|
'EPEL: a repository that stays disabled is a failure, not a success');
|
|
|
|
($epel_enabled, $enable_works, @seen) = (0, 1);
|
|
ensure_epel(1);
|
|
check((grep { /set-enabled|install / } @seen) == 0,
|
|
'EPEL: a dry run issues no mutating command');
|
|
}
|
|
|
|
print "\n" . ($failed ? "$failed FAILED of " . ($passed + $failed) : "all $passed checks passed") . "\n";
|
|
exit($failed ? 1 : 0);
|