scripts/tests/workstation-setup.pl

#!/usr/bin/env perl
# Copyright (c) 2026 Petr Balvín <opensource@petrbalvin.org> (https://petrbalvin.org)
# SPDX-License-Identifier: MIT

# Checks for workstation-setup.pl: the JSON decoder, the architecture mapping, the
# checksum file reader, the atomic writer, the runner and user command helpers,
# the Brave repo pin, the IDE launcher links and the supported system set.
#
# Run from anywhere: perl tests/workstation-setup.pl

use strict;
use warnings;

my $root = $0 =~ m{^(.*)/[^/]+$} ? "$1/.." : '..';
$root = "./$root" if $root !~ m{^/};
require "$root/workstation-setup.pl";

my ($passed, $failed) = (0, 0);

sub is {
    my ($got, $want, $label) = @_;
    $got = 'undef' unless defined $got;
    $want = 'undef' unless defined $want;
    if ($got eq $want) {
        $passed++;
        print "ok   $label\n";
        return 1;
    }
    $failed++;
    print "FAIL $label\n     got:  $got\n     want: $want\n";
    return 0;
}

sub check {
    my ($cond, $label) = @_;
    return is($cond ? 1 : 0, 1, $label);
}

# ---------------------------------------------------------------------------
# JSON
# ---------------------------------------------------------------------------

my $decoded = json_decode('{"a":1,"b":[true,false,null],"c":"x\\ny","d":{"e":2.5}}');
is(ref($decoded), 'HASH', 'json: an object decodes to a hash');
is($decoded->{a}, 1, 'json: an integer');
is($decoded->{b}[0], 1, 'json: true is truthy');
is($decoded->{b}[1], 0, 'json: false is falsey');
is($decoded->{b}[2], undef, 'json: null is undef');
is($decoded->{c}, "x\ny", 'json: an escaped newline');
is($decoded->{d}{e}, 2.5, 'json: a nested float');

my $strings = json_decode('{"s":"a\"b\\\\c\/d\te","u":"\u0041\u00e9"}');
is($strings->{s}, "a\"b\\c/d\te", 'json: quotes, backslashes, a solidus and a tab');
is($strings->{u}, "A\xc3\xa9", 'json: a unicode escape becomes UTF-8 bytes');

my $numbers = json_decode('{"i":-12,"f":1e3,"z":0,"n":-0.5}');
is($numbers->{i}, -12, 'json: a negative integer');
is($numbers->{f}, 1000, 'json: an exponent');
is($numbers->{z}, 0, 'json: zero');
is($numbers->{n}, -0.5, 'json: a negative float');

my $empty = json_decode('[]');
is(ref($empty), 'ARRAY', 'json: an empty array');
is(scalar(@$empty), 0, 'json: an empty array has no elements');

my $whitespace = json_decode("  {\n  \"a\" :  1\n}  ");
is($whitespace->{a}, 1, 'json: whitespace around and inside is skipped');

# Malformed input dies with the offset, so a caller that cannot trust its input wraps
# the call; the test asserts that contract rather than a sentinel value.
for my $bad ('', '{', '[1,]', 'nope', '{"a":}') {
    my $died = eval { json_decode($bad); 1 } ? 0 : 1;
    is($died, 1, "json: malformed input dies (" . ($bad eq '' ? 'empty' : $bad) . ")");
}
my $reason = eval { json_decode('nope'); '' } || $@;
check($reason =~ /offset 0/, 'json: the death names the offset');

# ---------------------------------------------------------------------------
# Architecture
# ---------------------------------------------------------------------------

my $arch = go_arch();
check(!defined $arch || $arch =~ /^(amd64|arm64)$/,
    'arch: the machine maps to a Go architecture or to nothing');

my $tmp = "/tmp/workstation-test.$$";

my $sums = "$tmp.sums";
open(my $fh, '>', $sums) or die "cannot write $sums: $!\n";
print {$fh} 'a' x 64 . "  ./tool.tar.gz\n";
print {$fh} 'b' x 64 . "  other.tar.gz\n";
close($fh);
is(sha256_from_sums($sums, 'other.tar.gz'), 'b' x 64, 'sums: a name is found in the file');
is(sha256_from_sums($sums, 'missing.tar.gz'), undef, 'sums: a name that is absent yields nothing');
is(sha256_from_sums($sums, './tool.tar.gz'), 'a' x 64, 'sums: the name as listed is matched');
is(sha256_from_sums($sums, 'tool.tar.gz'), undef, 'sums: a name that is listed differently is not matched');
unlink($sums);
is(sha256_from_sums("$tmp.nothing", 'x'), undef, 'sums: a missing file yields nothing');

# ---------------------------------------------------------------------------
# Atomic writes
# ---------------------------------------------------------------------------

# atomic_write settles the owner, which for a new file is root, so it needs root to
# run; as an ordinary user the write is refused and the check is skipped rather than
# pretended.  The container runs exercise the real path.
my $target = "$tmp.target";
# The contract is a death on failure and no value on success, which is how every
# caller uses it: eval { atomic_write(...); 1 }.
if ($> == 0) {
    my $written = eval { atomic_write($target, "one\n"); 1 } ? 1 : 0;
    is($written, 1, 'atomic_write: a new file is written');
    is(slurp($target), "one\n", 'atomic_write: the content is there');
    $written = eval { atomic_write($target, "two\n"); 1 } ? 1 : 0;
    is($written, 1, 'atomic_write: an existing file is replaced');
    is(slurp($target), "two\n", 'atomic_write: the new content is there');
    check(!-e "$target.$$" . '.tmp', 'atomic_write: no temporary file is left behind');
    unlink($target);
}
else {
    my $died = eval { atomic_write($target, "one\n"); 1 } ? 0 : 1;
    is($died, 1, 'atomic_write: dies when it cannot own the target, as an ordinary user');
    check(!-e "$target.$$" . '.tmp', 'atomic_write: the temporary file is cleaned up');
}

# ---------------------------------------------------------------------------
# Arguments
# ---------------------------------------------------------------------------

my @saved = @ARGV;
@ARGV = ('--dry-run', '--skip-rpm', '--skip-go');
my %args = parse_args();
is($args{dry_run}, 1, 'args: --dry-run');
is($args{skip_rpm}, 1, 'args: --skip-rpm');
is($args{skip_go}, 1, 'args: --skip-go');
is($args{skip_update}, 0, 'args: an unset skip stays off');
@ARGV = ();
my %defaults = parse_args();
is($defaults{dry_run}, 0, 'args: dry run is off by default');
@ARGV = @saved;

# ---------------------------------------------------------------------------
# Command composition for the real user
# ---------------------------------------------------------------------------

{
    local $ENV{SUDO_USER};
    delete $ENV{SUDO_USER};
    is(join(' ', @{ user_command(['flatpak', 'info', '--user', 'org.example.App']) }),
        'flatpak info --user org.example.App',
        'user_command: without SUDO_USER the command itself is the whole list');
    my $direct = run_as_user(['/bin/echo', 'as-user']);
    is($direct->{out}, "as-user\n",
        'run_as_user: without SUDO_USER the command runs directly');
    $ENV{SUDO_USER} = 'someuser';
    is(join(' ', @{ user_command(['flatpak', 'uninstall', '-y', 'org.example.App']) }),
        'sudo -u someuser flatpak uninstall -y org.example.App',
        'user_command: SUDO_USER becomes a sudo -u prefix before the command');
    is(join(' ', @{ user_command(['rustup-init', '-y'],
            { RUSTUP_HOME => '/h', CARGO_HOME => '/c' }) }),
        'sudo -u someuser env CARGO_HOME=/c RUSTUP_HOME=/h rustup-init -y',
        'user_command: env assignments come sorted between env(1) and the command');
}

# ---------------------------------------------------------------------------
# Runner exit codes
# ---------------------------------------------------------------------------

is(run(['perl', '-e', 'exit 7'])->{rc}, 7, 'run: an exit code passes through');
is(run(['perl', '-e', q{kill 9, $$}])->{rc}, 137,
    'run: a child killed by a signal reports 128+signal, not success');

# ---------------------------------------------------------------------------
# Repo gpgkey pinning
# ---------------------------------------------------------------------------

my $repo_file = "$tmp.repo";
my $key_file = "$tmp.key";
open(my $key_out, '>', $key_file) or die "cannot write $key_file: $!\n";
print {$key_out} "verified key material\n";
close($key_out);
open(my $repo_out, '>', $repo_file) or die "cannot write $repo_file: $!\n";
print {$repo_out} "[brave-browser]\nbaseurl=https://example.com/brave/x86_64/\n"
    . "\ngpgkey=https://example.com/brave-core.asc\nenabled=1\n";
close($repo_out);
is(pin_brave_repo_gpgkey($repo_file, $key_file), 1,
    'pin: a URL gpgkey is pinned to the local key file');
my $pinned_content = slurp($repo_file);
check(index($pinned_content, "gpgkey=file://$key_file") >= 0,
    'pin: the gpgkey line points at the key file');
check(index($pinned_content, 'baseurl=https://example.com/brave/x86_64/') >= 0,
    'pin: the untouched lines survive the rewrite');
check($pinned_content =~ /\n\n/, 'pin: a blank line survives the rewrite');
is(pin_brave_repo_gpgkey($repo_file, $key_file), 1,
    'pin: an already pinned file is left as it is');
unlink($repo_file);
is(pin_brave_repo_gpgkey($repo_file, $key_file), 0,
    'pin: a missing repo file fails without dying');
unlink($key_file);

# ---------------------------------------------------------------------------
# JetBrains launcher links
# ---------------------------------------------------------------------------

my $ide_home = "$tmp.ide";
my $ide_bin = "$ide_home/bin";
my $ide_desktop = "$ide_home/applications";
make_dirs($ide_bin) or die "cannot create $ide_bin\n";
for my $dir ("$ide_home/GoLand-2026.1", "$ide_home/GoLand-2026.2") {
    make_dirs("$dir/bin") or die "cannot create $dir/bin\n";
    my $launcher = "$dir/bin/goland.sh";
    open(my $launch_out, '>', $launcher) or die "cannot write $launcher: $!\n";
    close($launch_out);
    chmod(0755, $launcher);
}
is(jetbrains_links('GoLand', "$ide_home/GoLand-2026.1", $ide_bin, $ide_desktop), 1,
    'ide links: an install with a launcher gets its links');
is(readlink("$ide_bin/goland") // '', "$ide_home/GoLand-2026.1/bin/goland.sh",
    'ide links: the symlink points at the launcher');
is(jetbrains_links('GoLand', "$ide_home/GoLand-2026.2", $ide_bin, $ide_desktop), 1,
    'ide links: a newer install repoints the symlink');
is(readlink("$ide_bin/goland") // '', "$ide_home/GoLand-2026.2/bin/goland.sh",
    'ide links: the symlink follows the newer launcher');
is(jetbrains_links('GoLand', "$ide_home/GoLand-0.0.0", $ide_bin, $ide_desktop), 0,
    'ide links: a missing launcher fails the links');
if ($> == 0) {
    my $entry = slurp("$ide_desktop/jetbrains-goland.desktop");
    check(index($entry, "Exec=\"$ide_home/GoLand-2026.2/bin/goland.sh\"") >= 0,
        'ide links: the menu entry names the launcher');
}
remove_tree($ide_home);

# ---------------------------------------------------------------------------
# Supported systems
# ---------------------------------------------------------------------------

# The supported set is a lexical in the script, so its contract is checked
# through the usage text the set builds: Fedora advertised, nothing else.
check(index(usage(), 'workstation setup for Fedora') >= 0 && index(usage(), 'openEuler') < 0,
    'usage: only Fedora is advertised');

print "\n" . ($failed ? "$failed FAILED of " . ($passed + $failed) : "all $passed checks passed") . "\n";
exit($failed ? 1 : 0);