view release on metacpan or  search on metacpan

lib/Remote/Perl/Client.pm  view on Meta::CPAN

use strict;
use warnings;
# NOTE: this file runs on the remote side and must stay compatible with Perl 5.10+.
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 Fcntl  qw(F_SETFD FD_CLOEXEC O_RDWR);
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);
{ my $old = select $POUT; $| = 1; select $old }
$SIG{PIPE} = 'IGNORE';

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

# -- Constants -----------------------------------------------------------------
use constant {
    HDR             => 6,
    PROTO_VER       => 2,
    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 {
    my ($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 {
    my ($type, $stream, $body) = @_;
    $body //= '';
    _write(pack('CCN', $type, $stream, length($body)) . $body);
}

# Write all bytes to an arbitrary filehandle (pipes, sockets).
sub _write_fh {
    my ($fh, $bytes) = @_;