logger setup, wait for node start before sending requests

diff --git a/lib/Tak/ConnectorService.pm b/lib/Tak/ConnectorService.pm
index 2fb1eaf..a3a3caa 100644 (file)
--- a/lib/Tak/ConnectorService.pm
+++ b/lib/Tak/ConnectorService.pm
@@ -15,9 +15,13 @@ has connections => (is => 'ro', default => sub { Tak::Router->new });
 has ssh => (is => 'ro', default => sub { {} });
 
 sub handle_create {
-  my ($self, $on) = @_;
-  my ($kid_in, $kid_out, $kid_pid) = $self->_open($on);
+  my ($self, $on, %args) = @_;
+  my $log_level = $args{log_level}||'info';
+  my ($kid_in, $kid_out, $kid_pid) = $self->_open($on, $log_level);
   $kid_in->print(io('maint/mk-fat |')->all, "__END__\n");
+  my $up = <$kid_out>;
+  die [ failure => "Garbled response from child: $up" ]
+    unless $up eq "UP\n";
   my $connection = Tak::ConnectionService->new(
     read_fh => $kid_out, write_fh => $kid_in,
     listening_service => Tak::Router->new
@@ -35,16 +39,16 @@ sub handle_create {
 }
 
 sub _open {
-  my ($self, $on) = @_;
+  my ($self, $on, @args) = @_;
   unless ($on) {
-    my $kid_pid = IPC::Open2::open2(my $kid_out, my $kid_in, $^X, '-')
+    my $kid_pid = IPC::Open2::open2(my $kid_out, my $kid_in, $^X, '-', '-', @args)
       or die "Couldn't open2 child: $!";
     return ($kid_in, $kid_out, $kid_pid);
   }
   my $ssh = $self->ssh->{$on} ||= Net::OpenSSH->new($on);
   $ssh->error and
     die "Couldn't establish ssh connection: ".$ssh->error;
-  return $ssh->open2('perl','-');
+  return $ssh->open2('perl','-', $on, @args);
 }
 
 sub start_connection_request {

diff --git a/lib/Tak/JSONChannel.pm b/lib/Tak/JSONChannel.pm
index 86a63e9..af1aee1 100644 (file)
--- a/lib/Tak/JSONChannel.pm
+++ b/lib/Tak/JSONChannel.pm
@@ -3,6 +3,7 @@ package Tak::JSONChannel;
 use JSON::PP qw(encode_json decode_json);
 use IO::Handle;
 use Scalar::Util qw(weaken);
+use Log::Contextual qw(:log);
 use Moo;
 
 has read_fh => (is => 'ro', required => 1);
@@ -13,6 +14,7 @@ sub BUILD { shift->write_fh->autoflush(1); }
 sub read_message {
   my ($self) = @_;
   if (defined(my $line = readline($self->read_fh))) {
+    log_trace { "Received $line" };
     if (my $unpacked = $self->_unpack_line($line)) {
       return $unpacked;
     }
@@ -50,6 +52,7 @@ sub write_message {
     );
     return;
   }
+  log_trace { "Sending: $json" };
   $self->_raw_write_message($json);
 }
 

diff --git a/lib/Tak/STDIOSetup.pm b/lib/Tak/STDIOSetup.pm
index 53185d8..c06efbc 100644 (file)
--- a/lib/Tak/STDIOSetup.pm
+++ b/lib/Tak/STDIOSetup.pm
@@ -1,20 +1,30 @@
 package Tak::STDIOSetup;
 
-BEGIN { require MRO::Compat; }
-
+use Log::Contextual qw(:log);
+use Log::Contextual::SimpleLogger;
 use Tak::ConnectionService;
 use Tak::Router;
 use Tak;
 use strictures 1;
 
 sub run {
-  open my $stdin, '<&', \*STDIN;
-  open my $stdout, '>&', \*STDOUT;
+  open my $stdin, '<&', \*STDIN or die "Duping stdin: $!";
+  open my $stdout, '>&', \*STDOUT or die "Duping stdout: $!";
   # if we don't re-open them then 0 and 1 get re-used - which is not
   # only potentially bloody confusing but results in warnings like:
   # "Filehandle STDOUT reopened as STDIN only for input"
-  close STDIN; open STDIN, '<', '/dev/null';
-  close STDOUT; open STDOUT, '>', '/dev/null';
+  close STDIN or die "Closing stdin: $!";
+  open STDIN, '<', '/dev/null' or die "Re-opening stdin: $!";
+  close STDOUT or die "Closing stdout: $!";
+  open STDOUT, '>', '/dev/null' or die "Re-opening stdout: $!";
+  my ($host, $level) = @ARGV;
+  my $sig = '<'.join ':', $host, $$.'> ';
+  Log::Contextual::set_logger(
+    Log::Contextual::SimpleLogger->new({
+      levels_upto => $level,
+      coderef => sub { print STDERR $sig, @_; }
+    })
+  );
   my $done;
   my $connection = Tak::ConnectionService->new(
     read_fh => $stdin, write_fh => $stdout,
@@ -25,6 +35,8 @@ sub run {
   if ($0 eq '-') {
     $0 = 'tak-stdio-node';
   }
+  log_debug { "Node starting" };
+  print $stdout "UP\n";
   Tak->loop_until($done);
 }
 

diff --git a/lib/Tak/Script.pm b/lib/Tak/Script.pm
index 52ec0f1..b932fea 100644 (file)
--- a/lib/Tak/Script.pm
+++ b/lib/Tak/Script.pm
@@ -6,11 +6,15 @@ use IO::Handle;
 use Tak::Client::Router;
 use Tak::Client::RemoteRouter;
 use Tak::Router;
+use Log::Contextual qw(:log);
+use Log::Contextual::SimpleLogger;
 use Moo;
 
 has options => (is => 'ro', required => 1);
 has env => (is => 'ro', required => 1);
 
+has log_level => (is => 'rw');
+
 has stdin => (is => 'lazy');
 has stdout => (is => 'lazy');
 has stderr => (is => 'lazy');
@@ -42,7 +46,20 @@ sub BUILD {
   shift->setup_logger;
 }
 
-sub setup_logger { }
+sub setup_logger {
+  my ($self) = @_;
+  my @level_names = qw(fatal error warn info debug trace);
+  my $options = $self->options;
+  my $level = 2 + ($options->{verbose}||0) - ($options->{quiet}||0);
+  my $upto = $level_names[$level];
+  $self->log_level($upto);
+  Log::Contextual::set_logger(
+    Log::Contextual::SimpleLogger->new({
+      levels_upto => $upto,
+      coderef => sub { print STDERR '<local> ', @_ },
+    })
+  );
+}
 
 sub _parse_options {
   my ($self, $string, $argv) = @_;
@@ -118,7 +135,10 @@ sub _host_list_for {
 
 sub _connection_to {
   my ($self, $target) = @_;
-  my @path = $self->local_client->do(connector => create => $target);
+  log_debug { "Connecting to ${target}" };
+  my @path = $self->local_client->do(
+    connector => create => $target, log_level => $self->log_level
+  );
   my ($local, $remote) =
     map $self->local_client->curry(connector => connection => @path => $_),
       qw(local remote);
@@ -128,6 +148,7 @@ sub _connection_to {
     expose => { module_sender => [ 'remote', 'module_sender' ] }
   );
   $remote->do(module_loader => 'enable');
+  log_debug { "Setup connection to ${target}" };
   Tak::Client::RemoteRouter->new(
     %$remote, host => $target
   );

diff --git a/maint/mk-fat b/maint/mk-fat
index ee9701d..4b6799e 100755 (executable)
--- a/maint/mk-fat
+++ b/maint/mk-fat
@@ -1,7 +1,7 @@
 #!/bin/sh
 
 #if [ -e fatlib ]; then rm -r fatlib; fi
-#fatpack tree $(fatpack packlists-for strictures.pm Moo.pm JSON/PP.pm MRO/Compat.pm Class/C3.pm Algorithm/C3.pm)
+#fatpack tree $(fatpack packlists-for strictures.pm Moo.pm JSON/PP.pm MRO/Compat.pm Class/C3.pm Algorithm/C3.pm Log/Contextual.pm Data/Dumper/Concise.pm)
 fatpack file
 #rm -r fatlib
 echo "use lib 'lib'; use Tak::STDIOSetup; Tak::STDIOSetup->run;"