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