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; |
77bf1d9b |
9 | use Moo; |
10 | |
11 | with 'Tak::Role::Service'; |
12 | |
13 | has connections => (is => 'ro', default => sub { Tak::Router->new }); |
14 | |
2791fd73 |
15 | has ssh => (is => 'ro', default => sub { {} }); |
16 | |
77bf1d9b |
17 | sub handle_create { |
7b71b06e |
18 | my ($self, $on, %args) = @_; |
19 | my $log_level = $args{log_level}||'info'; |
20 | my ($kid_in, $kid_out, $kid_pid) = $self->_open($on, $log_level); |
986f5290 |
21 | $kid_in->print(io('maint/mk-fat |')->all, "__END__\n"); |
7b71b06e |
22 | my $up = <$kid_out>; |
23 | die [ failure => "Garbled response from child: $up" ] |
24 | unless $up eq "UP\n"; |
77bf1d9b |
25 | my $connection = Tak::ConnectionService->new( |
26 | read_fh => $kid_out, write_fh => $kid_in, |
27 | listening_service => Tak::Router->new |
28 | ); |
29 | my $client = Tak::Client->new(service => $connection); |
30 | # actually, we should register with a monotonic id and |
31 | # stash the pid elsewhere. but meh for now. |
32 | my $pid = $client->do(meta => 'pid'); |
2791fd73 |
33 | my $name = ($on||'|').':'.$pid; |
34 | my $conn_router = Tak::Router->new; |
35 | $conn_router->register(local => $connection->receiver->service); |
36 | $conn_router->register(remote => $connection); |
37 | $self->connections->register($name, $conn_router); |
38 | return ($name); |
39 | } |
40 | |
41 | sub _open { |
7b71b06e |
42 | my ($self, $on, @args) = @_; |
2791fd73 |
43 | unless ($on) { |
7b71b06e |
44 | my $kid_pid = IPC::Open2::open2(my $kid_out, my $kid_in, $^X, '-', '-', @args) |
2791fd73 |
45 | or die "Couldn't open2 child: $!"; |
46 | return ($kid_in, $kid_out, $kid_pid); |
47 | } |
48 | my $ssh = $self->ssh->{$on} ||= Net::OpenSSH->new($on); |
49 | $ssh->error and |
50 | die "Couldn't establish ssh connection: ".$ssh->error; |
7b71b06e |
51 | return $ssh->open2('perl','-', $on, @args); |
77bf1d9b |
52 | } |
53 | |
2791fd73 |
54 | sub start_connection_request { |
77bf1d9b |
55 | my ($self, $req, @payload) = @_;; |
56 | $self->connections->start_request($req, @payload); |
57 | } |
58 | |
2791fd73 |
59 | sub receive_connection { |
77bf1d9b |
60 | my ($self, @payload) = @_; |
61 | $self->connections->receive(@payload); |
62 | } |
63 | |
64 | 1; |