File Coverage

blib/lib/Net/Async/Tangence/Client/via/sshunix.pm

Criterion	Covered	Total	%
statement	8	26	30.7
branch	0	6	0.0
condition	0	6	0.0
subroutine	3	5	60.0
pod	0	1	0.0
total	11	44	25.0

#  You may distribute under the terms of either the GNU General Public License
#  or the Artistic License (the same terms as Perl itself)
#
#  (C) Paul Evans, 2010-2021 -- [e-mail]

package Net::Async::Tangence::Client::via::sshunix 0.16;

use v5.14;
use warnings;

# A tiny program we can run remotely to connect STDIN/STDOUT to a UNIX socket
# given as $ARGV[0]
use constant _NC_MICRO => <<'EOPERL';
use Socket qw( AF_UNIX SOCK_STREAM pack_sockaddr_un );
use IO::Handle;
socket(my $socket, AF_UNIX, SOCK_STREAM, 0) or die "socket(AF_UNIX): $!\n";
connect($socket, pack_sockaddr_un($ARGV[0])) or die "connect $ARGV[0]: $!\n";
my $fd = fileno($socket);
$socket->blocking(0); $socket->autoflush(1);
STDIN->blocking(0); STDOUT->autoflush(1);
my $rin = "";
vec($rin, 0, 1) = 1;
vec($rin, $fd, 1) = 1;
print "READY";
while(1) {
   select(my $rout = $rin, undef, undef, undef);
   if(vec($rout, 0, 1)) {
      sysread STDIN, my $buffer, 8192 or last;
      print $socket $buffer;
   }
   if(vec($rout, $fd, 1)) {
      sysread $socket, my $buffer, 8192 or last;
      print $buffer;
   }
}
EOPERL

sub connect
{
   my $client = shift;
   my ( $uri, %args ) = @_;

   my $host = $uri->authority;
   my $path = $uri->path;
   # Path will start with a leading /; we need to trim that
   $path =~ s{^/}{};

   my @sshargs;
   push @sshargs, "-4" if $args{family} and $args{family} eq "inet4";
   push @sshargs, "-6" if $args{family} and $args{family} eq "inet6";

   return $client->connect_exec(
      # Tell the remote perl we're going to send it a program on STDIN
      [ 'ssh', @sshargs, $host, 'perl', '-', $path ]
   )->then( sub {
      $client->write( _NC_MICRO . "\n__END__\n" );
      my $f = $client->new_future;

      $client->configure( on_read => sub {
         my ( $self, $buffref, $eof ) = @_;
         return 0 unless $$buffref =~ s/READY//;
         $self->configure( on_read => undef );
         $f->done;
         return 0;
      } );

      return $f;
   });
}

0x55AA;