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) = @_; |
8facab5f |
20 | die [ mistake => "No target supplied to create" ] unless $on; |
7b71b06e |
21 | my $log_level = $args{log_level}||'info'; |
22 | my ($kid_in, $kid_out, $kid_pid) = $self->_open($on, $log_level); |
8facab5f |
23 | $kid_in->print($Tak::STDIONode::DATA, "__END__\n") unless $on eq '-'; |
9df46eb8 |
24 | # Need to get a handshake to indicate STDIOSetup has finished |
25 | # messing around with file descriptors, otherwise we can severely |
26 | # confuse things by sending before the dup. |
7b71b06e |
27 | my $up = <$kid_out>; |
28 | die [ failure => "Garbled response from child: $up" ] |
9df46eb8 |
29 | unless $up eq "Ssyshere\n"; |
77bf1d9b |
30 | my $connection = Tak::ConnectionService->new( |
31 | read_fh => $kid_out, write_fh => $kid_in, |
32 | listening_service => Tak::Router->new |
33 | ); |
34 | my $client = Tak::Client->new(service => $connection); |
35 | # actually, we should register with a monotonic id and |
36 | # stash the pid elsewhere. but meh for now. |
37 | my $pid = $client->do(meta => 'pid'); |
8facab5f |
38 | my $name = $on.':'.$pid; |
2791fd73 |
39 | my $conn_router = Tak::Router->new; |
40 | $conn_router->register(local => $connection->receiver->service); |
41 | $conn_router->register(remote => $connection); |
42 | $self->connections->register($name, $conn_router); |
43 | return ($name); |
44 | } |
45 | |
46 | sub _open { |
7b71b06e |
47 | my ($self, $on, @args) = @_; |
8facab5f |
48 | if ($on eq '-') { |
49 | my $kid_pid = IPC::Open2::open2(my $kid_out, my $kid_in, 'tak-stdio-node', '-', @args) |
2791fd73 |
50 | or die "Couldn't open2 child: $!"; |
51 | return ($kid_in, $kid_out, $kid_pid); |
52 | } |
53 | my $ssh = $self->ssh->{$on} ||= Net::OpenSSH->new($on); |
54 | $ssh->error and |
55 | die "Couldn't establish ssh connection: ".$ssh->error; |
7b71b06e |
56 | return $ssh->open2('perl','-', $on, @args); |
77bf1d9b |
57 | } |
58 | |
2791fd73 |
59 | sub start_connection_request { |
77bf1d9b |
60 | my ($self, $req, @payload) = @_;; |
61 | $self->connections->start_request($req, @payload); |
62 | } |
63 | |
2791fd73 |
64 | sub receive_connection { |
77bf1d9b |
65 | my ($self, @payload) = @_; |
66 | $self->connections->receive(@payload); |
67 | } |
68 | |
69 | 1; |