#!/usr/bin/perl
# Unit checks for sglang-deploy.pl: the pure helpers, against what they must produce.
use strict;
use warnings;

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

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

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

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

# The verdict of a match is forced into a boolean: in a sub argument list a failed match
# yields the empty list, which shifts the label into the condition slot and turns the
# failure into a silent pass.
sub like {
    my ($got, $re, $label) = @_;
    $label = 'like without a label' unless defined $label;
    my $matched = (defined $got && $got =~ $re) ? 1 : 0;
    return is($matched, 1, $label);
}

sub check_unlike {
    my ($got, $re, $label) = @_;
    $label = 'check_unlike without a label' unless defined $label;
    my $matched = (defined $got && $got !~ $re) ? 1 : 0;
    return is($matched, 1, $label);
}

# ---- version_cmp ----------------------------------------------------------
is(version_cmp('7.2.4', '7.2.0'), 1,  'version_cmp 7.2.4 > 7.2.0');
is(version_cmp('7.2.0', '7.2.4'), -1, 'version_cmp 7.2.0 < 7.2.4');
is(version_cmp('7.2', '7.2.0'), 0,    'version_cmp 7.2 == 7.2.0');
is(version_cmp('10.0.0', '7.2.4'), 1, 'version_cmp 10.0.0 > 7.2.4');
is(version_cmp('6.4.3', '7.0.0'), -1, 'version_cmp 6.4.3 < 7.0.0');
is(version_cmp('7.10.0', '7.9.0'), 1, 'version_cmp 7.10.0 > 7.9.0 (numeric, not lexical)');

# ---- select_rocm_flavour --------------------------------------------------
is(select_rocm_flavour('7.2.4'), 'rocm724', 'flavour: host 7.2.4');
is(select_rocm_flavour('7.2.5'), 'rocm724', 'flavour: host 7.2.5');
is(select_rocm_flavour('7.2.3'), 'rocm720', 'flavour: host 7.2.3');
is(select_rocm_flavour('7.2.0'), 'rocm720', 'flavour: host 7.2.0');
is(select_rocm_flavour('7.1.0'), 'rocm700', 'flavour: host 7.1.0 falls back to rocm700');
is(select_rocm_flavour('7.0.0'), 'rocm700', 'flavour: host 7.0.0');
is(select_rocm_flavour('10.0.0'), 'rocm10', 'flavour: host 10.0.0');
is(select_rocm_flavour('10.2.0'), 'rocm10', 'flavour: host 10.2.0');
is(select_rocm_flavour('6.4.0'), undef,    'flavour: host 6.4.0 has no image');

# ---- arch_variant / radeon_present ---------------------------------------
my @mi300 = ('Advanced Micro Devices, Inc. [AMD/ATI] Instinct MI300X OAM [1002:74a1] (rev 01)');
my @mi325 = ('Advanced Micro Devices, Inc. [AMD/ATI] Instinct MI325X [1002:74a1]');
my @mi350 = ('Advanced Micro Devices, Inc. [AMD/ATI] Instinct MI350X [1002:75a0]');
my @mi355 = ('Advanced Micro Devices, Inc. [AMD/ATI] Instinct MI355X [1002:75a3]');
my @radeon = ('Advanced Micro Devices, Inc. [AMD/ATI] Navi 31 [Radeon RX 7900 XTX] [1002:744c]');
my @strix = ('Advanced Micro Devices, Inc. [AMD/ATI] Strix Halo [Radeon 8060S] [1002:150e]');
is(arch_variant(\@mi300), 'mi30x', 'arch: MI300X -> mi30x');
is(arch_variant(\@mi325), 'mi30x', 'arch: MI325X -> mi30x');
is(arch_variant(\@mi350), 'mi35x', 'arch: MI350X -> mi35x');
is(arch_variant(\@mi355), 'mi35x', 'arch: MI355X -> mi35x');
is(arch_variant(\@radeon), undef,  'arch: Radeon has no published image');
is(arch_variant(\@strix), 'gfx1151', 'arch: Strix Halo maps to gfx1151');
is(radeon_present(\@radeon), 1, 'radeon: Navi 31 detected');
is(radeon_present(\@strix), 0, 'radeon: Strix Halo is served by AMD builds');
is(radeon_present(\@mi300), 0, 'radeon: MI300X is not a Radeon card');

# ---- resolve_image / model_display ---------------------------------------
is(resolve_image('docker.io/lmsysorg/sglang', 'v0.5.19', 'mi30x', 'rocm10'),
   'docker.io/lmsysorg/sglang:v0.5.19-rocm10-mi30x', 'image: resolved tag');
is(resolve_image('docker.io/rocm/sgl-dev', 'v0.5.19', 'gfx1151', 'rocm724'),
   'docker.io/rocm/sgl-dev:v0.5.19-rocm724-gfx1151', 'image: AMD dev repository for gfx1151');
is(model_display('ZhipuAI/GLM-5.3'), 'GLM 5.3', 'display: known model');
is(model_display('acme/unknown'), 'acme/unknown', 'display: unknown model passes through');

# ---- the preset catalogue ------------------------------------------------
# The menu is the owner's list in the owner's order, so the names are asserted
# one by one, and each display name must resolve to the exact ModelScope
# repository the engine will pull weights from.
is(join('|', default_model_order()),
   'GLM 5.3|GLM 5.3 Flash|Qwen 3.8 Max|Qwen 3.8 Flash|DeepSeek V4.1 Flash',
   'presets: the menu order');
is(model_display('ZhipuAI/GLM-5.3'), 'GLM 5.3', 'presets: GLM 5.3');
is(default_model_repo('GLM 5.3'), 'ZhipuAI/GLM-5.3', 'presets: GLM 5.3 on ModelScope');
is(default_model_repo('GLM 5.3 Flash'), 'ZhipuAI/GLM-5.3-Flash',
   'presets: GLM 5.3 Flash on ModelScope, under ZhipuAI');
is(default_model_repo('Qwen 3.8 Max'), 'Qwen/Qwen3.8-2.4T-A95B',
   'presets: Qwen 3.8 Max under its weight name');
is(default_model_repo('Qwen 3.8 Flash'), 'Qwen/Qwen3.8-Flash-Next',
   'presets: Qwen 3.8 Flash under its weight name');
is(default_model_repo('DeepSeek V4.1 Flash'), 'deepseek-ai/DeepSeek-V4.1-Flash',
   'presets: DeepSeek V4.1 Flash');
is(model_display('Qwen/Qwen3.8-2.4T-A95B'), 'Qwen 3.8 Max',
   'display: the reverse lookup through a weight name');
for my $id (map { default_model_repo($_) } default_model_order()) {
    like($id, qr{^[A-Za-z0-9._-]+/[A-Za-z0-9._-]+$}, "presets: $id fits the model ID pattern");
}

# ---- base64url and key shape ---------------------------------------------
is(encode_base64url('Man'), 'TWFu', 'base64url: Man -> TWFu');
is(encode_base64url("\xfb\xff"), '-_8', 'base64url: FB FF -> -_8 (url alphabet)');
is(encode_base64url('M'), 'TQ', 'base64url: one byte, no padding');
my $key = generate_api_key();
like($key, qr/^[A-Za-z0-9_-]{43}$/, 'key: 32 bytes -> 43 url-safe characters');
my $key2 = generate_api_key();
is($key eq $key2 ? 'same' : 'different', 'different', 'key: two calls differ');

# ---- is_number ------------------------------------------------------------
is((is_number('8000') ? 1 : 0), 1, 'is_number: 8000');
is((is_number('0.90') ? 1 : 0), 1, 'is_number: 0.90');
is((is_number('abc') ? 1 : 0), 0, 'is_number: abc');
is((is_number('') ? 1 : 0), 0, 'is_number: empty');

# ---- is_positive_int / valid_dir_path -------------------------------------
is((is_positive_int('4') ? 1 : 0), 1, 'is_positive_int: 4');
is((is_positive_int('0') ? 1 : 0), 0, 'is_positive_int: 0 is not positive');
is((is_positive_int('8000.5') ? 1 : 0), 0, 'is_positive_int: a fractional port is refused');
is((is_positive_int('1e2') ? 1 : 0), 0, 'is_positive_int: an exponent is refused');
is((valid_dir_path('/opt/sglang') ? 1 : 0), 1, 'valid_dir_path: an absolute path passes');
is((valid_dir_path('sglang') ? 1 : 0), 0, 'valid_dir_path: a relative path is refused');
is((valid_dir_path('/opt/sg lang') ? 1 : 0), 0, 'valid_dir_path: whitespace is refused');
is((valid_dir_path('/opt/%h/sglang') ? 1 : 0), 0,
   'valid_dir_path: a systemd specifier is refused');
is((valid_dir_path('/opt/x;/sglang') ? 1 : 0), 0,
   'valid_dir_path: an nginx directive end is refused');

# ---- run(): exit status, signals and timeout ------------------------------
my $killed = run([$^X, '-e', 'kill 9, $$']);
is($killed->{rc}, 137, 'run: a child killed by a signal reports 128+signal, not 0');
my $exited = run([$^X, '-e', 'exit 3']);
is($exited->{rc}, 3, 'run: the child exit code passes through');
my $timedout = run([$^X, '-e', 'sleep 5'], timeout => 1);
is($timedout->{rc}, 124, 'run: an expired timeout reports rc 124');

# ---- family_is_fatal: --image overrides the GPU family --------------------
is(family_is_fatal(undef, 0), 1, 'family: an unmatched card without --image is fatal');
is(family_is_fatal(undef, 1), 0, 'family: --image overrides an unmatched card');
is(family_is_fatal('mi30x', 0), 0, 'family: a published family is never fatal');

# ---- radeon_env_for: the family decides, not any Radeon -------------------
my @mixed = ('Instinct MI300X [1002:74a1]', 'Navi 31 [Radeon RX 7900 XTX] [1002:744c]');
is(arch_variant(\@mixed), 'mi30x', 'env: a mixed host resolves the Instinct family');
is(radeon_present(\@mixed), 1, 'env: a mixed host does carry a Radeon');
is(scalar @{ radeon_env_for(arch_variant(\@mixed), radeon_present(\@mixed)) }, 0,
   'env: a display Radeon does not switch an Instinct deployment to the Radeon defaults');
is(scalar @{ radeon_env_for('gfx1151', 0) }, 2, 'env: gfx1151 carries the Radeon defaults');
is(scalar @{ radeon_env_for(undef, 1) }, 2,
   'env: a custom image on a Radeon-only host carries the Radeon defaults');
is(scalar @{ radeon_env_for('mi30x', 0) }, 0, 'env: an Instinct host carries none');

# ---- nginx config --------------------------------------------------------
my $conf = nginx_conf_content(8000, '[::1]', '/etc/ssl/sglang');
like($conf, qr/listen \[::\]:443 ssl;/, 'nginx: IPv6 listener on a dual-stack kernel');
like($conf, qr/listen 443 ssl;/, 'nginx: IPv4 listener');
like($conf, qr|ssl_certificate /etc/ssl/sglang/sglang\.crt;|, 'nginx: certificate path');
like($conf, qr/ssl_certificate_key \/etc\/ssl\/sglang\/sglang\.key;/, 'nginx: key path');
like($conf, qr|proxy_pass http://\[::1\]:8000;|, 'nginx: loopback upstream with the port');
like($conf, qr/proxy_http_version 1\.1;/, 'nginx: HTTP/1.1 for streaming');
like($conf, qr/proxy_buffering off;/, 'nginx: buffering off for streaming');
like($conf, qr/proxy_set_header Host \$host;/, 'nginx: $host survives the heredoc');
like($conf, qr/proxy_set_header X-Forwarded-For \$proxy_add_x_forwarded_for;/,
     'nginx: $proxy_add_x_forwarded_for survives the heredoc');

my $conf4 = nginx_conf_content(8000, '127.0.0.1', '/etc/ssl/sglang');
is($conf4 =~ /\[::\]/ ? 'yes' : 'no',
   (-e '/proc/net/if_inet6' ? 'yes' : 'no'), 'nginx: IPv6 listener follows the kernel');

# ---- systemd unit --------------------------------------------------------
my $unit = systemd_content({
    model                  => 'ZhipuAI/GLM-5.3',
    host                   => '::1',
    port                   => 8000,
    tensor_parallel        => 4,
    max_model_len          => 32768,
    gpu_memory_utilization => '0.9',
    state_dir              => '/opt/sglang',
    image                  => 'docker.io/lmsysorg/sglang:v0.5.19-rocm10-mi30x',
    env_file               => '/etc/sysconfig/sglang',
    radeon_env             => [],
});
like($unit, qr/Description=SGLang Inference Server \(ZhipuAI\/GLM-5\.3\)/, 'unit: description');
like($unit, qr/EnvironmentFile=\/etc\/sysconfig\/sglang/, 'unit: EnvironmentFile');
like($unit, qr/Environment=SGLANG_USE_MODELSCOPE=true/, 'unit: weights come from ModelScope');
like($unit, qr/--network=host/, 'unit: host networking');
like($unit, qr/--device=\/dev\/kfd --device=\/dev\/dri/, 'unit: GPU device nodes');
like($unit, qr/--group-add video/, 'unit: video group');
like($unit, qr/--ipc=host/, 'unit: IPC namespace');
like($unit, qr/--cap-add=SYS_PTRACE/, 'unit: ptrace capability');
like($unit, qr/--security-opt seccomp=unconfined/, 'unit: seccomp');
like($unit, qr|--volume /opt/sglang/modelscope:/root/\.cache/modelscope:Z|,
     'unit: ModelScope cache volume with SELinux relabel');
like($unit, qr/--env MODELSCOPE_TOKEN/, 'unit: ModelScope token forwarded when set');
like($unit, qr/--rm --replace --name sglang/, 'unit: container name and cleanup');
like($unit, qr/--pull=missing/, 'unit: pull policy');
like($unit, qr/docker\.io\/lmsysorg\/sglang:v0\.5\.19-rocm10-mi30x/, 'unit: image');
like($unit, qr/python3 -m sglang\.launch_server/, 'unit: engine entry point');
like($unit, qr/--model-path ZhipuAI\/GLM-5\.3/, 'unit: model path');
like($unit, qr/--host ::1/, 'unit: loopback bind');
like($unit, qr/--port 8000/, 'unit: port');
like($unit, qr/--api-key \$\{SGLANG_API_KEY\}/, 'unit: API key from the environment file');
is($unit =~ /sk-[A-Za-z0-9]/ ? 'yes' : 'no', 'no', 'unit: no literal API key');
like($unit, qr/--tp-size 4/, 'unit: tensor parallel as --tp-size');
like($unit, qr/--context-length 32768/, 'unit: context length');
like($unit, qr/--mem-fraction-static 0\.9/, 'unit: static memory fraction');
is($unit =~ /SGLANG_USE_AITER/ ? 'yes' : 'no', 'no',
   'unit: no Radeon variables on a non-Radeon host');
like($unit, qr/WantedBy=multi-user\.target/, 'unit: install section');
like($unit, qr/Restart=on-failure/, 'unit: restart policy');

my $unit_radeon = systemd_content({
    model                  => 'ZhipuAI/GLM-5.3',
    host                   => '::1',
    port                   => 8000,
    tensor_parallel        => 1,
    max_model_len          => 4096,
    gpu_memory_utilization => '0.9',
    state_dir              => '/opt/sglang',
    image                  => 'local/sglang-rocm:latest',
    env_file               => '/etc/sysconfig/sglang',
    radeon_env             => ['SGLANG_USE_AITER=false', 'SGLANG_ROCM_FUSED_DECODE_MLA=false'],
});
like($unit_radeon, qr/Environment=SGLANG_USE_AITER=false/, 'unit: AITER off on Radeon');
like($unit_radeon, qr/Environment=SGLANG_ROCM_FUSED_DECODE_MLA=false/,
     'unit: fused decode MLA off on Radeon');

# ---- parse_os_release reads the host (smoke test) ------------------------
my %release = parse_os_release();
is(exists $release{ID} ? 'present' : 'absent', 'present', 'os-release: ID is parsed');

# ---- arguments -----------------------------------------------------------
my @ARGV_COPY = @ARGV;
local @ARGV = ('--model', 'ZhipuAI/GLM-5.3', '--port=9000', '--tensor-parallel', '2');
my %args = parse_args();
is($args{model}, 'ZhipuAI/GLM-5.3', 'args: --model value');
is($args{port}, '9000', 'args: --port=9000 inline form');
is($args{tensor_parallel}, '2', 'args: --tensor-parallel value');
is($args{service_name}, 'sglang', 'args: service name default');
is($args{state_dir}, '/opt/sglang', 'args: state dir default');
is($args{cert_dir}, '/etc/ssl/sglang', 'args: cert dir default');

@ARGV = ('--dry-run', '--uninstall', '--rocm-flavour', 'rocm720');
my %args2 = parse_args();
is($args2{dry_run}, 1, 'args: --dry-run');
is($args2{uninstall}, 1, 'args: --uninstall');
is($args2{rocm_flavour}, 'rocm720', 'args: --rocm-flavour');

@ARGV = @ARGV_COPY;

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