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

# Idempotent SGLang deployment for AMD ROCm GPUs.
#
# SGLang behind nginx with self-signed TLS on Fedora, CentOS Stream or openEuler.
# The engine binds to ::1 (IPv4 loopback fallback) on port 8000, internal only;
# nginx proxies :443 to the loopback upstream with streaming (SSE) support.  The
# endpoint requires an API key, delivered to the service through a 0600
# EnvironmentFile; nginx to engine proxying is allowed through SELinux on enforcing
# systems.
#
# Why the engine runs in a container rather than straight on the host:
#
# SGLang publishes no ROCm wheel at all: the AMD install paths are the project's own
# container
# images and a source build against a full ROCm toolchain (llvm, hipcc, cmake, maturin,
# Rust), which Fedora carries only partly and which CentOS Stream and openEuler, where
# ROCm itself is unsupported by AMD, cannot carry at all.  Both AMD and SGLang document
# the container as the way to run SGLang on ROCm, so the container is what this script
# deploys: podman runs the official image, and the host keeps nginx, TLS, the API key,
# the firewall and the SELinux boolean.  The host needs no ROCm userland, only the
# amdgpu kernel driver and its device nodes, /dev/kfd and /dev/dri.
#
# Radeon cards: the project publishes no stable image for gfx1151 (Strix Halo, the
# Radeon 8060S and 8050S), so AMD's dated development builds are resolved instead, the
# newest per release.  A rerun therefore takes a newer build once AMD publishes one and
# restarts the service onto it; --image pins one build.  Every other Radeon card has no
# published image at all and is refused with the build recipe.
#
# Model cache: the container's /root/.cache/modelscope is bound to
# <state-dir>/modelscope and relabelled with :Z, so model weights survive
# redeployment and an SELinux-enforcing host can still read them.
#
# Equivalent launch arguments: this script keeps the familiar --tensor-parallel,
# --max-model-len and --gpu-memory-utilization names and writes them to the engine
# as SGLang's --tp-size, --context-length and --mem-fraction-static.
#
# Perl builtins only: no module has to be installed.  One piece of work Perl does
# not carry as a builtin is written out here, the command runner, which forks and
# keeps stdout and stderr apart in the scratch directory.
#
# External binaries used: dnf, rpm, curl, podman, lspci, openssl, systemctl,
# getenforce, getsebool, setsebool, firewall-cmd and nginx.
#
# Usage:
#     sglang-deploy.pl                                          # interactive model selection
#     sglang-deploy.pl --model ZhipuAI/GLM-5.3                   # deploy a specific model
#     sglang-deploy.pl --model ZhipuAI/GLM-5.3 --dry-run         # preview
#     sglang-deploy.pl --uninstall                               # tear down
#     sglang-deploy.pl --image lmsysorg/sglang:v0.5.19-rocm720-mi30x
#     sglang-deploy.pl --version

use strict;
use warnings;

my $VERSION = '2.0.0';

my $BOLD   = "\033[1m";
my $RED    = "\033[31m";
my $GREEN  = "\033[32m";
my $YELLOW = "\033[33m";
my $DIM    = "\033[2m";
my $RESET  = "\033[0m";

# Package installation and an image pull of tens of gigabytes both outlive a
# generic timeout by a wide margin.
my $DNF_TIMEOUT  = 600;
my $PULL_TIMEOUT = 3600;

# Supported systems, in the order the messages list them.
my @SUPPORTED_ORDER = ('fedora', 'centos', 'openeuler');
my %SUPPORTED_OS = (
    fedora    => 'Fedora',
    centos    => 'CentOS Stream',
    openeuler => 'openEuler',
);

# Tools this script itself needs.  podman is the engine's runtime: SGLang ships no
# ROCm wheel, so the server runs from the project's own ROCm image.
my @DNF_PACKAGES = qw(pciutils curl openssl podman);

# Packages the engine expects from server-setup.pl (warning only, not installed here).
my @REQUIRED_SERVER_PACKAGES = (['nginx', 'reverse proxy']);

# Default models for interactive selection when --model is omitted, keyed by
# display name.  Every ID is a ModelScope repository, which is where the engine
# downloads weights from (SGLANG_USE_MODELSCOPE), and all five were verified to
# exist there as of 2026-09.  Two display names hide technical release names,
# deliberately: Qwen 3.8 Max ships its weights as Qwen3.8-2.4T-A95B and
# Qwen 3.8 Flash as Qwen3.8-Flash-Next, while the shorter names belong to the
# QwenCloud API.  The GLM repositories sit under ZhipuAI on ModelScope, which is
# not the zai-org namespace Hugging Face uses.
my %DEFAULT_MODELS = (
    'GLM 5.3'             => 'ZhipuAI/GLM-5.3',
    'GLM 5.3 Flash'       => 'ZhipuAI/GLM-5.3-Flash',
    'Qwen 3.8 Max'        => 'Qwen/Qwen3.8-2.4T-A95B',
    'Qwen 3.8 Flash'      => 'Qwen/Qwen3.8-Flash-Next',
    'DeepSeek V4.1 Flash' => 'deepseek-ai/DeepSeek-V4.1-Flash',
);
# The menu order, which is the order the models are listed in above: selection 1 has
# to stay GLM 5.3, so this list is written out rather than taken from the hash.
my @DEFAULT_MODEL_ORDER = (
    'GLM 5.3', 'GLM 5.3 Flash', 'Qwen 3.8 Max', 'Qwen 3.8 Flash',
    'DeepSeek V4.1 Flash',
);

# Reverse lookup: ModelScope model ID to display name.
my %MODEL_NAMES = map { $DEFAULT_MODELS{$_} => $_ } keys %DEFAULT_MODELS;

# Test-visible accessors: the catalogue is lexical to this file, so the checks
# under tests/ read the menu through these rather than through the variables.
sub default_model_order { return @DEFAULT_MODEL_ORDER; }
sub default_model_repo  { my ($name) = @_; return $DEFAULT_MODELS{$name}; }

# Release resolution, per the SGLang AMD documentation: the images are tagged with
# the release branch (v0.5.19), a ROCm flavour and the GPU family.  The newest
# release tag is read from the GitHub API; the constant below is the fallback.
my $RELEASES_API           = 'https://api.github.com/repos/sgl-project/sglang/releases/latest';
my $FALLBACK_ENGINE_VERSION = 'v0.5.19';

# Fully qualified on purpose: podman refuses a short name without a terminal, and a
# systemd unit has no terminal.
my $IMAGE_REPO     = 'docker.io/lmsysorg/sglang';
my $IMAGE_HUB_REPO = 'lmsysorg/sglang';    # the same repository on Docker Hub

# A Radeon card has no stable tag in the project's repository.  AMD publishes dated
# development builds of the same release under its own image instead, and that is what
# this script resolves for a Strix Halo card (gfx1151, the Radeon 8060S and 8050S).
# Only the rocm724 flavour is published for it.
my $RADEON_DEV_REPO     = 'docker.io/rocm/sgl-dev';
my $RADEON_DEV_HUB_REPO = 'rocm/sgl-dev';
my $RADEON_DEV_FLAVOUR  = 'rocm724';

# GPU family, as the image tags name it.  The descriptions come from lspci, so the
# marketing name in the device description decides, never a device-ID table.
my $STRIX_HALO_RE = qr/\bStrix Halo\b|\bRadeon 80[56]0S\b/i;
my @ARCH_VARIANTS = (
    [qr/\bMI3(?:00|25)/i => 'mi30x'],    # gfx942: MI300A, MI300X, MI325X
    [qr/\bMI3(?:50|55)/i => 'mi35x'],    # gfx950: MI350X, MI355X
    [$STRIX_HALO_RE      => 'gfx1151'],  # gfx1151: Strix Halo, Radeon 8060S, 8050S
);
# The repository each family is published under.
my %IMAGE_REPO_FOR = (
    mi30x   => $IMAGE_REPO,
    mi35x   => $IMAGE_REPO,
    gfx1151 => $RADEON_DEV_REPO,
);

# ROCm flavours the images are published in, newest first, with the userland version
# each one carries.  The container's ROCm userland must not be newer than the host's
# kernel driver, so the newest flavour that does not exceed the host ROCm is chosen.
my @ROCM_FLAVOURS = (
    ['rocm10',  '10.0.0'],
    ['rocm724', '7.2.4'],
    ['rocm720', '7.2.0'],
    ['rocm700', '7.0.0'],
);
my $NEWEST_ROCM_FLAVOUR = 'rocm10';

# The AMD ROCm documentation for SGLang on Radeon cards requires AITER off and the
# fused decode MLA kernel unset: both are on by default and some workloads fail with
# them.  The engine reads them from the environment, so they go into the unit file.
my @RADEON_ENV = (
    'SGLANG_USE_AITER=false',
    'SGLANG_ROCM_FUSED_DECODE_MLA=false',
);

# Deployment layout.
my $CONTAINER_NAME   = 'sglang';
my $DEFAULT_STATE_DIR = '/opt/sglang';
my $CACHE_SUBDIR     = 'modelscope';
my $CACHE_MOUNT      = '/root/.cache/modelscope';
my $DEFAULT_CERT_DIR = '/etc/ssl/sglang';
my $DEFAULT_SERVICE  = 'sglang';
my $INTERNAL_PORT    = 8000;

# ModelScope model IDs look like "org/name", the same shape Hugging Face uses.
# The strict pattern also keeps systemd specifier characters (%) and whitespace
# out of unit files.
my $MODEL_ID_RE = qr{^[A-Za-z0-9._-]+/[A-Za-z0-9._-]+$};

my $TMP_DIR;           # private scratch directory, created only when needed
my $PARENT_PID = $$;   # a forked child must never clean up for the parent
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;
}

sub _info {
    my ($msg) = @_;
    print STDERR "  ${DIM}$msg$RESET\n";
    return;
}

sub _warn {
    my ($msg) = @_;
    print STDERR "  ${YELLOW}⚠ $msg$RESET\n";
    return;
}

sub _ok {
    my ($msg) = @_;
    print STDERR "  ${GREEN}✓ $msg$RESET\n";
    return;
}

sub _fail {
    my ($msg) = @_;
    print STDERR "  ${RED}✗ $msg$RESET\n";
    return;
}

# ---------------------------------------------------------------------------
# Commands, files and small helpers
# ---------------------------------------------------------------------------

# A hand-rolled which(1), so that the lookup itself needs no external binary.
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/sglang-deploy.$$" . ($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;
    # Only the process that created the directory may remove it: a forked child
    # inherits the END block.
    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 : '';
}

sub write_file {
    my ($path, $content) = @_;
    open(my $fh, '>', $path) or return 0;
    # The flush of a buffered handle surfaces at close, so close is checked too:
    # a full disk must not report a truncated unit file or nginx configuration
    # as written.
    my $ok = print {$fh} $content;
    $ok = 0 unless close($fh);
    return $ok ? 1 : 0;
}

# Run a command and return { rc, out, err }.
#
# The locale is forced to C for English output parsing.  A timeout, a missing binary
# and a failed exec become rc 124, 127 and 126 rather than exceptions, so callers
# always have a result to inspect.
sub run {
    my ($cmd, %opt) = @_;
    my $timeout = $opt{timeout} // 60;

    my $exe = find_exe($cmd->[0]);
    return { rc => 127, out => '', err => "command not found: $cmd->[0]" } 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 {
        # A child killed by a signal must not look like success: $? >> 8 is 0
        # for a signalled exit, so the signal becomes a shell-style 128+n code.
        my $signal = $? & 127;
        $rc = $signal ? 128 + $signal : ($? >> 8);
    }

    my $out = slurp($out_file);
    my $err = slurp($err_file);
    unlink($out_file, $err_file);
    return {
        rc  => $rc,
        out => $out,
        err => $timed_out ? "timed out after ${timeout}s" : $err,
    };
}

# The errno, the reason and the path, so a failure message names all three.
sub os_error_text {
    my ($path) = @_;
    return "[Errno " . (0 + $!) . "] $!: '$path'";
}

# ---------------------------------------------------------------------------
# System detection
# ---------------------------------------------------------------------------

sub parse_os_release {
    my %release;
    open(my $fh, '<', '/etc/os-release') or return %release;
    while (my $line = <$fh>) {
        $line =~ s/^\s+//;
        $line =~ s/\s+$//;
        next if $line eq '' || $line =~ /^#/;
        my ($key, $value) = split /=/, $line, 2;
        next unless defined $value;
        $value =~ s/^\s+//;
        $value =~ s/\s+$//;
        $value =~ s/^"//;
        $value =~ s/"$//;
        $value =~ s/^'//;
        $value =~ s/'$//;
        $release{$key} = $value;
    }
    close($fh);
    return %release;
}

sub detect_os {
    my %release = parse_os_release();
    my $os_id = lc($release{ID} // '');
    my $version_id = $release{VERSION_ID} // 'unknown';

    if (!exists $SUPPORTED_OS{$os_id}) {
        print STDERR "${RED}${BOLD}Error:${RESET} Unsupported operating system: ",
            "'", ($release{ID} // 'unknown'), "' (detected from /etc/os-release).\n";
        print STDERR "  Supported systems: ", join(', ', map { $SUPPORTED_OS{$_} } @SUPPORTED_ORDER), "\n";
        exit 1;
    }

    return ($os_id, $SUPPORTED_OS{$os_id}, $version_id);
}

sub check_root {
    my $uid = $>;
    if ($uid != 0) {
        print STDERR "${RED}${BOLD}Error:${RESET} This script must be run as root (UID 0).\n";
        print STDERR "  Current UID: $uid. Try: sudo perl sglang-deploy.pl --model ...\n";
        exit 1;
    }
    return;
}

# ---------------------------------------------------------------------------
# Idempotency helpers
# ---------------------------------------------------------------------------

sub systemctl_is_active {
    my ($service) = @_;
    return run(['systemctl', 'is-active', '--quiet', $service], timeout => 15)->{rc} == 0;
}

sub systemctl_is_enabled {
    my ($service) = @_;
    return run(['systemctl', 'is-enabled', '--quiet', $service], timeout => 15)->{rc} == 0;
}

sub rpm_installed {
    my ($pkg) = @_;
    return run(['rpm', '-q', $pkg], timeout => 30)->{rc} == 0;
}

sub podman_container_exists {
    my ($name) = @_;
    return run(['podman', 'container', 'exists', $name], timeout => 30)->{rc} == 0;
}

sub podman_image_exists {
    my ($image) = @_;
    return run(['podman', 'image', 'exists', $image], timeout => 30)->{rc} == 0;
}

# ---------------------------------------------------------------------------
# GPU, ROCm and image resolution helpers
# ---------------------------------------------------------------------------

# Return AMD/ATI GPU descriptions from lspci -nn (empty list when none).
#
# Only VGA/3D/Display controller class lines with the AMD/ATI vendor ID (1002) match,
# so the AMD chipset, audio and USB lines found on AMD-CPU systems are ignored.
sub detect_amd_gpus {
    my $lspci = find_exe('lspci');
    if (!defined $lspci) {
        _fail("lspci not found: pciutils should have been installed in the dependencies step");
        exit 1;
    }
    my $result = run([$lspci, '-nn'], timeout => 30);
    if ($result->{rc} != 0) {
        my $err = $result->{err};
        $err =~ s/\s+$//;
        _fail("lspci -nn failed: $err");
        exit 1;
    }

    my @gpu_classes = ('VGA compatible controller', '3D controller', 'Display controller');
    my @gpus;
    for my $line (split /\n/, $result->{out}) {
        next unless index($line, '[1002:') >= 0;
        my $is_gpu = 0;
        for my $cls (@gpu_classes) {
            if (index($line, $cls) >= 0) { $is_gpu = 1; last; }
        }
        next unless $is_gpu;
        if (index($line, ': ') >= 0) {
            $line =~ s/^.*?: //;
        }
        $line =~ s/^\s+//;
        $line =~ s/\s+$//;
        push @gpus, $line;
    }
    return @gpus;
}

# Map a GPU description to the image's GPU family, or undef when no published image
# matches.  Radeon cards are deliberately unmapped: the project publishes no stable
# Radeon tag, only dated development builds under AMD's own repository.
sub arch_variant {
    my ($gpus) = @_;
    for my $gpu (@$gpus) {
        for my $entry (@ARCH_VARIANTS) {
            my ($pattern, $variant) = @$entry;
            return $variant if $gpu =~ $pattern;
        }
    }
    return undef;
}

sub radeon_present {
    my ($gpus) = @_;
    for my $gpu (@$gpus) {
        next if $gpu =~ /\bMI3/;
        next if $gpu =~ $STRIX_HALO_RE;    # AMD publishes gfx1151 builds
        return 1 if $gpu =~ /\bRadeon\b/i;
    }
    return 0;
}

# A card no published family matches is fatal only when the image would be
# resolved from that family: --image is the documented escape for exactly those
# cards, so with it the family is informational and never fatal.
sub family_is_fatal {
    my ($variant, $image_opt) = @_;
    return 0 if defined $variant;
    return $image_opt ? 0 : 1;
}

# The Radeon defaults apply to the family the deployed image targets: gfx1151,
# or a custom image on a host no published family matches.  A Radeon that only
# drives the display next to an Instinct does not switch the Instinct off its
# optimisations.
sub radeon_env_for {
    my ($variant, $is_radeon) = @_;
    my $targets_radeon = defined $variant ? $variant eq 'gfx1151' : $is_radeon;
    return $targets_radeon ? [@RADEON_ENV] : [];
}

# The installed ROCm userland version (e.g. '7.2.4'), or undef when the host has none.
# A host running only the container needs no ROCm at all, which is why this is
# informational: it selects the image flavour and is reported, never required.
sub detect_rocm_version {
    if (-f '/opt/rocm/.info/version') {
        my $text = slurp('/opt/rocm/.info/version');
        $text =~ s/^\s+//;
        $text =~ s/\s+$//;
        my ($version) = split /-/, $text;
        return $version if defined $version && length $version;
    }
    # Fedora's native packages install into /usr (no /opt/rocm).
    my $rpm = run(['rpm', '-q', '--qf', '%{VERSION}', 'rocm-runtime'], timeout => 30);
    if ($rpm->{rc} == 0 && $rpm->{out} =~ /\S/) {
        my $version = $rpm->{out};
        $version =~ s/^\s+//;
        $version =~ s/\s+$//;
        return $version;
    }
    my $smi = find_exe('rocm-smi');
    if (defined $smi) {
        my $result = run([$smi, '--version'], timeout => 30);
        my $banner = $result->{out} . $result->{err};
        if ($banner =~ /(\d+\.\d+(?:\.\d+)?)/) {
            return $1;
        }
    }
    return undef;
}

# Compare two dotted numeric versions: -1, 0 or 1.
sub version_cmp {
    my ($left, $right) = @_;
    my @a = split /\./, $left;
    my @b = split /\./, $right;
    my $len = @a > @b ? scalar @a : scalar @b;
    for my $i (0 .. $len - 1) {
        my $x = $i < @a ? $a[$i] : 0;
        my $y = $i < @b ? $b[$i] : 0;
        $x = 0 unless $x =~ /^\d+$/;
        $y = 0 unless $y =~ /^\d+$/;
        return $x <=> $y if $x != $y;
    }
    return 0;
}

# The newest published flavour whose userland is not newer than the host's ROCm, or
# undef when the host ROCm predates every published image.
sub select_rocm_flavour {
    my ($rocm_version) = @_;
    for my $entry (@ROCM_FLAVOURS) {
        my ($flavour, $version) = @$entry;
        return $flavour if version_cmp($version, $rocm_version) <= 0;
    }
    return undef;
}

# Fetch a URL as text via curl -fsSL; the empty string on failure (with a warning).
sub fetch_text {
    my ($url, $timeout) = @_;
    $timeout //= 30;
    my $curl = find_exe('curl');
    if (!defined $curl) {
        _warn("curl not found: cannot fetch remote version information");
        return '';
    }
    my $result = run([$curl, '-fsSL', '-A', "sglang-deploy/$VERSION", $url], timeout => $timeout);
    if ($result->{rc} != 0) {
        _warn("Failed to fetch $url (curl exit $result->{rc})");
        return '';
    }
    return $result->{out};
}

# Resolve the newest SGLang release tag ('v0.5.19'), from the GitHub API with the
# tag list and then a constant as fallbacks.  The charset bound on both patterns
# keeps whatever the API answers out of the image reference and the unit file,
# where whitespace and % are refused.
sub resolve_engine_version {
    my $listing = fetch_text($RELEASES_API);
    if ($listing =~ /"tag_name"\s*:\s*"(v\d+\.\d+\.\d+[A-Za-z0-9._-]*)"/) {
        return $1;
    }
    my $tags = fetch_text('https://api.github.com/repos/sgl-project/sglang/tags?per_page=20');
    if ($tags =~ /"name"\s*:\s*"(v\d+\.\d+\.\d+[A-Za-z0-9._-]*)"/) {
        return $1;
    }
    _warn("Could not resolve the newest SGLang release: using the fallback pin "
        . "$FALLBACK_ENGINE_VERSION");
    return $FALLBACK_ENGINE_VERSION;
}

# Does the tag exist on Docker Hub?  1 yes, 0 no, undef when it cannot be told.
sub image_tag_published {
    my ($hub_repo, $tag) = @_;
    my $curl = find_exe('curl');
    return undef unless defined $curl;
    my $url = "https://hub.docker.com/v2/repositories/$hub_repo/tags/$tag";
    # Only a definitive 404 says the tag is unpublished.  Rate limiting (429)
    # and server errors answer with other codes, and with curl -f they would
    # be indistinguishable from a missing tag, so the code is read instead.
    my $result = run(
        [$curl, '-sS', '-o', '/dev/null', '-w', '%{http_code}', $url],
        timeout => 30,
    );
    return undef if $result->{rc} != 0;
    my $code = $result->{out};
    $code =~ s/^\s+//;
    $code =~ s/\s+$//;
    return 1    if $code =~ /^2/;
    return 0    if $code eq '404';
    return undef;
}

sub resolve_image {
    my ($repo, $engine_version, $variant, $flavour) = @_;
    return "$repo:$engine_version-$flavour-$variant";
}

# The newest dated development build AMD published for a Strix Halo card, or the empty
# string when the index cannot be read.  The tags carry the release, the flavour, the
# family and the build date (v0.5.19-rocm724-gfx1151-20260916).  The ordering is
# passed explicitly so the first answer is the newest build without relying on the
# endpoint's default.
sub resolve_radeon_dev_tag {
    my ($engine_version) = @_;
    my $prefix = "$engine_version-$RADEON_DEV_FLAVOUR-gfx1151";
    my $url = "https://hub.docker.com/v2/repositories/$RADEON_DEV_HUB_REPO/tags"
        . "?page_size=5&name=$prefix&ordering=last_updated";
    my $listing = fetch_text($url);
    if ($listing =~ /"name"\s*:\s*"(\Q$prefix\E-\d{8})"/) {
        return $1;
    }
    return '';
}

# Probe ModelScope for the model: 'ok', 'missing', or 'unknown'.
#
# Only a definitive 404 ('missing') is fatal; network problems yield 'unknown' so
# offline environments are not blocked.  The API answer carries no gated signal,
# so a repository that needs a token surfaces at the first start instead, which
# MODELSCOPE_TOKEN in the unit's environment solves.
sub ms_model_status {
    my ($model) = @_;
    my $curl = find_exe('curl');
    return 'unknown' unless defined $curl;
    my $url = "https://modelscope.cn/api/v1/models/$model";
    my $result = run(
        [$curl, '-sS', '-A', "sglang-deploy/$VERSION", '-o', '-',
            '-w', "\n__HTTP__%{http_code}\n", $url],
        timeout => 15,
    );
    return 'unknown' if $result->{rc} != 0;
    my $body = $result->{out};
    my $code = '';
    if ($body =~ s/\n__HTTP__(\d{3})\n\s*$//) {
        $code = $1;
    }
    return 'missing' if $code eq '404';
    return 'unknown' if $code !~ /^2/;
    # An existing repository answers with its document, whose Name field names it;
    # a hit without a name is treated as no answer at all.
    return 'ok' if $body =~ /"Name"\s*:\s*"[^"]+"/;
    return 'unknown';
}

# Return (bind_host, nginx_upstream_host): IPv6 ::1 first.
#
# Falls back to 127.0.0.1 on kernels with IPv6 disabled
# (net.ipv6.conf.all.disable_ipv6=1), where binding ::1 would fail.
sub detect_loopback {
    if (-e '/proc/net/if_inet6') {
        return ('::1', '[::1]');
    }
    return ('127.0.0.1', '127.0.0.1');
}

# The host's fully qualified name, or the short name when the resolver has no
# FQDN for this host.  The hostname(1) binary is only an accelerator: the
# kernel's own name is read when it is missing, so a minimal installation works.
sub host_fqdn {
    my $hostname = find_exe('hostname');
    if (defined $hostname) {
        my $result = run([$hostname, '-f'], timeout => 15);
        my $fqdn = $result->{out};
        $fqdn =~ s/^\s+//;
        $fqdn =~ s/\s+$//;
        return $fqdn if length $fqdn;
    }
    return host_name();
}

sub host_name {
    my $name = slurp('/proc/sys/kernel/hostname');
    $name =~ s/\s+$//;
    return $name if length $name;
    my $hostname = find_exe('hostname');
    return '' unless defined $hostname;
    my $result = run([$hostname], timeout => 15);
    $name = $result->{out};
    $name =~ s/^\s+//;
    $name =~ s/\s+$//;
    return $name;
}

# Build a subjectAltName value from the host FQDN and primary IPv4 (if resolvable).
#
# openssl rejects an extension whose value is empty, so an entry is only added when it
# carries something, and localhost is the last resort for a host that cannot name
# itself at all.
sub cert_san {
    my $fqdn = host_fqdn();
    my $hostname = host_name();

    my @entries;
    push @entries, "DNS:$fqdn" if length $fqdn;
    push @entries, "DNS:$hostname" if length $hostname && $hostname ne $fqdn;
    if (length $fqdn) {
        my $addr = gethostbyname($fqdn);
        if (defined $addr) {
            my $dotted = join('.', unpack('C4', $addr));
            if ($dotted !~ /^127\./) {
                push @entries, "IP:$dotted";
            }
        }
    }
    push @entries, 'DNS:localhost' unless @entries;
    return join(',', @entries);
}

# ---------------------------------------------------------------------------
# 1. System dependencies
# ---------------------------------------------------------------------------

sub install_system_deps {
    my ($dry_run) = @_;
    my %results = (installed => [], skipped => [], failed => []);

    my @missing;
    for my $pkg (@DNF_PACKAGES) {
        if (rpm_installed($pkg)) {
            push @{ $results{skipped} }, $pkg;
        }
        else {
            push @missing, $pkg;
        }
    }

    if (!@missing) {
        _info("All " . scalar(@DNF_PACKAGES) . " packages already installed");
    }
    else {
        _status("Installing " . scalar(@missing) . " package(s): " . join(', ', @missing));
        if ($dry_run) {
            _status_done('dry run');
            $results{installed} = [@missing];
        }
        else {
            my $result = run(['dnf', 'install', '-y', @missing], timeout => $DNF_TIMEOUT);
            if ($result->{rc} == 0) {
                $results{installed} = [@missing];
                _status_done('ok');
            }
            else {
                _status_done('failed');
                $results{failed} = [@missing];
                my $err = $result->{err};
                $err =~ s/\s+$//;
                _info("dnf stderr: $err") if length $err;
            }
        }
    }

    # The engine's runtime.  A missing podman is not fatal here: the pull step reports
    # it, and the container simply cannot start without it.
    _status('Checking podman');
    my $podman = find_exe('podman');
    if (defined $podman) {
        my $result = run([$podman, '--version'], timeout => 30);
        my $version = $result->{out};
        $version =~ s/^\s+//;
        $version =~ s/\s+$//;
        _status_done($version ne '' ? $version : 'installed');
        $results{podman} = $version ne '' ? $version : 'installed';
    }
    elsif ($dry_run) {
        _status_done('would install');
        $results{podman} = 'dry run';
    }
    else {
        _status_done('not found');
        $results{podman} = undef;
        _fail('podman is not installed: the engine runs as a container and cannot start');
    }

    # Packages expected from server-setup.pl (warning only, not installed here).
    for my $entry (@REQUIRED_SERVER_PACKAGES) {
        my ($pkg, $purpose) = @$entry;
        if (!rpm_installed($pkg)) {
            _warn("$pkg ($purpose) is not installed: run server-setup.pl first");
        }
    }

    return \%results;
}

# ---------------------------------------------------------------------------
# 2. Pre-flight checks
# ---------------------------------------------------------------------------

sub preflight_checks {
    my ($os_id, $version_id, $argv) = @_;
    my %results;

    # Root (idempotent no-op: main() already checked; keeps the status line).
    _status('Checking root privileges');
    check_root();
    _status_done('root');

    # OS (already detected by main for the header).
    _status('Detecting operating system');
    _status_done("$SUPPORTED_OS{$os_id} $version_id");
    $results{os_id} = $os_id;
    $results{os_display} = $SUPPORTED_OS{$os_id};
    $results{version_id} = $version_id;

    # AMD GPU hardware, class and vendor filtered, so AMD chipsets never match.
    _status('Checking GPU hardware');
    my @gpus = detect_amd_gpus();
    if (!@gpus) {
        _status_done('not found');
        print STDERR "\n  ${RED}${BOLD}Error:${RESET} No AMD GPU detected in this system. ",
            "SGLang on ROCm requires an AMD GPU.\n";
        exit 1;
    }
    if (@gpus == 1) {
        _status_done($gpus[0]);
    }
    else {
        _status_done("$gpus[0] (+" . (scalar(@gpus) - 1) . " more)");
    }
    $results{gpu_models} = [@gpus];
    $results{gpu_count} = scalar @gpus;

    # Kernel driver and its device nodes: the engine is a container, so the host
    # carries the driver, never the ROCm userland.  The nodes are the material fact,
    # and the driver creates them; the module directory is only a hint about why they
    # are missing, since a container's /sys may not show it.
    _status('Checking the amdgpu kernel driver');
    my @missing_nodes = grep { !-e $_ } ('/dev/kfd', '/dev/dri');
    if (@missing_nodes) {
        _status_done('not ready');
        print STDERR "\n  ${RED}${BOLD}Error:${RESET} The amdgpu kernel driver is not ready: ",
            "missing device node(s): ", join(', ', @missing_nodes), ".\n";
        if (!-d '/sys/module/amdgpu') {
            print STDERR "  The amdgpu kernel module is not loaded either.\n";
        }
        print STDERR "  The container reaches the GPU through /dev/kfd and /dev/dri, which the\n";
        print STDERR "  driver creates. Install the AMD GPU driver for this distribution, load it\n";
        print STDERR "  and re-run.\n";
        exit 1;
    }
    _status_done('present (/dev/kfd, /dev/dri)');

    # ROCm userland, when the host happens to have one: it selects the image flavour.
    _status('Checking ROCm installation');
    my $rocm_version = detect_rocm_version();
    if (defined $rocm_version) {
        _status_done("present ($rocm_version)");
        $results{rocm} = 1;
    }
    else {
        _status_done('not installed (not needed, the image carries it)');
        $results{rocm} = 0;
    }
    $results{rocm_version} = $rocm_version;

    # GPU family from the lspci description, for the image tag.  A card with no
    # published family is fatal only when the image is resolved from the family:
    # --image is the documented escape for such cards.
    my $variant = arch_variant(\@gpus);
    my $is_radeon = radeon_present(\@gpus);
    my $custom_image = defined $argv->{image} && length $argv->{image};
    if (family_is_fatal($variant, $custom_image)) {
        if ($is_radeon) {
            print STDERR "\n  ${RED}${BOLD}Error:${RESET} Radeon card detected, and neither ",
                "SGLang nor AMD\n  publishes a stable image for this one:\n";
            print STDERR "    $gpus[0]\n";
            print STDERR "  Build an image for it and pass it directly:\n";
            print STDERR "    podman build -t sglang-rocm -f docker/rocm.Dockerfile .\n";
            print STDERR "  then re-run with --image sglang-rocm:latest.\n";
        }
        else {
            print STDERR "\n  ${RED}${BOLD}Error:${RESET} No published SGLang image matches this GPU:\n";
            print STDERR "    $gpus[0]\n";
            print STDERR "  Published families are mi30x (MI300, MI325) and mi35x (MI350, MI355).\n";
            print STDERR "  Build an image for this card or pass one with --image <tag>.\n";
        }
        exit 1;
    }
    $results{arch_variant} = $variant;

    # ROCm flavour: the newest published one whose userland is not newer than the
    # host's, or the newest available when the host carries no ROCm to compare
    # with.  The flavour only selects the image tag, so with --image there is
    # nothing to select and no host ROCm can be too old for it.
    my $flavour;
    if ($custom_image) {
        _status('Checking ROCm flavour');
        _status_done('skipped (the image comes from --image)');
        $flavour = 'from --image';
    }
    elsif ($variant eq 'gfx1151') {
        $flavour = $RADEON_DEV_FLAVOUR;
        _status('Checking ROCm flavour');
        _status_done("$flavour (the only flavour published for gfx1151)");
    }
    elsif (defined $argv->{rocm_flavour} && length $argv->{rocm_flavour}) {
        $flavour = $argv->{rocm_flavour};
        _status('Checking ROCm flavour');
        _status_done("$flavour (from --rocm-flavour)");
    }
    elsif (defined $rocm_version) {
        $flavour = select_rocm_flavour($rocm_version);
        _status('Checking ROCm flavour');
        if (defined $flavour) {
            _status_done("$flavour (host ROCm $rocm_version)");
        }
        else {
            _status_done('none published');
            print STDERR "\n  ${RED}${BOLD}Error:${RESET} No published image targets ROCm ",
                "$rocm_version or older.\n";
            print STDERR "  Published flavours: ",
                join(', ', map { "$_->[0] (ROCm $_->[1])" } @ROCM_FLAVOURS), "\n";
            print STDERR "  Upgrade the ROCm driver, or pass --image with an image built for ",
                "this stack.\n";
            exit 1;
        }
    }
    else {
        $flavour = $NEWEST_ROCM_FLAVOUR;
        _status('Checking ROCm flavour');
        _status_done("$flavour (no host ROCm to compare with)");
        _warn("No ROCm userland found on the host, so the newest flavour ($flavour) is assumed. "
            . "The container's ROCm must not be newer than the amdgpu kernel driver, or it "
            . "cannot open the GPU: if this host's driver predates ROCm "
            . "$ROCM_FLAVOURS[0][1], pass --rocm-flavour with an older one.");
    }
    $results{rocm_flavour} = $flavour;

    # The image itself: --image wins, otherwise it is resolved from the release, the
    # flavour and the GPU family and checked against Docker Hub.
    my $image;
    if (defined $argv->{image} && length $argv->{image}) {
        $image = $argv->{image};
        _status('Using the requested image');
        _status_done($image);
        $results{engine_version} = 'from --image';
    }
    else {
        _status('Resolving the newest SGLang release');
        my $engine_version = resolve_engine_version();
        _status_done($engine_version);
        $results{engine_version} = $engine_version;

        if ($variant eq 'gfx1151') {
            _status('Resolving the newest AMD development build for gfx1151');
            my $tag = resolve_radeon_dev_tag($engine_version);
            if (!length $tag) {
                _status_done('not found');
                print STDERR "\n  ${RED}${BOLD}Error:${RESET} No AMD development build found ",
                    "for $engine_version-gfx1151.\n";
                print STDERR "  Build an image for this card (docker/rocm-gfx1151.Dockerfile) and\n";
                print STDERR "  pass it with --image <tag>.\n";
                exit 1;
            }
            $image = "$RADEON_DEV_REPO:$tag";
            $results{radeon_dev} = 1;
            _status_done($tag);
        }
        else {
            $image = resolve_image($IMAGE_REPO_FOR{$variant}, $engine_version, $variant, $flavour);
            _status('Checking the image tag is published');
            my $published = image_tag_published($IMAGE_HUB_REPO,
                "$engine_version-$flavour-$variant");
            if (defined $published && !$published) {
                _status_done('not found');
                print STDERR "\n  ${RED}${BOLD}Error:${RESET} The resolved image tag does not ",
                    "exist: $image\n";
                print STDERR "  Pass the image to deploy with --image <tag>.\n";
                exit 1;
            }
            _status_done(defined $published ? 'ok' : 'could not verify (offline?)');
        }
    }
    $results{engine_image} = $image;

    # Radeon needs AITER and the fused decode MLA kernel off; the values are recorded
    # here so the unit file carries them only where they are required, which the
    # resolved family decides, not the mere presence of a Radeon in the system.
    $results{radeon_env} = radeon_env_for($variant, $is_radeon);

    return \%results;
}

# ---------------------------------------------------------------------------
# 3. State directory (model cache)
# ---------------------------------------------------------------------------

sub setup_state_dir {
    my ($state_dir, $dry_run) = @_;
    my %results;
    my $cache_dir = "$state_dir/$CACHE_SUBDIR";

    _status("Ensuring $state_dir directory");
    if (-d $cache_dir) {
        _status_done('exists');
        $results{state_dir_exists} = 1;
        return \%results;
    }
    if ($dry_run) {
        _status_done('dry run');
        $results{state_dir_created} = 'dry run';
        return \%results;
    }
    my $ok = 1;
    for my $dir ($state_dir, $cache_dir) {
        next if -d $dir;
        if (!mkdir($dir, 0755)) {
            _status_done('failed');
            _fail("Could not create $dir: " . os_error_text($dir));
            $results{state_dir_created} = 0;
            $ok = 0;
            last;
        }
    }
    if ($ok) {
        _status_done('created');
        $results{state_dir_created} = 1;
    }
    return \%results;
}

# ---------------------------------------------------------------------------
# 4. Engine image
# ---------------------------------------------------------------------------

sub fetch_engine_image {
    my ($image, $dry_run) = @_;
    my %results;
    $results{image} = $image;

    _status('Checking the engine image');
    if (podman_image_exists($image)) {
        _status_done('already present');
        $results{image_present} = 1;
        return \%results;
    }

    if ($dry_run) {
        _status_done('dry run');
        _info("Would run: podman pull $image");
        $results{image_pulled} = 'dry run';
        return \%results;
    }

    if (!defined find_exe('podman')) {
        _status_done('podman not found');
        _fail('podman is not installed: cannot pull the engine image');
        $results{image_pulled} = 0;
        return \%results;
    }

    _status("Pulling $image (tens of gigabytes, this takes a while)");
    my $result = run(['podman', 'pull', $image], timeout => $PULL_TIMEOUT);
    if ($result->{rc} == 0) {
        _status_done('ok');
        $results{image_pulled} = 1;
    }
    else {
        _status_done('failed');
        my $err = $result->{err};
        $err =~ s/\s+$//;
        my $tail = length($err) > 500 ? substr($err, -500) : $err;
        _fail("Image pull failed: $tail");
        $results{image_pulled} = 0;
    }
    return \%results;
}

# ---------------------------------------------------------------------------
# 5. TLS certificate (self-signed)
# ---------------------------------------------------------------------------

sub setup_tls {
    my ($cert_dir, $dry_run) = @_;
    my %results;
    my $key_path = "$cert_dir/$CONTAINER_NAME.key";
    my $crt_path = "$cert_dir/$CONTAINER_NAME.crt";

    _status('Checking TLS certificate');
    if (-f $crt_path && -f $key_path) {
        _status_done('already exists');
        $results{cert_exists} = 1;
        return \%results;
    }

    if ($dry_run) {
        _status_done('would generate');
        $results{cert_created} = 'dry run';
        return \%results;
    }

    my $openssl = find_exe('openssl');
    if (!defined $openssl) {
        _status_done('openssl not found');
        _fail('openssl is not installed: cannot generate a certificate');
        $results{cert_created} = 0;
        return \%results;
    }

    if (!-d $cert_dir) {
        mkdir($cert_dir, 0755) or do {
            _status_done('cannot create the directory');
            _fail("Could not create $cert_dir: " . os_error_text($cert_dir));
            $results{cert_created} = 0;
            return \%results;
        };
    }

    _status('Generating self-signed certificate');
    # A restrictive umask while openssl runs: the key must never touch the disk
    # world-readable, not even for the instant before the chmod below.
    my $old_umask = umask(0077);
    my $result = run([
        $openssl, 'req', '-x509', '-nodes', '-days', '365',
        '-newkey', 'rsa:2048',
        '-keyout', $key_path,
        '-out',    $crt_path,
        '-subj',   '/CN=' . host_fqdn(),
        '-addext', 'subjectAltName=' . cert_san(),
    ], timeout => 30);
    umask($old_umask);

    if ($result->{rc} == 0) {
        chmod 0600, $key_path;
        chmod 0644, $crt_path;
        _status_done('generated');
        $results{cert_created} = 1;
    }
    else {
        _status_done('failed');
        my $err = $result->{err};
        $err =~ s/\s+$//;
        _fail("openssl failed: $err");
        $results{cert_created} = 0;
    }

    return \%results;
}

# ---------------------------------------------------------------------------
# 6. API key (EnvironmentFile for the systemd unit)
# ---------------------------------------------------------------------------

sub setup_api_key {
    my ($service_name, $api_key, $dry_run) = @_;
    my %results;
    my $env_path = "/etc/sysconfig/$service_name";

    my $current = -f $env_path ? slurp($env_path) : '';

    _status('Checking API key environment file');
    if (!defined $api_key && index($current, 'SGLANG_API_KEY=') >= 0) {
        # A file written by something else may carry looser permissions than
        # this script's own; the key stays root-only either way.
        chmod 0600, $env_path;
        _status_done('already present, reusing the existing key');
        $results{env_file} = 'exists';
        return \%results;
    }

    my $desired = defined $api_key ? "SGLANG_API_KEY=$api_key\n" : '';
    if (defined $api_key && $current eq $desired) {
        _status_done('already configured');
        $results{env_file} = 'exists';
        return \%results;
    }

    if ($dry_run) {
        _status_done(length $current ? 'would update' : 'would create');
        $results{env_file} = 'dry run';
        return \%results;
    }

    my $key = defined $api_key ? $api_key : generate_api_key();
    # 0600 from the start: the secret must never exist world-readable, not even
    # between the write and a later chmod.
    my $old_umask = umask(0077);
    my $written = write_file($env_path, "SGLANG_API_KEY=$key\n");
    umask($old_umask);
    if (!$written) {
        _status_done('failed');
        _fail("Could not write $env_path: " . os_error_text($env_path));
        $results{env_file} = 'failed';
        return \%results;
    }
    chmod 0600, $env_path;
    _status_done(length $current ? 'updated' : 'created');
    $results{env_file} = length $current ? 'updated' : 'created';
    $results{generated_key} = $key unless defined $api_key;
    return \%results;
}

# A URL-safe key: 32 random bytes, base64 without padding, '-' and '_' for
# '+' and '/'.
sub generate_api_key {
    my $bytes = '';
    my $fh;
    if (open(my $rand, '<', '/dev/urandom')) {
        $fh = $rand;
        my $raw = '';
        my $got = read($fh, $raw, 32);
        $bytes = $got == 32 ? $raw : '';
        close($fh);
    }
    if (length($bytes) != 32) {
        # Fall back to hashing the process state: weaker, and said out loud.
        _warn('/dev/urandom is unavailable: deriving the key from process state instead');
        $bytes = '';
        for my $i (1 .. 8) {
            $bytes .= pack('N', ($$ * $i * 2654435761) % 4294967296);
        }
        $bytes = substr($bytes, 0, 32);
    }
    my $b64 = encode_base64url($bytes);
    return $b64;
}

sub encode_base64url {
    my ($data) = @_;
    my $alphabet = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_';
    my $out = '';
    my $bits = 0;
    my $buffer = 0;
    for my $byte (unpack('C*', $data)) {
        $buffer = ($buffer << 8) | $byte;
        $bits += 8;
        while ($bits >= 6) {
            $bits -= 6;
            $out .= substr($alphabet, ($buffer >> $bits) & 0x3F, 1);
        }
    }
    if ($bits > 0) {
        $out .= substr($alphabet, ($buffer << (6 - $bits)) & 0x3F, 1);
    }
    return $out;
}

# ---------------------------------------------------------------------------
# 7. SELinux
# ---------------------------------------------------------------------------

# Allow nginx to reach the engine's port on SELinux-enforcing systems.
#
# http_port_t covers 80/81/443/488/8008/8009/8443/9000 but not the engine's port, so
# on enforcing systems nginx needs httpd_can_network_connect.
sub setup_selinux {
    my ($dry_run) = @_;
    my %results;

    _status('Checking SELinux status');
    my $getenforce = find_exe('getenforce');
    if (!defined $getenforce) {
        _status_done('not installed (skipping)');
        $results{selinux} = 'absent';
        return \%results;
    }
    my $mode_result = run([$getenforce], timeout => 10);
    my $mode = $mode_result->{out};
    $mode =~ s/^\s+//;
    $mode =~ s/\s+$//;
    $mode = lc $mode;
    if ($mode ne 'enforcing') {
        _status_done("$mode (skipping)");
        $results{selinux} = $mode;
        return \%results;
    }
    _status_done('enforcing');

    _status('Checking httpd_can_network_connect boolean');
    my $getsebool = find_exe('getsebool');
    my $setsebool = find_exe('setsebool');
    if (!defined $getsebool || !defined $setsebool) {
        _status_done('tools missing');
        _warn('getsebool/setsebool not found: nginx proxying may be blocked (502)');
        $results{selinux} = 'failed';
        return \%results;
    }

    my $current = run([$getsebool, 'httpd_can_network_connect'], timeout => 10);
    if ($current->{rc} == 0 && index($current->{out}, '--> on') >= 0) {
        _status_done('already on');
        $results{selinux} = 'on';
        return \%results;
    }

    if ($dry_run) {
        _status_done('would set on');
        $results{selinux} = 'dry run';
        return \%results;
    }

    # -P persists across reboots; the policy rebuild can take a while.
    my $set_result = run([$setsebool, '-P', 'httpd_can_network_connect=1'], timeout => 180);
    if ($set_result->{rc} == 0) {
        _status_done('set on');
        $results{selinux} = 'on';
    }
    else {
        _status_done('failed');
        my $err = $set_result->{err};
        $err =~ s/\s+$//;
        _warn("setsebool failed: $err");
        $results{selinux} = 'failed';
    }

    return \%results;
}

# ---------------------------------------------------------------------------
# 8. nginx configuration
# ---------------------------------------------------------------------------

# Return the nginx server block content.
#
# HTTP/1.1 with an empty Connection header and proxy_buffering off are required for
# the engine's SSE streaming: nginx's defaults (HTTP/1.0, buffering on) would hold a
# whole streamed completion until generation finishes.  The IPv6 listener is emitted
# only when the kernel actually has IPv6 enabled (the same check as detect_loopback);
# socket() on [::]:443 would otherwise fail with EAFNOSUPPORT and take nginx down.
sub nginx_conf_content {
    my ($port, $upstream_host, $cert_dir) = @_;
    my $ipv6_listen = -e '/proc/net/if_inet6' ? "listen [::]:443 ssl;\n    " : '';
    return <<"CONF";
server {
    ${ipv6_listen}listen 443 ssl;
    server_name _;

    ssl_certificate $cert_dir/$CONTAINER_NAME.crt;
    ssl_certificate_key $cert_dir/$CONTAINER_NAME.key;
    ssl_protocols TLSv1.2 TLSv1.3;

    client_max_body_size 50m;

    location / {
        proxy_pass http://$upstream_host:$port;
        proxy_http_version 1.1;
        proxy_set_header Connection "";
        proxy_set_header Host \$host;
        proxy_set_header X-Real-IP \$remote_addr;
        proxy_set_header X-Forwarded-For \$proxy_add_x_forwarded_for;
        proxy_set_header X-Forwarded-Proto \$scheme;
        proxy_buffering off;
        proxy_read_timeout 300s;
        proxy_send_timeout 300s;
    }
}
CONF
}

sub nginx_conf_path {
    my ($service_name) = @_;
    return "/etc/nginx/conf.d/$service_name.conf";
}

sub setup_nginx {
    my ($port, $upstream_host, $cert_dir, $service_name, $dry_run) = @_;
    my %results;
    my $conf_path = nginx_conf_path($service_name);
    my $desired_content = nginx_conf_content($port, $upstream_host, $cert_dir);

    # Write the nginx config if it is missing or different.
    _status('Checking nginx configuration');
    if (-f $conf_path) {
        my $current = slurp($conf_path);
        $current =~ s/^\s+//;
        $current =~ s/\s+$//;
        my $desired = $desired_content;
        $desired =~ s/^\s+//;
        $desired =~ s/\s+$//;
        if ($current eq $desired) {
            _status_done('already configured');
            $results{nginx_configured} = 1;
        }
        elsif ($dry_run) {
            _status_done('would update');
            $results{nginx_configured} = 'dry run';
        }
        elsif (write_file($conf_path, $desired_content)) {
            _status_done('updated');
            $results{nginx_configured} = 1;
        }
        else {
            _status_done('failed');
            _fail("Could not write $conf_path: " . os_error_text($conf_path));
            $results{nginx_configured} = 0;
        }
    }
    elsif ($dry_run) {
        _status_done('would create');
        $results{nginx_configured} = 'dry run';
    }
    elsif (write_file($conf_path, $desired_content)) {
        _status_done('created');
        $results{nginx_configured} = 1;
    }
    else {
        _status_done('failed');
        _fail("Could not write $conf_path: " . os_error_text($conf_path));
        $results{nginx_configured} = 0;
    }

    # Ensure nginx is enabled and running (handles the enabled-but-stopped case).
    _status('Ensuring nginx service is enabled and running');
    my $nginx_running = systemctl_is_active('nginx');
    if (systemctl_is_enabled('nginx') && $nginx_running) {
        _status_done('running');
        $results{nginx_running} = 1;
    }
    elsif ($dry_run) {
        _status_done('dry run');
        $results{nginx_running} = 'dry run';
    }
    else {
        my $start_result = systemctl_is_enabled('nginx')
            ? run(['systemctl', 'start', 'nginx'], timeout => 30)
            : run(['systemctl', 'enable', '--now', 'nginx'], timeout => 30);
        if ($start_result->{rc} == 0) {
            _status_done('enabled and started');
            $results{nginx_running} = 1;
        }
        else {
            _status_done('failed');
            my $err = $start_result->{err};
            $err =~ s/\s+$//;
            _warn("Could not start nginx: $err");
            $results{nginx_running} = 0;
        }
    }

    # Test and reload the configuration (only possible when nginx is running).
    _status('Reloading nginx configuration');
    if ($dry_run) {
        _status_done('dry run');
        $results{nginx_reloaded} = 'dry run';
    }
    elsif (!$results{nginx_running}) {
        _status_done('skipped (nginx not running)');
        $results{nginx_reloaded} = 0;
    }
    else {
        my $test_result = run(['nginx', '-t'], timeout => 30);
        if ($test_result->{rc} != 0) {
            _status_done('config test failed');
            my $err = $test_result->{err};
            $err =~ s/\s+$//;
            _fail("nginx -t failed: $err");
            $results{nginx_reloaded} = 0;
        }
        else {
            my $reload_result = run(['systemctl', 'reload', 'nginx'], timeout => 30);
            if ($reload_result->{rc} == 0) {
                _status_done('reloaded');
                $results{nginx_reloaded} = 1;
            }
            else {
                _status_done('failed');
                my $err = $reload_result->{err};
                $err =~ s/\s+$//;
                _fail("nginx reload failed: $err");
                $results{nginx_reloaded} = 0;
            }
        }
    }

    return \%results;
}

# ---------------------------------------------------------------------------
# 9. systemd service
# ---------------------------------------------------------------------------

# Return the systemd unit file content.
#
# The API key is substituted by systemd from the EnvironmentFile (${SGLANG_API_KEY}),
# so the key never appears in the unit file itself.
sub systemd_content {
    my ($opts) = @_;
    my $podman = find_exe('podman') // '/usr/bin/podman';
    my $image  = $opts->{image};
    my $cache  = "$opts->{state_dir}/$CACHE_SUBDIR";

    my @env_lines = map { "Environment=$_\n" } @{ $opts->{radeon_env} };
    my $env_block = join('', @env_lines);

    return <<"UNIT";
[Unit]
Description=SGLang Inference Server ($opts->{model})
After=network-online.target
Wants=network-online.target

[Service]
Type=simple
Environment=PYTHONUNBUFFERED=1
Environment=SGLANG_USE_MODELSCOPE=true
${env_block}EnvironmentFile=$opts->{env_file}
ExecStart=$podman run --rm --replace --name $CONTAINER_NAME \\
  --network=host \\
  --pull=missing \\
  --device=/dev/kfd --device=/dev/dri \\
  --group-add video \\
  --ipc=host \\
  --cap-add=SYS_PTRACE \\
  --security-opt seccomp=unconfined \\
  --volume $cache:$CACHE_MOUNT:Z \\
  --env MODELSCOPE_TOKEN \\
  $image \\
  python3 -m sglang.launch_server \\
  --model-path $opts->{model} \\
  --host $opts->{host} \\
  --port $opts->{port} \\
  --api-key \${SGLANG_API_KEY} \\
  --tp-size $opts->{tensor_parallel} \\
  --context-length $opts->{max_model_len} \\
  --mem-fraction-static $opts->{gpu_memory_utilization}
Restart=on-failure
RestartSec=10

[Install]
WantedBy=multi-user.target
UNIT
}

sub setup_systemd {
    my ($opts, $dry_run) = @_;
    my %results;
    my $service_name = $opts->{service_name};
    my $unit_path = "/etc/systemd/system/$service_name.service";
    my $env_file = "/etc/sysconfig/$service_name";
    my %unit_opts = (%$opts, env_file => $env_file);
    my $desired_content = systemd_content(\%unit_opts);

    # Write the unit file if it is missing or different.
    my $unit_changed = 0;
    _status("Checking $service_name.service unit file");
    if (-f $unit_path) {
        my $current = slurp($unit_path);
        $current =~ s/^\s+//;
        $current =~ s/\s+$//;
        my $desired = $desired_content;
        $desired =~ s/^\s+//;
        $desired =~ s/\s+$//;
        if ($current eq $desired) {
            _status_done('already configured');
            $results{unit_configured} = 1;
        }
        elsif ($dry_run) {
            _status_done('would update');
            $results{unit_configured} = 'dry run';
        }
        elsif (write_file($unit_path, $desired_content)) {
            _status_done('updated');
            $results{unit_configured} = 1;
            $unit_changed = 1;
        }
        else {
            _status_done('failed');
            _fail("Could not write $unit_path: " . os_error_text($unit_path));
            $results{unit_configured} = 0;
        }
    }
    elsif ($dry_run) {
        _status_done('would create');
        $results{unit_configured} = 'dry run';
    }
    elsif (write_file($unit_path, $desired_content)) {
        _status_done('created');
        $results{unit_configured} = 1;
        $unit_changed = 1;
    }
    else {
        _status_done('failed');
        _fail("Could not write $unit_path: " . os_error_text($unit_path));
        $results{unit_configured} = 0;
    }
    $results{unit_changed} = $unit_changed;

    # systemctl daemon-reload.
    _status('Reloading systemd daemon');
    if ($dry_run) {
        _status_done('dry run');
    }
    else {
        my $reload_result = run(['systemctl', 'daemon-reload'], timeout => 30);
        if ($reload_result->{rc} != 0) {
            _status_done('failed');
            my $err = $reload_result->{err};
            $err =~ s/\s+$//;
            _fail("daemon-reload failed: $err");
            $results{unit_configured} = 0;
        }
        else {
            _status_done('ok');
        }
    }

    # Enable the service.
    _status("Enabling $service_name service");
    if (systemctl_is_enabled($service_name)) {
        _status_done('already enabled');
        $results{service_enabled} = 1;
    }
    elsif ($dry_run) {
        _status_done('dry run');
        $results{service_enabled} = 'dry run';
    }
    else {
        my $enable_result = run(['systemctl', 'enable', $service_name], timeout => 30);
        if ($enable_result->{rc} == 0) {
            _status_done('enabled');
            $results{service_enabled} = 1;
        }
        else {
            _status_done('failed');
            my $err = $enable_result->{err};
            $err =~ s/\s+$//;
            _fail("systemctl enable failed: $err");
            $results{service_enabled} = 0;
        }
    }

    # Start the service, or restart it when the unit changed underneath it.
    _status("Starting $service_name service");
    my $is_active = systemctl_is_active($service_name);
    if ($dry_run) {
        _status_done('dry run');
        $results{service_started} = 'dry run';
    }
    elsif ($is_active && $unit_changed) {
        my $restart_result = run(['systemctl', 'try-restart', $service_name], timeout => 60);
        if ($restart_result->{rc} == 0) {
            _status_done('restarted (unit changed)');
            $results{service_started} = 'restarted';
        }
        else {
            _status_done('failed');
            my $err = $restart_result->{err};
            $err =~ s/\s+$//;
            _fail("systemctl try-restart failed: $err "
                . "(check logs with: journalctl -u $service_name -f)");
            $results{service_started} = 0;
        }
    }
    elsif ($is_active) {
        _status_done('already running');
        $results{service_started} = 1;
    }
    else {
        my $start_result = run(['systemctl', 'start', $service_name], timeout => 30);
        if ($start_result->{rc} == 0) {
            _status_done('started');
            $results{service_started} = 1;
        }
        else {
            _status_done('failed');
            my $err = $start_result->{err};
            $err =~ s/\s+$//;
            _fail("systemctl start failed: $err "
                . "(check logs with: journalctl -u $service_name -f)");
            $results{service_started} = 0;
        }
    }

    return \%results;
}

# ---------------------------------------------------------------------------
# 10. Firewall
# ---------------------------------------------------------------------------

sub setup_firewall {
    my ($dry_run) = @_;
    my %results;

    _status('Checking firewalld');
    my $fw_result = run(['systemctl', 'is-active', '--quiet', 'firewalld'], timeout => 10);
    if ($fw_result->{rc} != 0) {
        _status_done('not running (skipping)');
        $results{firewall_active} = 0;
        return \%results;
    }

    _status_done('active');

    # Check whether the https service is already allowed.
    _status('Checking HTTPS firewall rule');
    my $list_result = run(['firewall-cmd', '--permanent', '--list-services'], timeout => 30);
    if ($list_result->{rc} == 0 && grep { $_ eq 'https' } split /\s+/, $list_result->{out}) {
        _status_done('already allowed');
        $results{firewall_configured} = 1;
        return \%results;
    }

    if ($dry_run) {
        _status_done('dry run');
        $results{firewall_configured} = 'dry run';
        return \%results;
    }

    # Add the https service.
    my $add_result = run(['firewall-cmd', '--permanent', '--add-service=https'], timeout => 30);
    if ($add_result->{rc} != 0) {
        _status_done('failed');
        my $err = $add_result->{err};
        $err =~ s/\s+$//;
        _warn("firewall-cmd failed: $err");
        $results{firewall_configured} = 0;
        return \%results;
    }

    # Reload to apply: a failed reload leaves the rule inactive.
    my $reload_result = run(['firewall-cmd', '--reload'], timeout => 30);
    if ($reload_result->{rc} == 0) {
        _status_done('added (permanent)');
        $results{firewall_configured} = 1;
    }
    else {
        _status_done('failed');
        my $err = $reload_result->{err};
        $err =~ s/\s+$//;
        _warn("firewall-cmd --reload failed: $err "
            . "(the rule is stored permanently but not active)");
        $results{firewall_configured} = 0;
    }

    return \%results;
}

# ---------------------------------------------------------------------------
# 11. Uninstall
# ---------------------------------------------------------------------------

# Tear down the SGLang deployment.
#
# Deliberately kept (documented at the end): the image, <state-dir> with the
# ModelScope cache of downloaded weights, the firewalld https rule, and the SELinux
# boolean.
sub uninstall {
    my ($opts, $dry_run) = @_;
    my %results;
    my $service_name = $opts->{service_name};
    my $state_dir = $opts->{state_dir};
    my $cert_dir = $opts->{cert_dir};

    # Stop and disable the systemd service.
    _status("Stopping $service_name service");
    if (systemctl_is_active($service_name) || systemctl_is_enabled($service_name)) {
        if ($dry_run) {
            _status_done('dry run');
        }
        else {
            my $stop_result = run(['systemctl', 'stop', $service_name], timeout => 60);
            my $disable_result = run(['systemctl', 'disable', $service_name], timeout => 30);
            if ($stop_result->{rc} != 0 || $disable_result->{rc} != 0) {
                _status_done('failed');
                my $stop_err = $stop_result->{err};
                $stop_err =~ s/\s+$//;
                my $disable_err = $disable_result->{err};
                $disable_err =~ s/\s+$//;
                _warn("stop/disable failed (stop: " . (length $stop_err ? $stop_err : 'ok')
                    . ", disable: " . (length $disable_err ? $disable_err : 'ok')
                    . "), continuing cleanup");
                $results{service_stopped} = 0;
            }
            else {
                _status_done('stopped and disabled');
                $results{service_stopped} = 1;
            }
        }
    }
    else {
        _status_done('not running');
        $results{service_not_found} = 1;
    }

    # Remove systemd unit file.
    my $unit_path = "/etc/systemd/system/$service_name.service";
    _status("Removing $service_name.service unit file");
    if (-f $unit_path) {
        if ($dry_run) {
            _status_done('dry run');
        }
        else {
            unlink($unit_path);
            run(['systemctl', 'daemon-reload'], timeout => 30);
            _status_done('removed');
            $results{unit_removed} = 1;
        }
    }
    else {
        _status_done('not present');
        $results{unit_not_found} = 1;
    }

    # Remove a container the engine left behind (podman run removes it on a clean
    # stop; a killed podman leaves one).
    _status('Removing the engine container');
    if (podman_container_exists($CONTAINER_NAME)) {
        if ($dry_run) {
            _status_done('dry run');
        }
        else {
            my $rm_result = run(['podman', 'rm', '-f', $CONTAINER_NAME], timeout => 60);
            if ($rm_result->{rc} == 0) {
                _status_done('removed');
                $results{container_removed} = 1;
            }
            else {
                _status_done('failed');
                my $err = $rm_result->{err};
                $err =~ s/\s+$//;
                _warn("podman rm -f failed: $err");
                $results{container_removed} = 0;
            }
        }
    }
    else {
        _status_done('not present');
        $results{container_not_found} = 1;
    }

    # Remove the API key environment file.
    my $env_path = "/etc/sysconfig/$service_name";
    _status('Removing API key environment file');
    if (-f $env_path) {
        if ($dry_run) {
            _status_done('dry run');
        }
        else {
            unlink($env_path);
            _status_done('removed');
            $results{env_removed} = 1;
        }
    }
    else {
        _status_done('not present');
        $results{env_not_found} = 1;
    }

    # Remove the nginx config.
    my $nginx_conf = nginx_conf_path($service_name);
    _status("Removing nginx $service_name configuration");
    if (-f $nginx_conf) {
        if ($dry_run) {
            _status_done('dry run');
        }
        else {
            unlink($nginx_conf);
            my $reload_result = run(['systemctl', 'reload', 'nginx'], timeout => 30);
            if ($reload_result->{rc} != 0) {
                _status_done('removed (nginx reload failed)');
                my $err = $reload_result->{err};
                $err =~ s/\s+$//;
                _warn("nginx reload failed: $err");
            }
            else {
                _status_done('removed and nginx reloaded');
            }
            $results{nginx_removed} = 1;
        }
    }
    else {
        _status_done('not present');
        $results{nginx_not_found} = 1;
    }

    # Remove the TLS certificates.
    _status('Removing TLS certificates');
    if (-d $cert_dir) {
        if ($dry_run) {
            _status_done('dry run');
        }
        else {
            # Remove the individual files first, then the directory.
            for my $fname ("$CONTAINER_NAME.key", "$CONTAINER_NAME.crt") {
                my $fpath = "$cert_dir/$fname";
                unlink($fpath) if -f $fpath;
            }
            rmdir($cert_dir);
            _status_done('removed');
            $results{certs_removed} = 1;
        }
    }
    else {
        _status_done('not present');
        $results{certs_not_found} = 1;
    }

    # What deliberately persists after an uninstall.
    print STDERR "\n";
    _info('Kept on the system (remove manually if unwanted):');
    _info("  the engine image (podman rmi <image>)");
    _info("  $state_dir (ModelScope cache with downloaded model weights)");
    _info("  firewalld 'https' rule and the SELinux httpd_can_network_connect boolean");

    return \%results;
}

# ---------------------------------------------------------------------------
# Summary
# ---------------------------------------------------------------------------

sub print_summary {
    my ($opts) = @_;
    my $results = $opts->{results};
    my $warnings = $opts->{warnings};
    my $service_name = $opts->{service_name};
    my $port = $opts->{port};
    my $mode = $opts->{uninstall_mode} ? 'Uninstall' : ($opts->{dry_run} ? 'Dry Run' : 'Setup');

    print STDERR "\n${BOLD}── $mode Summary ──${RESET}\n";
    print STDERR "  OS: $opts->{os_display} $opts->{version_id}\n";

    if ($opts->{uninstall_mode}) {
        my $ur = $results->{uninstall} // {};
        for my $pair (
            ['service_stopped',    'SGLang service stopped'],
            ['unit_removed',       'systemd unit removed'],
            ['container_removed',  'engine container removed'],
            ['env_removed',        'API key environment file removed'],
            ['nginx_removed',      'nginx config removed'],
            ['certs_removed',      'TLS certificates removed'],
        ) {
            my ($key, $label) = @$pair;
            next unless defined $ur->{$key};
            # A step that ran and failed reports failure: 0 is a recorded
            # outcome, not an absent one.
            if ($ur->{$key} eq 1) { _ok($label) }
            else                  { _fail($label) }
        }
        for my $pair (
            ['service_not_found',   'SGLang service: already absent'],
            ['unit_not_found',      'systemd unit: already absent'],
            ['container_not_found', 'engine container: already absent'],
            ['env_not_found',       'API key environment file: already absent'],
            ['nginx_not_found',     'nginx config: already absent'],
            ['certs_not_found',     'TLS certs: already absent'],
        ) {
            my ($key, $label) = @$pair;
            _info($label) if exists $ur->{$key};
        }
    }
    else {
        # Deploy summary.
        _ok('Model: ' . model_display($opts->{model}));

        my $sd = $results->{system_deps} // {};
        my $installed = scalar @{ $sd->{installed} // [] };
        my $skipped = scalar @{ $sd->{skipped} // [] };
        my $failed_pkgs = scalar @{ $sd->{failed} // [] };
        if ($opts->{dry_run}) {
            _ok("System packages: $skipped present, $installed would be installed");
        }
        else {
            _ok("System packages: $skipped already present, $installed installed");
        }
        _fail("  $failed_pkgs package(s) failed to install") if $failed_pkgs;

        my $pf = $results->{preflight} // {};
        if (my $image = $pf->{engine_image}) {
            _ok("Engine image: $image");
            if ($pf->{radeon_dev}) {
                _info('AMD publishes this build daily: a rerun takes the newest one, '
                    . 'and --image pins a single build');
            }
        }
        my $rocm = $pf->{rocm_version};
        if (($pf->{rocm_flavour} // '') eq 'from --image') {
            _info('Host ROCm: ' . (defined $rocm ? $rocm : 'none')
                . ' (image from --image)');
        }
        elsif (defined $rocm) {
            _info("Host ROCm: $rocm (image flavour $pf->{rocm_flavour})");
        }
        else {
            _info("Host ROCm: none, the image carries it (flavour $pf->{rocm_flavour})");
        }

        my $image_state = $results->{image} // {};
        if ($image_state->{image_present}) {
            _ok('Engine image: already present');
        }
        elsif ($image_state->{image_pulled} && $image_state->{image_pulled} ne 'dry run') {
            _ok('Engine image: pulled');
        }
        elsif ($image_state->{image_pulled} && $image_state->{image_pulled} eq 'dry run') {
            _info('Engine image: would be pulled');
        }
        elsif (($image_state->{image_pulled} // 1) == 0) {
            _fail('Engine image: pull failed');
        }

        my $state = $results->{state_dir} // {};
        if ($state->{state_dir_exists}) {
            _ok("Model cache: $opts->{state_dir}/$CACHE_SUBDIR (existing)");
        }
        elsif ($state->{state_dir_created} && $state->{state_dir_created} ne 'dry run') {
            _ok("Model cache: $opts->{state_dir}/$CACHE_SUBDIR (created)");
        }
        elsif ($state->{state_dir_created} && $state->{state_dir_created} eq 'dry run') {
            _info("Model cache: would create $opts->{state_dir}/$CACHE_SUBDIR");
        }

        my $tls = $results->{tls} // {};
        if ($tls->{cert_exists} || ($tls->{cert_created} // '') eq 1) {
            _ok('TLS certificate: configured (self-signed, 365-day validity)');
        }
        elsif (($tls->{cert_created} // '') eq 'dry run') {
            _info('TLS: would generate a self-signed certificate (SAN from the host FQDN)');
        }

        my $ak = $results->{api_key} // {};
        my $env_state = $ak->{env_file};
        if ($opts->{generated_api_key}) {
            _ok("API key: stored in /etc/sysconfig/$service_name (0600 root:root)");
            print STDERR "  ${YELLOW}${BOLD}API key (shown once, store it securely): "
                . "$opts->{generated_api_key}${RESET}\n";
        }
        elsif ($env_state && $env_state eq 'exists') {
            _ok('API key: existing key reused');
        }
        elsif ($env_state && $env_state eq 'updated') {
            _ok('API key: updated from --api-key');
        }
        elsif ($env_state && $env_state eq 'created') {
            _ok("API key: stored in /etc/sysconfig/$service_name (0600 root:root)");
        }
        elsif ($env_state && $env_state eq 'dry run') {
            _info("API key: would generate/store in /etc/sysconfig/$service_name (0600)");
        }
        elsif ($env_state && $env_state eq 'failed') {
            _fail('API key: could not write the environment file');
        }

        my $se = ($results->{selinux} // {})->{selinux};
        if ($se && $se eq 'on') {
            _ok('SELinux: httpd_can_network_connect on');
        }
        elsif ($se && $se eq 'dry run') {
            _info('SELinux: would set httpd_can_network_connect=1');
        }
        elsif ($se && $se eq 'failed') {
            _fail('SELinux: failed to set httpd_can_network_connect');
        }
        elsif ($se && ($se eq 'permissive' || $se eq 'disabled')) {
            _info("SELinux: $se (skipped)");
        }
        elsif ($se && $se eq 'absent') {
            _info('SELinux: not installed (skipped)');
        }

        my $ng = $results->{nginx} // {};
        if ($ng->{nginx_configured} && $ng->{nginx_configured} eq 1
            && $ng->{nginx_reloaded} && $ng->{nginx_reloaded} eq 1) {
            _ok('nginx: configured and reloaded');
        }
        elsif ($ng->{nginx_configured} && $ng->{nginx_configured} eq 1) {
            _fail('nginx: config written but reload failed');
        }
        elsif (($ng->{nginx_configured} // '') eq 'dry run') {
            _info('nginx: would write config and reload');
        }

        my $svc = $results->{systemd} // {};
        my $started = $svc->{service_started};
        my $bind_host = $opts->{bind_host};
        my $disp = index($bind_host, ':') >= 0 ? "[$bind_host]:$port" : "$bind_host:$port";
        if (defined $started && ($started eq 1 || $started eq 'restarted')) {
            my $verb = $started eq 'restarted' ? 'restarted with an updated unit' : 'running';
            _ok("systemd: $service_name $verb on $disp");
            _info('First load takes minutes. Verify: curl -fk https://localhost/health (retry)');
        }
        elsif (defined $started && $started eq 0) {
            _fail("systemd: $service_name failed to start");
        }
        elsif (defined $started && $started eq 'dry run') {
            _info("systemd: would enable and start $service_name");
        }

        my $fw = $results->{firewall} // {};
        if (defined $fw->{firewall_active} && $fw->{firewall_active} eq 0) {
            _info('Firewall: firewalld not running (skipped)');
        }
        elsif ($fw->{firewall_configured} && $fw->{firewall_configured} eq 1) {
            _ok('Firewall: HTTPS (443) allowed');
        }
        elsif (defined $fw->{firewall_configured} && $fw->{firewall_configured} eq 0) {
            _fail('Firewall: failed to allow HTTPS (443)');
        }
        elsif (($fw->{firewall_configured} // '') eq 'dry run') {
            _info('Firewall: would allow HTTPS (443)');
        }
    }

    if (@$warnings) {
        print STDERR "\n";
        _warn($_) for @$warnings;
    }

    print STDERR "\n${BOLD}" . ('═' x 60) . "${RESET}\n";
    print STDERR "  ${BOLD}Total time: " . sprintf('%.1f', $opts->{elapsed}) . "s${RESET}\n";
    print STDERR "${BOLD}" . ('═' x 60) . "${RESET}\n\n";
    return;
}

# ---------------------------------------------------------------------------
# CLI
# ---------------------------------------------------------------------------

sub usage {
    my $text = <<"USAGE";
Usage: sglang-deploy.pl [options]

  --model ID                     ModelScope model ID (menu when omitted)
  --port N                       internal engine port (default: $INTERNAL_PORT, not 443)
  --tensor-parallel N            GPUs for tensor parallelism (default: 1, written as
                                 the engine's --tp-size)
  --max-model-len N              context length (default: 4096, written as the
                                 engine's --context-length)
  --gpu-memory-utilization F     static memory fraction (default: 0.90, written as
                                 the engine's --mem-fraction-static)
  --state-dir PATH               state and model cache directory (default: $DEFAULT_STATE_DIR)
  --service-name NAME            systemd service name (default: $DEFAULT_SERVICE)
  --cert-dir PATH                TLS certificate directory (default: $DEFAULT_CERT_DIR)
  --image TAG                    engine image (default: resolved from the GPU and
                                 the newest SGLang release; a Radeon card resolves
                                 AMD's newest dated gfx1151 build)
  --rocm-flavour NAME            ROCm flavour of the image (default: from the host
                                 ROCm; rocm10, rocm724, rocm720 or rocm700)
  --api-key KEY                  API key for the endpoint (default: generate and
                                 store in /etc/sysconfig)
  --dry-run                      preview without making changes
  --uninstall                    tear down the service, container, nginx config
                                 and certificates
  --help                         show this help
  --version                      show the version
USAGE
    print STDERR $text;
    return;
}

sub parse_args {
    my %args = (
        model                  => undef,
        port                   => $INTERNAL_PORT,
        tensor_parallel        => 1,
        max_model_len          => 4096,
        gpu_memory_utilization => '0.9',
        state_dir              => $DEFAULT_STATE_DIR,
        service_name           => $DEFAULT_SERVICE,
        cert_dir               => $DEFAULT_CERT_DIR,
        image                  => '',
        rocm_flavour           => '',
        api_key                => undef,
        dry_run                => 0,
        uninstall              => 0,
    );
    my %takes_value = map { $_ => 1 } qw(
        model port tensor-parallel max-model-len gpu-memory-utilization
        state-dir service-name cert-dir image rocm-flavour api-key
    );

    my $i = 0;
    while ($i < @ARGV) {
        my $arg = $ARGV[$i];
        my $name = $arg;
        my $inline;
        if ($arg =~ /^--([^=]+)=(.*)$/s) {
            ($name, $inline) = ("--$1", $2);
        }
        if ($name eq '--help') {
            usage();
            exit 0;
        }
        if ($name eq '--version') {
            print "sglang-deploy.pl $VERSION\n";
            exit 0;
        }
        if ($name eq '--dry-run') {
            $args{dry_run} = 1;
            $i++;
            next;
        }
        if ($name eq '--uninstall') {
            $args{uninstall} = 1;
            $i++;
            next;
        }
        if ($name !~ /^--([a-z-]+)$/ || !$takes_value{$1}) {
            _fail("Unknown option: $arg");
            usage();
            exit 2;
        }
        my $key = $1;
        my $value = $inline;
        if (!defined $value) {
            $i++;
            if ($i >= @ARGV) {
                _fail("Option $name needs a value");
                exit 2;
            }
            $value = $ARGV[$i];
        }
        if ($key eq 'model')                 { $args{model} = $value }
        elsif ($key eq 'port')               { $args{port} = $value }
        elsif ($key eq 'tensor-parallel')    { $args{tensor_parallel} = $value }
        elsif ($key eq 'max-model-len')      { $args{max_model_len} = $value }
        elsif ($key eq 'gpu-memory-utilization') { $args{gpu_memory_utilization} = $value }
        elsif ($key eq 'state-dir')          { $args{state_dir} = $value }
        elsif ($key eq 'service-name')       { $args{service_name} = $value }
        elsif ($key eq 'cert-dir')           { $args{cert_dir} = $value }
        elsif ($key eq 'image')              { $args{image} = $value }
        elsif ($key eq 'rocm-flavour')       { $args{rocm_flavour} = $value }
        elsif ($key eq 'api-key')            { $args{api_key} = $value }
        $i++;
    }

    return %args;
}

sub model_display {
    my ($model) = @_;
    return $MODEL_NAMES{$model} // $model;
}

sub prompt_model {
    my ($args) = @_;
    # Under `curl | sudo perl` stdin is the pipe the script itself arrived on; the
    # read would hit EOF instantly and look like a cancel.
    if (!-t STDIN) {
        _fail('Interactive model selection needs a terminal: pass --model instead');
        exit 2;
    }
    print STDERR "\n${BOLD}Select a model to deploy:${RESET}\n\n";
    my $i = 0;
    for my $name (@DEFAULT_MODEL_ORDER) {
        $i++;
        print STDERR "  ${GREEN}$i${RESET}. $name\n";
    }
    print STDERR "  ${DIM}" . ($i + 1) . ". Enter a custom model ID${RESET}\n\n";

    print STDERR "  Choice [${GREEN}1${RESET}]: ";
    my $choice = <STDIN>;
    if (!defined $choice) {
        print STDERR "\nCancelled.\n";
        exit 130;
    }
    $choice =~ s/^\s+//;
    $choice =~ s/\s+$//;
    $choice = '1' if $choice eq '';

    if ($choice !~ /^\d+$/) {
        print STDERR "${RED}Invalid input.${RESET}\n";
        exit 1;
    }
    my $idx = $choice + 0;
    if ($idx >= 1 && $idx <= @DEFAULT_MODEL_ORDER) {
        $args->{model} = $DEFAULT_MODELS{ $DEFAULT_MODEL_ORDER[$idx - 1] };
    }
    elsif ($idx == @DEFAULT_MODEL_ORDER + 1) {
        print STDERR "  Model ID: ";
        my $custom = <STDIN>;
        if (!defined $custom) {
            print STDERR "\nCancelled.\n";
            exit 130;
        }
        $custom =~ s/^\s+//;
        $custom =~ s/\s+$//;
        if ($custom eq '') {
            print STDERR "${RED}Model ID cannot be empty.${RESET}\n";
            exit 1;
        }
        $args->{model} = $custom;
    }
    else {
        print STDERR "${RED}Invalid choice.${RESET}\n";
        exit 1;
    }
    return;
}

sub is_number {
    my ($value) = @_;
    return defined $value && $value =~ /^-?\d+(?:\.\d+)?(?:[eE][-+]?\d+)?$/;
}

# A positive integer: the port, the context length and the tensor parallel size
# are counts, so the fractional and exponent forms is_number accepts must not
# reach the engine's command line.
sub is_positive_int {
    my ($value) = @_;
    return defined $value && $value =~ /^\d+$/ && $value + 0 > 0;
}

# A directory the generated nginx configuration and the unit file carry
# verbatim: absolute, and free of the whitespace that splits arguments, of the
# % systemd expands as a specifier and of the ; that ends an nginx directive.
sub valid_dir_path {
    my ($path) = @_;
    return 0 unless defined $path && length $path;
    return 0 unless substr($path, 0, 1) eq '/';
    return $path !~ /[\s%;]/;
}

sub validate_args {
    my ($args) = @_;
    if ($args->{service_name} !~ /^[A-Za-z0-9_.\@-]+$/) {
        _fail("Invalid --service-name: '$args->{service_name}'");
        exit 1;
    }
    if (length $args->{image} && $args->{image} =~ /[\s%]/) {
        _fail("Invalid --image: '$args->{image}' (whitespace and % are not allowed)");
        exit 1;
    }
    if (!valid_dir_path($args->{state_dir})) {
        _fail("Invalid --state-dir: '$args->{state_dir}' (an absolute path without "
            . "whitespace, % or ;)");
        exit 1;
    }
    if (!valid_dir_path($args->{cert_dir})) {
        _fail("Invalid --cert-dir: '$args->{cert_dir}' (an absolute path without "
            . "whitespace, % or ;)");
        exit 1;
    }
    if (length $args->{rocm_flavour}
        && !grep { $_->[0] eq $args->{rocm_flavour} } @ROCM_FLAVOURS) {
        _fail("Invalid --rocm-flavour: '$args->{rocm_flavour}' (expected one of "
            . join(', ', map { $_->[0] } @ROCM_FLAVOURS));
        exit 1;
    }
    return if $args->{uninstall};

    if (!defined $args->{model} || $args->{model} !~ $MODEL_ID_RE) {
        my $shown = defined $args->{model} ? $args->{model} : '';
        _fail("Invalid model ID: '$shown' (expected 'org/name', "
            . "letters, digits, dot, dash, underscore only)");
        exit 1;
    }
    if (!is_positive_int($args->{port}) || $args->{port} + 0 > 65535
        || $args->{port} + 0 == 443) {
        _fail("Invalid --port $args->{port}: must be an integer 1-65535 and not 443 "
            . "(nginx)");
        exit 1;
    }
    if (!is_number($args->{gpu_memory_utilization})
        || $args->{gpu_memory_utilization} + 0 <= 0
        || $args->{gpu_memory_utilization} + 0 > 1) {
        _fail("Invalid --gpu-memory-utilization $args->{gpu_memory_utilization} "
            . ": must be in (0, 1]");
        exit 1;
    }
    if (!is_positive_int($args->{max_model_len})) {
        _fail("Invalid --max-model-len $args->{max_model_len}: must be a positive "
            . "integer");
        exit 1;
    }
    if (!is_positive_int($args->{tensor_parallel})) {
        _fail("Invalid --tensor-parallel $args->{tensor_parallel}: must be a positive "
            . "integer");
        exit 1;
    }
    if (defined $args->{api_key} && ($args->{api_key} eq '' || $args->{api_key} =~ /\s/)) {
        _fail('Invalid --api-key: must be non-empty and contain no whitespace');
        exit 1;
    }
    return;
}

# ---------------------------------------------------------------------------
# Main
# ---------------------------------------------------------------------------

sub main {
    my $start = time();
    my (@warnings, %results, @failures);

    # parse_args first: --help/--version must work without root privileges.  The
    # sections take a reference to it, so it stays one value as it travels.
    my %opts = parse_args();
    my $args = \%opts;
    check_root();
    prompt_model($args) if !$args->{uninstall} && !defined $args->{model};
    validate_args($args);
    my ($os_id, $os_display, $version_id) = detect_os();

    # Header.
    print STDERR "\n${BOLD}" . ('═' x 60) . "${RESET}\n";
    print STDERR "${BOLD}  SGLang Deploy  v$VERSION: $os_display $version_id (ROCm)${RESET}\n";
    print STDERR "${BOLD}" . ('═' x 60) . "${RESET}\n";
    if ($args->{dry_run}) {
        print STDERR "\n  ${YELLOW}${BOLD}DRY RUN: no changes will be made${RESET}\n";
    }
    if ($args->{uninstall} && !$args->{dry_run}) {
        print STDERR "\n  ${YELLOW}${BOLD}UNINSTALL MODE: all SGLang components will be removed${RESET}\n";
    }
    print STDERR "\n";

    my ($bind_host, $upstream_host) = detect_loopback();

    # ── Uninstall path ──
    if ($args->{uninstall}) {
        print STDERR "${BOLD}── Uninstall ──${RESET}\n";
        $results{uninstall} = uninstall($args, $args->{dry_run});
        print_summary({
            results        => \%results,
            warnings       => \@warnings,
            service_name   => $args->{service_name},
            port           => $args->{port},
            os_display     => $os_display,
            version_id     => $version_id,
            elapsed        => time() - $start,
            dry_run        => $args->{dry_run},
            uninstall_mode => 1,
            bind_host      => $bind_host,
        });
        exit 1 if defined $results{uninstall}{container_removed}
            && $results{uninstall}{container_removed} eq 0;
        return 0;
    }

    # ── Deploy path ──
    # 1. System dependencies (before preflight: provides lspci, curl and podman).
    print STDERR "\n${BOLD}── System Dependencies ──${RESET}\n";
    $results{system_deps} = install_system_deps($args->{dry_run});
    my @failed_pkgs = @{ $results{system_deps}{failed} // [] };
    push @failures, 'failed to install packages: ' . join(', ', @failed_pkgs) if @failed_pkgs;

    # 2. Pre-flight checks.
    print STDERR "\n${BOLD}── Pre-flight Checks ──${RESET}\n";
    my $preflight = preflight_checks($os_id, $version_id, $args);
    $results{preflight} = $preflight;
    my $gpu_count = $preflight->{gpu_count} // 0;
    _info("GPU count: $gpu_count");
    if ($gpu_count && $gpu_count < $args->{tensor_parallel} + 0) {
        push @warnings, "--tensor-parallel=$args->{tensor_parallel} but only "
            . "$gpu_count GPU(s) detected";
    }

    # 3. State directory and model cache.
    print STDERR "\n${BOLD}── Model Cache ──${RESET}\n";
    $results{state_dir} = setup_state_dir($args->{state_dir}, $args->{dry_run});
    if (defined $results{state_dir}{state_dir_created}
        && $results{state_dir}{state_dir_created} eq 0) {
        _fail('Could not create the state directory: cannot continue');
        exit 1;
    }

    # 4. Engine image (fatal on failure, nothing runs without it).
    print STDERR "\n${BOLD}── Engine Image ──${RESET}\n";
    $results{image} = fetch_engine_image($preflight->{engine_image}, $args->{dry_run});
    if (defined $results{image}{image_pulled} && $results{image}{image_pulled} eq 0) {
        _fail('Engine image is not available: cannot continue');
        exit 1;
    }

    # 5. TLS certificate (fatal, nginx cannot start without it).
    print STDERR "\n${BOLD}── TLS Certificate ──${RESET}\n";
    $results{tls} = setup_tls($args->{cert_dir}, $args->{dry_run});
    if (defined $results{tls}{cert_created} && $results{tls}{cert_created} eq 0) {
        _fail('TLS certificate setup failed: cannot continue');
        exit 1;
    }

    # 6. API key environment file.
    print STDERR "\n${BOLD}── API Key ──${RESET}\n";
    $results{api_key} = setup_api_key($args->{service_name}, $args->{api_key}, $args->{dry_run});
    if (defined $results{api_key}{env_file} && $results{api_key}{env_file} eq 'failed') {
        _fail('Could not store the API key: cannot continue');
        exit 1;
    }

    # 7. SELinux (non-fatal: only relevant on enforcing systems).
    print STDERR "\n${BOLD}── SELinux ──${RESET}\n";
    $results{selinux} = setup_selinux($args->{dry_run});
    if (defined $results{selinux}{selinux} && $results{selinux}{selinux} eq 'failed') {
        push @failures, 'SELinux boolean httpd_can_network_connect not set';
    }

    # 8. nginx.
    print STDERR "\n${BOLD}── nginx ──${RESET}\n";
    $results{nginx} = setup_nginx(
        $args->{port}, $upstream_host, $args->{cert_dir}, $args->{service_name}, $args->{dry_run},
    );
    if (defined $results{nginx}{nginx_reloaded} && $results{nginx}{nginx_reloaded} eq 0) {
        push @failures, 'nginx configuration reload failed';
    }

    # 9. systemd service (the model is probed before the unit is written).
    print STDERR "\n${BOLD}── systemd Service ──${RESET}\n";
    _status('Verifying ' . model_display($args->{model}) . ' on ModelScope');
    my $ms_status = ms_model_status($args->{model});
    if ($ms_status eq 'missing') {
        _status_done('not found');
        _fail("Model '$args->{model}' does not exist on ModelScope");
        exit 1;
    }
    if ($ms_status eq 'unknown') {
        _status_done('could not verify (offline?)');
    }
    else {
        _status_done('found');
    }

    $results{systemd} = setup_systemd({
        model                  => $args->{model},
        port                   => $args->{port},
        host                   => $bind_host,
        tensor_parallel        => $args->{tensor_parallel},
        max_model_len          => $args->{max_model_len},
        gpu_memory_utilization => $args->{gpu_memory_utilization},
        state_dir              => $args->{state_dir},
        service_name           => $args->{service_name},
        image                  => $preflight->{engine_image},
        radeon_env             => $preflight->{radeon_env},
    }, $args->{dry_run});
    if (defined $results{systemd}{service_started} && $results{systemd}{service_started} eq 0) {
        push @failures, "$args->{service_name} service failed to start";
    }

    # 10. Firewall.
    print STDERR "\n${BOLD}── Firewall ──${RESET}\n";
    $results{firewall} = setup_firewall($args->{dry_run});
    if (defined $results{firewall}{firewall_configured}
        && $results{firewall}{firewall_configured} eq 0) {
        push @failures, 'firewall rule for HTTPS (443) not applied';
    }

    print_summary({
        results          => \%results,
        warnings         => \@warnings,
        model            => $args->{model},
        port             => $args->{port},
        service_name     => $args->{service_name},
        os_display       => $os_display,
        version_id       => $version_id,
        state_dir        => $args->{state_dir},
        elapsed          => time() - $start,
        dry_run          => $args->{dry_run},
        uninstall_mode   => 0,
        bind_host        => $bind_host,
        generated_api_key => $results{api_key}{generated_key},
    });

    if (@failures) {
        _fail('Completed with ' . scalar(@failures) . ' failed step(s):');
        _info("  - $_") for @failures;
        exit 1;
    }
    return 0;
}

END {
    remove_scratch();
}

exit(main()) unless caller;