From: Matt S Trout <mst@shadowcat.co.uk>
Date: Tue, 20 Dec 2011 11:58:27 +0000 (+0000)
Subject: TCP support for ListenerService
X-Git-Tag: v0.001001~5
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=90be5988a9447d992d875a2a535702625f109dd1;p=scpubgit%2FTak-Daemon.git

TCP support for ListenerService
---

diff --git a/lib/Tak/Daemon/ListenerService.pm b/lib/Tak/Daemon/ListenerService.pm
index 1751ab5..3d0af0a 100644
--- a/lib/Tak/Daemon/ListenerService.pm
+++ b/lib/Tak/Daemon/ListenerService.pm
@@ -5,7 +5,7 @@ use Moo;
 
 with 'Tak::Role::Service';
 
-has socket_location => (is => 'ro', required => 1);
+has listen_on => (is => 'ro', required => 1);
 has router => (is => 'ro', required => 1);
 
 has state => (is => 'rw', default => sub { 'down' }, init_arg => undef);
@@ -27,15 +27,20 @@ sub _build__start_in_progress {
   my ($self) = @_;
   weaken($self);
   my %start = (requests => (my $requests = []));
+  my $listen_on = $self->listen_on;
+  my %addr = (
+    socktype => "stream",
+    map +(
+      ref($_)
+        ? (family => "inet", %$_)
+        : (family => "unix", path => $_)
+    ), $listen_on
+  );
   $start{start} = sub {
     $self->state('starting');
     Tak->loop_upgrade;
     Tak->loop->listen(
-      addr => {
-        family => "unix",
-        socktype => "stream",
-        path => $self->socket_location,
-      },
+      addr => \%addr,
       on_notifier => sub {
         $self->listener($_[0]);
         $_->success('started') for @$requests;
@@ -70,7 +75,7 @@ sub handle_stop {
   # there's probably something more intelligent to do here, but meh
   die failure => 'starting' if $self->state eq 'starting';
   Tak->loop->remove($self->clear_listener);
-  unlink($self->socket_location);
+  !ref and unlink($_) for $self->listen_on;
   $self->state('down');
   return 'stopped';
 }
@@ -80,7 +85,7 @@ sub DEMOLISH {
 
   return unless $self->state eq 'running';
 
-  unlink($self->socket_location);
+  !ref and unlink($_) for $self->listen_on;
 
   return if $in_global_destruction;
 
diff --git a/t/lib/PortFinder.pm b/t/lib/PortFinder.pm
new file mode 100644
index 0000000..eca5004
--- /dev/null
+++ b/t/lib/PortFinder.pm
@@ -0,0 +1,52 @@
+# intentionally not changing package to jam the routine herein straight
+# into the use-ing package. Yes, this is totally a hack.
+#
+# Code is almost verbatim (bar _check_port -> $_check_port because I'm
+# polluting people's namespaces already) from Test::TCP 1.07 by
+# Tokuhiro Matsuno E<lt>tokuhirom@gmail.comE<gt> which is perl licensed.
+
+use IO::Socket::INET;
+use strictures 1;
+
+my $_check_port = sub {
+    my ($port) = @_;
+
+    my $remote = IO::Socket::INET->new(
+        Proto    => 'tcp',
+        PeerAddr => '127.0.0.1',
+        PeerPort => $port,
+    );
+    if ($remote) {
+        close $remote;
+        return 1;
+    }
+    else {
+        return 0;
+    }
+};
+
+sub empty_port {
+    my $port = do {
+        if (@_) {
+            my $p = $_[0];
+            $p = 19000 unless $p =~ /^[0-9]+$/ && $p < 19000;
+            $p;
+        } else {
+            10000 + int(rand()*1000);
+        }
+    };
+
+    while ( $port++ < 20000 ) {
+        next if $_check_port->($port);
+        my $sock = IO::Socket::INET->new(
+            Listen    => 5,
+            LocalAddr => '127.0.0.1',
+            LocalPort => $port,
+            Proto     => 'tcp',
+            (($^O eq 'MSWin32') ? () : (ReuseAddr => 1)),
+        );
+        return $port if $sock;
+    }
+    die "empty port not found";
+}
+
diff --git a/t/tcp_listen.t b/t/tcp_listen.t
new file mode 100644
index 0000000..a17635d
--- /dev/null
+++ b/t/tcp_listen.t
@@ -0,0 +1,49 @@
+use strictures 1;
+use Test::More;
+use Tak::Daemon::ListenerService;
+use Tak::Client;
+use Tak::Router;
+use Tak::ConnectorService;
+
+use Log::Contextual ();
+use Log::Contextual::SimpleLogger ();
+
+Log::Contextual::set_logger(
+  Log::Contextual::SimpleLogger->new({
+    levels_upto => 'info',
+    coderef => sub { print STDERR @_; }
+  })
+);
+
+use lib 't/lib';
+use PortFinder;
+
+my $port = empty_port;
+
+my $l_cl = Tak::Client->new(
+  service => Tak::Daemon::ListenerService->new(
+    router => Tak::Client->new(service => Tak::Router->new),
+    listen_on => { ip => '127.0.0.1', port => $port },
+  )
+);
+
+$l_cl->do('start');
+
+warn "up on ${port}";
+
+#Tak->loop_until(0);
+
+my $conn_cl = Tak::Client->new(
+  service => Tak::ConnectorService->new
+);
+
+warn "Connecting";
+
+my $cl = $conn_cl->curry(
+  connection => $conn_cl->do(create => "127.0.0.1:${port}")
+    => remote => 'meta'
+);
+
+cmp_ok($cl->do('pid'), '==', $$, "PID returned from TCP ok");
+
+done_testing;