tribes-supertest/scripts/test-dev-branch

#!/usr/bin/env perl

use strict;
use warnings;

use Cwd qw(abs_path getcwd);
use File::Basename qw(dirname);
use File::Path qw(make_path);
use File::Spec;
use Getopt::Long qw(GetOptionsFromArray);
use IO::Select;
use IPC::Open3 qw(open3);
use JSON::PP qw(decode_json encode_json);
use POSIX qw(strftime);
use Symbol qw(gensym);
use Time::HiRes qw(time);

my $DEV_BRANCH = 'supertest-dev';
my $CHANNEL_URL = 'https://git.teralink.net/tribes/guix-tribes.git';
my $INTRO_COMMIT = '7c4f9d3b3477945ca75d22baa237c44895f2e454';
my $DEV_FINGERPRINT = 'F29B A6DA 96E5 EC29 FDDE D994 8F4F 75B3 B19D 4784';
my $DEV_FINGERPRINT_COMPACT = 'F29BA6DA96E5EC29FDDED9948F4F75B3B19D4784';
my $SIGNER_LABEL = 'tribes-supertest-dev';
my $DEV_KEY_FILE = 'supertest-dev-B19D4784.key';

my %COMMANDS = map { $_ => 1 } qw(prepare reset env run ssh rpc help);

sub usage {
    print <<'EOF';
Usage:
  scripts/test-dev-branch [options] <scenario>
  scripts/test-dev-branch prepare [options]
  scripts/test-dev-branch reset [options]
  scripts/test-dev-branch env [options]
  scripts/test-dev-branch run [options] <scenario>
  scripts/test-dev-branch ssh [options] <node> [-- <command...>]
  scripts/test-dev-branch rpc [options] <node> -- <elixir-expression>

Options:
  --plugin NAME         Update and test plugin NAME (default: no plugin override)
  --plugin-repo PATH    Plugin checkout to pin (default: ../tribes-plugin-NAME)
  --keep-nodes         Keep nodes after the scenario run
  --cert-mode MODE     self-signed (default) or acme
  --run-id ID          Override generated SUPERTEST_RUN_ID
  --guix-repo PATH     guix-tribes checkout (default: ../guix-tribes)
  --tribes-repo PATH   tribes checkout (default: ../tribes)
  --legion-repo PATH   legion_kk checkout (default: ../legion_kk)
  --build-host HOST    optional remote Guix build host for pin helpers (default: local Guix)
  --dry-run            Print commands that would run
  -h, --help           Show this help

The default form prepares the hard-coded supertest-dev guix-tribes branch and
then runs the requested scenario in self-signed mode.
EOF
}

sub fail {
    die "@_\n";
}

sub shell_quote {
    my ($value) = @_;
    $value =~ s/'/'\\''/g;
    return "'$value'";
}

sub display_cmd {
    return join(' ', map { shell_quote($_) } @_);
}

sub compact_fingerprint {
    my ($value) = @_;
    $value =~ s/\s+//g;
    return $value;
}

sub run_checked {
    my ($ctx, @cmd) = @_;
    print "+ ", display_cmd(@cmd), "\n" if $ctx->{verbose} || $ctx->{dry_run};
    return if $ctx->{dry_run};
    system(@cmd) == 0 or fail("Command failed: " . display_cmd(@cmd));
}

sub capture {
    my (@cmd) = @_;
    my $err = gensym;
    my $pid = open3(my $in, my $out, $err, @cmd);
    close $in;

    my $output = '';
    my $select = IO::Select->new($out, $err);
    while (my @ready = $select->can_read) {
        for my $fh (@ready) {
            my $chunk = '';
            my $bytes = sysread($fh, $chunk, 8192);
            if (defined $bytes && $bytes > 0) {
                $output .= $chunk;
                next;
            }

            $select->remove($fh);
            close $fh;
        }
    }

    waitpid($pid, 0);
    my $status = $? >> 8;
    return ($status, $output);
}

sub capture_checked {
    my (@cmd) = @_;
    my ($status, $output) = capture(@cmd);
    $status == 0 or fail("Command failed: " . display_cmd(@cmd) . "\n$output");
    chomp $output;
    return $output;
}

sub read_file {
    my ($path) = @_;
    open my $fh, '<', $path or fail("Failed to read $path: $!");
    local $/;
    return <$fh>;
}

sub write_file {
    my ($path, $content) = @_;
    open my $fh, '>', $path or fail("Failed to write $path: $!");
    print {$fh} $content or fail("Failed to write $path: $!");
    close $fh or fail("Failed to close $path: $!");
}

sub write_json_file {
    my ($path, $data) = @_;
    my $json = JSON::PP->new->canonical->pretty->encode($data);
    write_file($path, $json);
}

sub repo_root {
    my $script_dir = abs_path(dirname($0));
    return abs_path(File::Spec->catdir($script_dir, '..'));
}

sub abs_default {
    my ($base, $path) = @_;
    return abs_path(File::Spec->rel2abs($path, $base));
}

sub parse_args {
    my @argv = @_;
    my $root = repo_root();
    my %opts = (
        cert_mode => 'self-signed',

        dry_run => 0,
        keep_nodes => 0,
        guix_repo => abs_default($root, '../guix-tribes'),
        tribes_repo => abs_default($root, '../tribes'),
        legion_repo => abs_default($root, '../legion_kk'),
    );

    GetOptionsFromArray(
        \@argv,
        'plugin=s'      => \$opts{plugin},
        'plugin-repo=s' => \$opts{plugin_repo},
        'keep-nodes'    => \$opts{keep_nodes},
        'cert-mode=s'   => \$opts{cert_mode},
        'run-id=s'      => \$opts{run_id},
        'guix-repo=s'   => \$opts{guix_repo},
        'tribes-repo=s' => \$opts{tribes_repo},
        'legion-repo=s' => \$opts{legion_repo},
        'build-host=s'  => \$opts{build_host},
        'dry-run'       => \$opts{dry_run},
        'h|help'        => \$opts{help},
    ) or do {
        usage();
        exit 1;
    };

    if ($opts{help}) {
        usage();
        exit 0;
    }

    $opts{guix_repo} = abs_default($root, $opts{guix_repo});
    $opts{tribes_repo} = abs_default($root, $opts{tribes_repo});
    $opts{legion_repo} = abs_default($root, $opts{legion_repo});
    $opts{plugin_repo} = abs_default($root, $opts{plugin_repo}) if defined $opts{plugin_repo};
    $opts{root} = $root;

    my $command = shift(@argv);
    if (!defined $command) {
        usage();
        exit 1;
    }

    if (!$COMMANDS{$command}) {
        unshift @argv, $command;
        $command = 'run';
    }

    validate_cert_mode($opts{cert_mode});

    return ($command, \%opts, \@argv);
}

sub validate_cert_mode {
    my ($mode) = @_;
    return if $mode eq 'self-signed' || $mode eq 'acme';
    fail("Unsupported --cert-mode $mode; expected self-signed or acme.");
}

sub require_repo {
    my ($path, $label) = @_;
    my $git = File::Spec->catfile($path, '.git');
    (-d $git || -f $git) or fail("$label repo not found: $path");
}

sub require_clean_repo {
    my ($repo, $label) = @_;
    my $status = capture_checked('git', '-C', $repo, 'status', '--porcelain');
    $status eq '' or fail("$label repo has uncommitted changes:\n$status");
}

sub require_source_commit_pushed {
    my ($ctx, $repo, $label, $commit) = @_;
    run_checked($ctx, 'git', '-C', $repo, 'fetch', 'origin');
    my $branches = capture_checked('git', '-C', $repo, 'branch', '-r', '--contains', $commit);
    $branches =~ /\borigin\//
      or fail("$label commit $commit is not reachable from any origin branch. Push the source repo first.");
}

sub current_commit {
    my ($repo, $rev) = @_;
    return capture_checked('git', '-C', $repo, 'rev-parse', "$rev^{commit}");
}

sub current_branch {
    my ($repo) = @_;
    return capture_checked('git', '-C', $repo, 'branch', '--show-current');
}

sub ensure_dev_signing_key {
    my ($ctx) = @_;
    my $key = capture_checked('git', '-C', $ctx->{guix_repo}, 'config', '--get', 'user.signingkey');
    $key eq $DEV_FINGERPRINT_COMPACT
      or fail("guix-tribes user.signingkey is $key, expected $DEV_FINGERPRINT_COMPACT.");
}

sub branch_contains {
    my ($repo, $ancestor, $descendant) = @_;
    my ($status, undef) = capture('git', '-C', $repo, 'merge-base', '--is-ancestor', $ancestor, $descendant);
    return $status == 0;
}

sub ensure_dev_branch_ready {
    my ($ctx) = @_;
    my $repo = $ctx->{guix_repo};
    my $branch = current_branch($repo);
    my $local_ready = branch_contains($repo, $INTRO_COMMIT, $DEV_BRANCH);
    my $remote_ready = branch_contains($repo, $INTRO_COMMIT, "origin/$DEV_BRANCH");
    my $start_point =
      $local_ready ? $DEV_BRANCH :
      $remote_ready ? "origin/$DEV_BRANCH" :
      undef;

    defined $start_point
      or fail("$DEV_BRANCH does not descend from intro commit $INTRO_COMMIT locally or on origin. Run reset first.");

    if ($branch ne $DEV_BRANCH || !$local_ready) {
        if ($ctx->{dry_run}) {
            run_checked($ctx, 'git', '-C', $repo, 'checkout', '-B', $DEV_BRANCH, $start_point);
            return $start_point;
        }
        run_checked($ctx, 'git', '-C', $repo, 'checkout', '-B', $DEV_BRANCH, $start_point);
    }

    branch_contains($repo, $INTRO_COMMIT, 'HEAD')
      or fail("$DEV_BRANCH does not descend from intro commit $INTRO_COMMIT. Run reset first.");

    my $auth = read_file(File::Spec->catfile($repo, '.guix-authorizations'));
    compact_fingerprint($auth) =~ /\Q$DEV_FINGERPRINT_COMPACT\E/
      or fail("$DEV_BRANCH does not authorize the supertest dev signing key. Run reset first.");

    return $start_point;
}

sub authenticate_dev_branch {
    my ($ctx) = @_;
    my $end = current_commit($ctx->{guix_repo}, 'HEAD');
    run_checked(
        $ctx,
        'guix', 'git', 'authenticate',
        $INTRO_COMMIT,
        $DEV_FINGERPRINT_COMPACT,
        '--repository=' . $ctx->{guix_repo},
        '--end=' . $end,
    );
}

sub require_dev_branch_synced_to_master {
    my ($ctx) = @_;
    my $repo = $ctx->{guix_repo};
    my $sync_file = File::Spec->catfile($repo, '.supertest-dev-sync.json');
    -f $sync_file or fail("$DEV_BRANCH has no .supertest-dev-sync.json. Run scripts/test-dev-branch reset first.");

    my $sync = decode_json(read_file($sync_file));
    my $source_commit = $sync->{source_commit} // '';
    my $master_commit = current_commit($repo, 'origin/master');
    $source_commit eq $master_commit
      or fail("$DEV_BRANCH is synced to master $source_commit, but current origin/master is $master_commit. Run scripts/test-dev-branch reset first.");
}

sub commit_if_changed {
    my ($ctx, $message) = @_;
    my $repo = $ctx->{guix_repo};
    if ($ctx->{dry_run}) {
        print "Would commit guix-tribes changes if pin helpers changed files.\n";
        run_checked($ctx, 'git', '-C', $repo, 'add', 'tribes/packages/source.scm', 'tribes/plugins');
        run_checked($ctx, 'git', '-C', $repo, 'commit', '-S' . $DEV_FINGERPRINT_COMPACT, '-m', $message);
        return 1;
    }

    my $status = capture_checked('git', '-C', $repo, 'status', '--porcelain');
    if ($status eq '') {
        print "No guix-tribes changes to commit.\n";
        return 0;
    }

    run_checked($ctx, 'git', '-C', $repo, 'add', 'tribes/packages/source.scm', 'tribes/plugins');
    run_checked($ctx, 'git', '-C', $repo, 'commit', '-S' . $DEV_FINGERPRINT_COMPACT, '-m', $message);
    return 1;
}

sub ensure_plugin_name {
    my ($name) = @_;
    defined $name && $name =~ /\A[a-z0-9][a-z0-9_-]*\z/
      or fail("Invalid plugin name: " . (defined $name ? $name : ''));
}

sub plugin_repo_for {
    my ($ctx, $plugin) = @_;
    return $ctx->{plugin_repo} if defined $ctx->{plugin_repo};
    return abs_default($ctx->{root}, "../tribes-plugin-$plugin");
}

sub prepare {
    my ($ctx) = @_;
    require_repo($ctx->{guix_repo}, 'guix-tribes');
    require_repo($ctx->{tribes_repo}, 'tribes');
    require_clean_repo($ctx->{guix_repo}, 'guix-tribes');
    require_clean_repo($ctx->{tribes_repo}, 'tribes');
    ensure_dev_signing_key($ctx);

    my $tribes_commit = current_commit($ctx->{tribes_repo}, 'HEAD');
    require_source_commit_pushed($ctx, $ctx->{tribes_repo}, 'tribes', $tribes_commit);

    my ($plugin, $plugin_repo, $plugin_commit);
    if (defined $ctx->{plugin}) {
        $plugin = $ctx->{plugin};
        ensure_plugin_name($plugin);
        $plugin_repo = plugin_repo_for($ctx, $plugin);
        require_repo($plugin_repo, "tribes-plugin-$plugin");
        require_clean_repo($plugin_repo, "tribes-plugin-$plugin");
        $plugin_commit = current_commit($plugin_repo, 'HEAD');
        require_source_commit_pushed($ctx, $plugin_repo, "tribes-plugin-$plugin", $plugin_commit);
    }

    run_checked($ctx, 'git', '-C', $ctx->{guix_repo}, 'fetch', 'origin');
    my $dev_ref = ensure_dev_branch_ready($ctx);
    require_dev_branch_synced_to_master($ctx);

    my @build_host_args = defined $ctx->{build_host} && length $ctx->{build_host}
      ? ('--build-host', $ctx->{build_host})
      : ();

    run_checked(
        $ctx,
        File::Spec->catfile($ctx->{guix_repo}, 'scripts', 'update-tribes-pin'),
        '--guix-repo', $ctx->{guix_repo},
        '--tribes-repo', $ctx->{tribes_repo},
        @build_host_args,
        $tribes_commit,
    );

    if (defined $plugin) {
        run_checked(
            $ctx,
            File::Spec->catfile($ctx->{guix_repo}, 'scripts', 'update-plugin-pin'),
            '--guix-repo', $ctx->{guix_repo},
            '--tribes-repo', $ctx->{tribes_repo},
            '--tribes-rev', $tribes_commit,
            '--plugin-repo', $plugin_repo,
            @build_host_args,
            $plugin,
            $plugin_commit,
        );
    }

    my $message = defined $plugin
      ? "chore: update dev pins for $plugin plugin"
      : 'chore: update dev Tribes pin';
    commit_if_changed($ctx, $message);
    authenticate_dev_branch($ctx);
    run_checked($ctx, 'git', '-C', $ctx->{guix_repo}, 'push', 'origin', $DEV_BRANCH);

    my $guix_commit = $ctx->{dry_run}
      ? current_commit($ctx->{guix_repo}, $dev_ref)
      : current_commit($ctx->{guix_repo}, 'HEAD');
    print "Dry run only; channel commit below is the current dev branch base.\n" if $ctx->{dry_run};
    print_dev_env($guix_commit);
    return $guix_commit;
}

sub reset_branch {
    my ($ctx) = @_;
    require_repo($ctx->{guix_repo}, 'guix-tribes');
    require_clean_repo($ctx->{guix_repo}, 'guix-tribes');
    ensure_dev_signing_key($ctx);

    my $repo = $ctx->{guix_repo};
    run_checked($ctx, 'git', '-C', $repo, 'fetch', 'origin');
    branch_contains($repo, $INTRO_COMMIT, "origin/$DEV_BRANCH")
      or fail("origin/$DEV_BRANCH does not descend from intro commit $INTRO_COMMIT.");

    run_checked($ctx, 'git', '-C', $repo, 'checkout', '-B', $DEV_BRANCH, "origin/$DEV_BRANCH");
    authenticate_dev_branch($ctx);

    my $previous_dev_commit = current_commit($repo, 'HEAD');
    my $master_commit = current_commit($repo, 'origin/master');
    my $master_auth = capture_checked('git', '-C', $repo, 'show', 'origin/master:.guix-authorizations');
    my $dev_key = capture_checked('git', '-C', $repo, 'show', "HEAD:$DEV_KEY_FILE");
    my $sync_path = File::Spec->catfile($repo, '.supertest-dev-sync.json');
    my $sync_data = {
        mode => 'tree-sync',
        source_branch => 'origin/master',
        source_commit => $master_commit,
        previous_dev_commit => $previous_dev_commit,
        synced_at => iso_now(),
    };

    if ($ctx->{dry_run}) {
        print "Would replace $DEV_BRANCH tree with origin/master $master_commit, then restore dev authorization and $DEV_KEY_FILE.\n";
        run_checked($ctx, 'git', '-C', $repo, 'read-tree', '--reset', '-u', 'origin/master');
        run_checked($ctx, 'git', '-C', $repo, 'add', '-A');
        run_checked(
            $ctx,
            'git', '-C', $repo, 'commit', '-S' . $DEV_FINGERPRINT_COMPACT,
            '-m', 'chore: sync supertest dev channel to master',
            '-m', "Source: guix-tribes master $master_commit\nBase: previous supertest-dev $previous_dev_commit\nMode: tree sync, preserving dev channel authorization",
        );
        authenticate_dev_branch($ctx);
        run_checked($ctx, 'git', '-C', $repo, 'push', '--force-with-lease', 'origin', $DEV_BRANCH);
        return;
    }

    run_checked($ctx, 'git', '-C', $repo, 'read-tree', '--reset', '-u', 'origin/master');
    write_file(File::Spec->catfile($repo, '.guix-authorizations'), ensure_dev_authorization($master_auth));
    write_file(File::Spec->catfile($repo, $DEV_KEY_FILE), $dev_key);
    write_json_file($sync_path, $sync_data);
    run_checked($ctx, 'git', '-C', $repo, 'add', '-A');
    run_checked(
        $ctx,
        'git', '-C', $repo, 'commit', '-S' . $DEV_FINGERPRINT_COMPACT,
        '-m', 'chore: sync supertest dev channel to master',
        '-m', "Source: guix-tribes master $master_commit\nBase: previous supertest-dev $previous_dev_commit\nMode: tree sync, preserving dev channel authorization",
    );
    authenticate_dev_branch($ctx);
    run_checked($ctx, 'git', '-C', $repo, 'push', '--force-with-lease', 'origin', $DEV_BRANCH);
    print "Synced $DEV_BRANCH tree to origin/master $master_commit.\n";
}

sub ensure_dev_authorization {
    my ($text) = @_;
    return $text if compact_fingerprint($text) =~ /\Q$DEV_FINGERPRINT_COMPACT\E/;

    my $entry = qq(  ("$DEV_FINGERPRINT"\n   (name "$SIGNER_LABEL"))\n);
    $text =~ s/\)\)\s*\z/$entry))/s
      or fail('Could not add dev authorization to .guix-authorizations.');
    return $text;
}

sub print_dev_env {
    my ($commit) = @_;
    print "SUPERTEST_DEV_CHANNEL_MODE=1\n";
    print "SUPERTEST_GUIX_TRIBES_CHANNEL_URL=$CHANNEL_URL\n";
    print "SUPERTEST_GUIX_TRIBES_CHANNEL_BRANCH=$DEV_BRANCH\n";
    print "SUPERTEST_GUIX_TRIBES_CHANNEL_COMMIT=$commit\n";
    print "SUPERTEST_GUIX_TRIBES_INTRO_COMMIT=$INTRO_COMMIT\n";
    print "SUPERTEST_GUIX_TRIBES_INTRO_FINGERPRINT=$DEV_FINGERPRINT\n";
    print "SUPERTEST_GUIX_TRIBES_SIGNER_FINGERPRINT=$DEV_FINGERPRINT\n";
    print "SUPERTEST_GUIX_TRIBES_SIGNER_LABEL=$SIGNER_LABEL\n";
}

sub env_hash_for {
    my ($ctx, $scenario, $guix_commit) = @_;
    my %env = (
        %ENV,
        SUPERTEST_DEV_CHANNEL_MODE => '1',
        SUPERTEST_GUIX_TRIBES_CHANNEL_URL => $CHANNEL_URL,
        SUPERTEST_GUIX_TRIBES_CHANNEL_BRANCH => $DEV_BRANCH,
        SUPERTEST_GUIX_TRIBES_CHANNEL_COMMIT => $guix_commit,
        SUPERTEST_GUIX_TRIBES_INTRO_COMMIT => $INTRO_COMMIT,
        SUPERTEST_GUIX_TRIBES_INTRO_FINGERPRINT => $DEV_FINGERPRINT,
        SUPERTEST_GUIX_TRIBES_SIGNER_FINGERPRINT => $DEV_FINGERPRINT,
        SUPERTEST_GUIX_TRIBES_SIGNER_LABEL => $SIGNER_LABEL,
        SUPERTEST_CERT_MODE => $ctx->{cert_mode},
        SUPERTEST_LEGION_REPO => $ctx->{legion_repo},
    );
    $env{SUPERTEST_KEEP_NODES} = '1' if $ctx->{keep_nodes};
    $env{SUPERTEST_PLUGIN_NAME} = $ctx->{plugin} if defined $ctx->{plugin};
    $env{SUPERTEST_RUN_ID} = $ctx->{run_id} if defined $ctx->{run_id};
    return %env;
}

sub run_scenario {
    my ($ctx, $scenario, $guix_commit) = @_;
    defined $scenario && length $scenario or fail('Missing scenario name.');

    my $run_id = $ctx->{run_id} // build_run_id();
    $ctx->{run_id} = $run_id;
    my $artifact_root = File::Spec->catdir($ctx->{root}, '.state', 'supertest', "$run_id-$scenario");
    my $scenario_root = File::Spec->catdir($artifact_root, $scenario);
    my $state_dir = File::Spec->catdir($scenario_root, 'legion-state');
    my $cache_dir = File::Spec->catdir($scenario_root, 'legion-cache');

    my %env = env_hash_for($ctx, $scenario, $guix_commit);
    local %ENV = %env;

    my $latest = {
        scenario => $scenario,
        runId => $run_id,
        artifactRootDir => $artifact_root,
        scenarioRootDir => $scenario_root,
        legionStateDir => $state_dir,
        legionCacheDir => $cache_dir,
        legionRepo => $ctx->{legion_repo},
        certMode => $ctx->{cert_mode},
        devBranch => $DEV_BRANCH,
        guixCommit => $guix_commit,
        createdAt => iso_now(),
        (defined $ctx->{plugin} ? (plugin => $ctx->{plugin}) : ()),
    };
    if ($ctx->{dry_run}) {
        print "Would write latest run metadata:\n", encode_json($latest), "\n";
    } else {
        write_latest($ctx, $latest);
    }

    run_checked($ctx, 'devenv', 'shell', '--', 'npm', 'run', 'scenario', '--', $scenario);
}

sub build_run_id {
    my $now = time();
    my $millis = int(($now - int($now)) * 1000);
    return strftime('%Y-%m-%dt%H%M%S', gmtime($now)) . sprintf('%03dz', $millis);
}

sub iso_now {
    return strftime('%Y-%m-%dT%H:%M:%SZ', gmtime());
}

sub write_latest {
    my ($ctx, $data) = @_;
    my $dir = File::Spec->catdir($ctx->{root}, '.state', 'dev-branch');
    make_path($dir);
    write_file(File::Spec->catfile($dir, 'latest.json'), encode_json($data) . "\n");
}

sub read_latest {
    my ($ctx) = @_;
    my $path = File::Spec->catfile($ctx->{root}, '.state', 'dev-branch', 'latest.json');
    -f $path or fail("No latest dev-branch run metadata found at $path.");
    return decode_json(read_file($path));
}

sub run_legion_from_latest {
    my ($ctx, @args) = @_;
    my $latest = read_latest($ctx);
    my %env = (
        %ENV,
        LEGION_STATE_DIR => $latest->{legionStateDir},
        LEGION_CACHE_DIR => $latest->{legionCacheDir},
        LEGION_APP_ROOT => $latest->{legionRepo},
        LEGION_TEST_CERT_MODE => $latest->{certMode} // 'self-signed',
    );
    defined $ENV{LEGION_UNLOCK_PASSWORD}
      or fail('LEGION_UNLOCK_PASSWORD is required for Legion ssh/rpc helpers.');
    local %ENV = %env;
    run_checked(
        $ctx,
        'devenv',
        'shell',
        '--',
        'node',
        '--import', 'tsx',
        File::Spec->catfile($latest->{legionRepo}, 'src', 'engine', 'cli-main.ts'),
        @args,
    );
}

sub command_env {
    my ($ctx) = @_;
    require_repo($ctx->{guix_repo}, 'guix-tribes');
    run_checked($ctx, 'git', '-C', $ctx->{guix_repo}, 'fetch', 'origin');
    my $ref = branch_contains($ctx->{guix_repo}, $INTRO_COMMIT, "origin/$DEV_BRANCH")
      ? "origin/$DEV_BRANCH"
      : $DEV_BRANCH;
    my $commit = current_commit($ctx->{guix_repo}, $ref);
    print_dev_env($commit);
}

sub command_ssh {
    my ($ctx, $args) = @_;
    my $node = shift @$args;
    defined $node or fail('ssh requires a node reference.');
    shift @$args if @$args && $args->[0] eq '--';
    run_legion_from_latest($ctx, 'node', 'ssh', $node, @$args ? ('--', @$args) : ());
}

sub command_rpc {
    my ($ctx, $args) = @_;
    my $node = shift @$args;
    defined $node or fail('rpc requires a node reference.');
    shift @$args if @$args && $args->[0] eq '--';
    @$args or fail('rpc requires an Elixir expression.');
    run_legion_from_latest($ctx, 'node', 'rpc', $node, '--', join(' ', @$args));
}

sub main {
    my ($command, $ctx, $args) = parse_args(@ARGV);
    chdir $ctx->{root} or fail("Failed to chdir to $ctx->{root}: $!");

    if ($command eq 'help') {
        usage();
        return 0;
    }
    if ($command eq 'reset') {
        reset_branch($ctx);
        return 0;
    }
    if ($command eq 'prepare') {
        prepare($ctx);
        return 0;
    }
    if ($command eq 'env') {
        command_env($ctx);
        return 0;
    }
    if ($command eq 'ssh') {
        command_ssh($ctx, $args);
        return 0;
    }
    if ($command eq 'rpc') {
        command_rpc($ctx, $args);
        return 0;
    }
    if ($command eq 'run') {
        my $scenario = shift @$args;
        @$args == 0 or fail("Unexpected extra arguments: @$args");
        my $commit = prepare($ctx);
        run_scenario($ctx, $scenario, $commit);
        return 0;
    }

    fail("Unknown command: $command");
}

exit main();