use v5.36;
package Remote::Perl::Client;

# Remote bootstrap client.  Sent verbatim by Bootstrap.pm and eval'd on the
# remote side.  Only uses Perl core modules.
#
# Architecture: one persistent relay process, plus one executor per RUN.
#   Client (relay)  -- owns the protocol pipe; runs the select loop permanently.
#   Executor        -- runs the user script with real STDIN/STDOUT/STDERR pipes.
#
# This split means the protocol loop is never blocked by script I/O, enabling
# real-time stdout/stderr streaming and correct signal forwarding.

use Socket qw(AF_UNIX SOCK_STREAM);
use POSIX  qw(WNOHANG);

# -- Save real pipe handles before any redirection -----------------------------
open(my $PIN,  '<&', \*STDIN)  or die "dup STDIN: $!\n";
open(my $POUT, '>&', \*STDOUT) or die "dup STDOUT: $!\n";
binmode($PIN); binmode($POUT);
$POUT->autoflush(1);
$SIG{PIPE} = 'IGNORE';

syswrite($POUT, "REMOTEPERL1\n");

# -- Constants -----------------------------------------------------------------
use constant {
    HDR             => 6,
    PROTO_VER       => 1,
    MSG_HELLO       => 0x00,   MSG_READY       => 0x01,
    MSG_RUN         => 0x10,
    MSG_DATA        => 0x20,   MSG_EOF         => 0x21,
    MSG_CREDIT      => 0x30,
    MSG_MOD_REQ     => 0x40,   MSG_MOD_MISSING => 0x41,
    MSG_RETURN      => 0x50,
    MSG_SIGNAL      => 0x60,   MSG_SIGNAL_ACK  => 0x61,
    MSG_ERROR       => 0xE0,   MSG_BYE         => 0xF0,
    S_CTRL          => 0,      S_STDIN         => 1,
    S_STDOUT        => 2,      S_STDERR        => 3,
};

# -- State ---------------------------------------------------------------------
my $pbuf        = '';
my %sc          = ();   # send credits: stream_id => bytes remaining
my $window      = 65536;
my $done        = 0;
my $next_stream = 4;

# -- Wire I/O ------------------------------------------------------------------

# Write bytes to the protocol pipe.
sub _write($bytes) {
    my ($total, $off) = (length($bytes), 0);
    while ($off < $total) {
        my $n = syswrite($POUT, $bytes, $total - $off, $off);
        die "syswrite: $!\n" unless defined $n;
        $off += $n;
    }
}

sub _send($type, $stream, $body = '') {
    _write(pack('CCN', $type, $stream, length($body)) . $body);
}

# Write all bytes to an arbitrary filehandle (pipes, sockets).
sub _write_fh($fh, $bytes) {
    my ($total, $off) = (length($bytes), 0);
    while ($off < $total) {
        my $n = syswrite($fh, $bytes, $total - $off, $off);
        die "syswrite fh: $!\n" unless defined $n;
        $off += $n;
    }
}

# Blocking read of exactly $n bytes from $fh.  Returns undef on EOF.
sub _read_fixed($fh, $n) {
    my $buf = '';
    while (length($buf) < $n) {
        my $got = sysread($fh, my $chunk, $n - length($buf));
        die "sysread fh: $!\n" unless defined $got;
        return undef unless $got;
        $buf .= $chunk;
    }
    return $buf;
}

# -- Protocol parsing ----------------------------------------------------------

sub _pump($block = 1) {
    my $rin = '';
    vec($rin, fileno($PIN), 1) = 1;
    return unless select(my $r = $rin, undef, undef, $block ? undef : 0) > 0;
    my $n = sysread($PIN, my $data, 65536);
    die "sysread: $!\n" unless defined $n;
    unless ($n) { $done = 1; return }
    $pbuf .= $data;
    _drain_dispatch();
}

sub _drain_dispatch() {
    while (length($pbuf) >= HDR) {
        my ($type, $stream, $len) = unpack('CCN', $pbuf);
        last if length($pbuf) < HDR + $len;
        substr($pbuf, 0, HDR, '');
        my $body = $len ? substr($pbuf, 0, $len, '') : '';
        _dispatch($type, $stream, $body);
    }
}

# -- Pre-fork dispatcher (handshake + waiting for RUN) -------------------------
my ($run_source, @run_args);

sub _decode_run($body) {
    my $off  = 0;
    my $argc = unpack('N', substr($body, $off, 4)); $off += 4;
    my @argv;
    for (1 .. $argc) {
        my $len = unpack('N', substr($body, $off, 4)); $off += 4;
        push @argv, substr($body, $off, $len); $off += $len;
    }
    return (substr($body, $off), @argv);
}

sub _dispatch($type, $stream, $body) {
    if    ($type == MSG_CREDIT) { $sc{$stream} = ($sc{$stream}//0) + unpack('N', $body) }
    elsif ($type == MSG_RUN)    { ($run_source, @run_args) = _decode_run($body) }
    elsif ($type == MSG_BYE)    { $done = 1 }
    elsif ($type == MSG_ERROR)  { warn "remperl error: $body\n"; $done = 1 }
}

sub _read_raw_message() {
    while (length($pbuf) < HDR) {
        my $n = sysread($PIN, my $data, 65536);
        die "sysread: $!\n" unless defined $n;
        die "EOF waiting for message\n" unless $n;
        $pbuf .= $data;
    }
    my ($type, $stream, $len) = unpack('CCN', $pbuf);
    while (length($pbuf) < HDR + $len) {
        my $n = sysread($PIN, my $data, 65536);
        die "sysread: $!\n" unless defined $n;
        die "EOF waiting for message body\n" unless $n;
        $pbuf .= $data;
    }
    substr($pbuf, 0, HDR, '');
    my $body = $len ? substr($pbuf, 0, $len, '') : '';
    return ($type, $stream, $body);
}

# -- Handshake -----------------------------------------------------------------
{
    my ($type, undef, $body) = _read_raw_message();
    die sprintf("Expected HELLO(0x00), got 0x%02x\n", $type) unless $type == MSG_HELLO;
    die sprintf("Malformed HELLO: expected 5 bytes, got %d\n", length($body))
        unless length($body) >= 5;
    my ($ver, $win) = unpack('CN', $body);
    die "Protocol version mismatch: got $ver, expected " . PROTO_VER . "\n"
        unless $ver == PROTO_VER;
    $window = $win;
    $sc{$_} = $window for S_CTRL, S_STDOUT, S_STDERR;
    _send(MSG_READY, S_CTRL);
}

# -- Main loop: handle successive RUN commands on the same connection ----------
until ($done) {
    $run_source = undef;
    @run_args   = ();
    _pump(1) until defined $run_source || $done;
    last if $done;
    _do_run($run_source, @run_args);
}
_send(MSG_BYE, S_CTRL);

# -- Per-run entry point -------------------------------------------------------
sub _do_run($source, @args) {
    pipe(my $stdin_r,  my $stdin_w)  or die "pipe stdin: $!\n";
    pipe(my $stdout_r, my $stdout_w) or die "pipe stdout: $!\n";
    pipe(my $stderr_r, my $stderr_w) or die "pipe stderr: $!\n";
    pipe(my $result_r, my $result_w) or die "pipe result: $!\n";
    socketpair(my $mod_c, my $mod_e, AF_UNIX, SOCK_STREAM, 0)
        or die "socketpair: $!\n";
    binmode($_) for $stdin_r,  $stdin_w,
                    $stdout_r, $stdout_w,
                    $stderr_r, $stderr_w,
                    $result_r, $result_w,
                    $mod_c,    $mod_e;

    my $exec_pid = fork() // die "fork: $!\n";

    if ($exec_pid == 0) {
        # === EXECUTOR (child) =================================================
        close($_) for $stdin_w, $stdout_r, $stderr_r, $result_r, $mod_c;

        open(STDIN,  '<&', $stdin_r)  or die "dup stdin: $!\n";
        open(STDOUT, '>&', $stdout_w) or die "dup stdout: $!\n";
        open(STDERR, '>&', $stderr_w) or die "dup stderr: $!\n";
        STDOUT->autoflush(1);
        STDERR->autoflush(1);
        close($_) for $stdin_r, $stdout_w, $stderr_w;

        # Install the @INC hook if module serving is enabled.
        our $REMOTE_PERL_SERVE //= 0;

        if ($REMOTE_PERL_SERVE) {
            my $inc_hook = sub {
                my (undef, $filename) = @_;
                _write_fh($mod_e, pack('N', length($filename)) . $filename);
                my $status = _read_fixed($mod_e, 1) // return undef;
                return undef if unpack('C', $status);   # MOD_MISSING
                my $src_len = unpack('N', _read_fixed($mod_e, 4) // return undef);
                my $src     = _read_fixed($mod_e, $src_len)       // return undef;
                open(my $fh, '<', \$src) or die "scalar open: $!\n";
                return $fh;
            };
            push @INC, $inc_hook;
        }

        $SIG{PIPE} = 'DEFAULT';
        @ARGV = @args;
        eval $source;
        my $eval_err = $@;

        # Write die message (if any) and close the result pipe before output
        # streams, so the relay can read it by the time stdout/stderr reach EOF.
        if ($eval_err) {
            _write_fh($result_w, pack('N', length($eval_err)) . $eval_err);
        }
        close($result_w);
        close($mod_e);
        close(STDOUT);
        close(STDERR);
        exit($eval_err ? 1 : 0);
    }

    # === CLIENT / RELAY (parent) ==============================================
    close($_) for $stdin_r, $stdout_w, $stderr_w, $result_w, $mod_e;

    # Grant stdin credits so the local side may send data.
    _send(MSG_CREDIT, S_STDIN, pack('N', $window));

    my $die_msg = _relay($exec_pid, $stdin_w, $stdout_r, $stderr_r, $result_r, $mod_c);

    waitpid($exec_pid, 0);
    my $exit_code = ($? & 0x7F) ? 1 : (($? >> 8) & 0xFF);
    _send(MSG_RETURN, S_CTRL, pack('C', $exit_code) . $die_msg);
}

# -- Relay loop ----------------------------------------------------------------

# Send as much of $$bufref as credits allow on $stream.
sub _flush_buf($stream, $bufref) {
    while (($sc{$stream}//0) > 0 && length($$bufref)) {
        my $take = ($sc{$stream} < length($$bufref)) ? $sc{$stream} : length($$bufref);
        _send(MSG_DATA, $stream, substr($$bufref, 0, $take, ''));
        $sc{$stream} -= $take;
    }
}

sub _relay($exec_pid, $stdin_w, $stdout_r, $stderr_r, $result_r, $mod_c) {
    my ($stdout_eof, $stderr_eof, $stdin_w_closed, $mod_c_eof) = (0, 0, 0, 0);
    my ($stdout_buf, $stderr_buf) = ('', '');

    # At most one module request in flight at a time: executor blocks until answered.
    my ($mod_stream, %mod_src, %mod_fin, %mod_miss);

    RELAY: until ($stdout_eof && $stderr_eof) {
        my $rin = '';
        vec($rin, fileno($PIN),      1) = 1;
        vec($rin, fileno($stdout_r), 1) = 1 unless $stdout_eof;
        vec($rin, fileno($stderr_r), 1) = 1 unless $stderr_eof;
        # Watch for new module requests only when none is in flight.
        vec($rin, fileno($mod_c),    1) = 1 unless $mod_c_eof || defined $mod_stream;

        select(my $r = $rin, undef, undef, undef);

        # -- Protocol pipe -----------------------------------------------------
        if (vec($r, fileno($PIN), 1)) {
            my $n = sysread($PIN, my $data, 65536);
            unless ($n) { $done = 1; last RELAY }
            $pbuf .= $data;

            while (length($pbuf) >= HDR) {
                my ($type, $stream, $len) = unpack('CCN', $pbuf);
                last if length($pbuf) < HDR + $len;
                substr($pbuf, 0, HDR, '');
                my $body = $len ? substr($pbuf, 0, $len, '') : '';

                if ($type == MSG_CREDIT) {
                    $sc{$stream} = ($sc{$stream}//0) + unpack('N', $body);
                    _flush_buf(S_STDOUT, \$stdout_buf) if $stream == S_STDOUT;
                    _flush_buf(S_STDERR, \$stderr_buf) if $stream == S_STDERR;
                }
                elsif ($type == MSG_DATA && $stream == S_STDIN && !$stdin_w_closed) {
                    eval { _write_fh($stdin_w, $body) }
                        or do { close($stdin_w); $stdin_w_closed = 1 };
                }
                elsif ($type == MSG_EOF && $stream == S_STDIN && !$stdin_w_closed) {
                    close($stdin_w);
                    $stdin_w_closed = 1;
                }
                elsif ($type == MSG_SIGNAL) {
                    _send(MSG_SIGNAL_ACK, S_CTRL, $body);
                    kill($body, $exec_pid);
                }
                elsif ($type == MSG_ERROR) {
                    warn "remperl error: $body\n";
                    kill('TERM', $exec_pid);
                    $done = 1; last RELAY;
                }
                elsif ($type == MSG_BYE) {
                    $done = 1; last RELAY;
                }
                # Module response from the local side.
                elsif (defined $mod_stream && $stream == $mod_stream) {
                    $mod_src{$mod_stream} .= $body if $type == MSG_DATA;
                    $mod_fin{$mod_stream}  = 1     if $type == MSG_EOF;
                    $mod_miss{$mod_stream} = 1     if $type == MSG_MOD_MISSING;
                }
            }

            # Forward completed module response to the executor.
            if (defined $mod_stream
                    && ($mod_fin{$mod_stream} || $mod_miss{$mod_stream})) {
                if ($mod_fin{$mod_stream}) {
                    my $src = $mod_src{$mod_stream};
                    eval { _write_fh($mod_c, pack('CN', 0, length($src)) . $src) }
                        or do { $mod_c_eof = 1 };
                } else {
                    eval { _write_fh($mod_c, pack('C', 1)) }
                        or do { $mod_c_eof = 1 };
                }
                delete $mod_src{$mod_stream};
                delete $mod_fin{$mod_stream};
                delete $mod_miss{$mod_stream};
                $mod_stream = undef;
            }
        }

        # -- Executor stdout ---------------------------------------------------
        if (!$stdout_eof && vec($r, fileno($stdout_r), 1)) {
            my $n = sysread($stdout_r, my $data, 65536);
            if ($n) {
                $stdout_buf .= $data;
                _flush_buf(S_STDOUT, \$stdout_buf);
            } else {
                _flush_buf(S_STDOUT, \$stdout_buf);
                _send(MSG_EOF, S_STDOUT);
                $stdout_eof = 1;
            }
        }

        # -- Executor stderr ---------------------------------------------------
        if (!$stderr_eof && vec($r, fileno($stderr_r), 1)) {
            my $n = sysread($stderr_r, my $data, 65536);
            if ($n) {
                $stderr_buf .= $data;
                _flush_buf(S_STDERR, \$stderr_buf);
            } else {
                _flush_buf(S_STDERR, \$stderr_buf);
                _send(MSG_EOF, S_STDERR);
                $stderr_eof = 1;
            }
        }

        # -- Module socket: new request from executor --------------------------
        if (!$mod_c_eof && !defined $mod_stream && vec($r, fileno($mod_c), 1)) {
            my $hdr = _read_fixed($mod_c, 4);
            if (!defined $hdr) {
                $mod_c_eof = 1;   # executor closed its end; stop watching
            }
            else {
                my $filename = _read_fixed($mod_c, unpack('N', $hdr)) // do { $mod_c_eof = 1; next };
                $mod_stream              = $next_stream++;
                $mod_src{$mod_stream}    = '';
                $mod_fin{$mod_stream}    = 0;
                $mod_miss{$mod_stream}   = 0;
                _send(MSG_MOD_REQ, $mod_stream, $filename);
            }
        }
    }

    # Clean up if the connection died before the run completed.
    unless ($stdout_eof && $stderr_eof) {
        kill('TERM', $exec_pid);
    }
    close($stdin_w) unless $stdin_w_closed;

    # Read die message from the result pipe.  The executor writes the message
    # (if any) and closes result_w before closing stdout/stderr, so by the time
    # we reach here the data is already in the kernel pipe buffer.
    my $die_msg = '';
    my $hdr = _read_fixed($result_r, 4);
    if (defined $hdr) {
        my $len = unpack('N', $hdr);
        $die_msg = $len ? (_read_fixed($result_r, $len) // '') : '';
    }

    return $die_msg;
}

1;
