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