Commit | Line | Data |
77bf1d9b |
1 | package Tak::ConnectorService; |
2 | |
3 | use IPC::Open2; |
4 | use IO::All; |
5 | use Tak::Router; |
6 | use Tak::Client; |
7 | use Tak::ConnectionService; |
2791fd73 |
8 | use Net::OpenSSH; |
3f28f492 |
9 | use Tak::STDIONode; |
77bf1d9b |
10 | use Moo; |
11 | |
12 | with 'Tak::Role::Service'; |
13 | |
14 | has connections => (is => 'ro', default => sub { Tak::Router->new }); |
15 | |
2791fd73 |
16 | has ssh => (is => 'ro', default => sub { {} }); |
17 | |
77bf1d9b |
18 | sub handle_create { |
7b71b06e |
19 | my ($self, $on, %args) = @_; |
20 | my $log_level = $args{log_level}||'info'; |
21 | my ($kid_in, $kid_out, $kid_pid) = $self->_open($on, $log_level); |
3f28f492 |
22 | $kid_in->print($Tak::STDIONode::DATA, "__END__\n"); |
9df46eb8 |
23 | # Need to get a handshake to indicate STDIOSetup has finished |
24 | # messing around with file descriptors, otherwise we can severely |
25 | # confuse things by sending before the dup. |
7b71b06e |
26 | my $up = <$kid_out>; |
27 | die [ failure => "Garbled response from child: $up" ] |
9df46eb8 |
28 | unless $up eq "Ssyshere\n"; |
77bf1d9b |
29 | my $connection = Tak::ConnectionService->new( |
30 | read_fh => $kid_out, write_fh => $kid_in, |
31 | listening_service => Tak::Router->new |
32 | ); |
33 | my $client = Tak::Client->new(service => $connection); |
34 | # actually, we should register with a monotonic id and |
35 | # stash the pid elsewhere. but meh for now. |
36 | my $pid = $client->do(meta => 'pid'); |
2791fd73 |
37 | my $name = ($on||'|').':'.$pid; |
38 | my $conn_router = Tak::Router->new; |
39 | $conn_router->register(local => $connection->receiver->service); |
40 | $conn_router->register(remote => $connection); |
41 | $self->connections->register($name, $conn_router); |
42 | return ($name); |
43 | } |
44 | |
45 | sub _open { |
7b71b06e |
46 | my ($self, $on, @args) = @_; |
2791fd73 |
47 | unless ($on) { |
7b71b06e |
48 | my $kid_pid = IPC::Open2::open2(my $kid_out, my $kid_in, $^X, '-', '-', @args) |
2791fd73 |
49 | or die "Couldn't open2 child: $!"; |
50 | return ($kid_in, $kid_out, $kid_pid); |
51 | } |
52 | my $ssh = $self->ssh->{$on} ||= Net::OpenSSH->new($on); |
53 | $ssh->error and |
54 | die "Couldn't establish ssh connection: ".$ssh->error; |
7b71b06e |
55 | return $ssh->open2('perl','-', $on, @args); |
77bf1d9b |
56 | } |
57 | |
2791fd73 |
58 | sub start_connection_request { |
77bf1d9b |
59 | my ($self, $req, @payload) = @_;; |
60 | $self->connections->start_request($req, @payload); |
61 | } |
62 | |
2791fd73 |
63 | sub receive_connection { |
77bf1d9b |
64 | my ($self, @payload) = @_; |
65 | $self->connections->receive(@payload); |
66 | } |
67 | |
68 | 1; |