#! perl # mandatory

# this listens for new tcp connections and hands them over to the server core

use Socket;
use AnyEvent::Socket;

CONF BIND_ADDRESSES = [[undef, 13327]];
CONF DETECT_TIMEOUT = 300; # when to time-out connections
CONF LOG_CONNECTS   = 1; # whether to even log connects

our $MAX_DETECT; # how many bytes to read to identify the protocol

our @LISTENERS;
our @DETECTORS;
our %DETECTORS;

sub _update_detectors {
   $MAX_DETECT = List::Util::max map $_->[1], values %DETECTORS;
}

sub register($$$$) {
   my ($name, $max_detect, $detect, $serve) = @_;

   $DETECTORS{$name} = [$max_detect, $detect, $serve, $name];
   _update_detectors;

   Guard::guard {
      delete $DETECTORS{$name};
      _update_detectors if defined &_update_detectors;
   }
}

our $deliantra_detector = ext::tcp::register deliantra => 10, sub {
   /^..version /s
}, sub {
   my $ns = cf::client::create fileno $_[1], $_[0];
   $ns->run;
   $ns->inbuf_append ($_[2]);
};

for (@$BIND_ADDRESSES) {
   my ($host, $port) = @$_;
   cf::info "listening on ", (format_hostport $host, $port), "\n";

   push @LISTENERS, tcp_server $host, $port, sub {
      my ($fh, $host, $port) = @_
         or return;

      my $lhost = AnyEvent::Socket::format_address
                     +(AnyEvent::Socket::unpack_sockaddr getsockname $fh)[1];

      my $id = format_hostport $host, $port;

      cf::info "$id: accepted connection.\n"
         if $lhost ne $host and $LOG_CONNECTS; # do not log connections from the host, e.g. for watchdogs

      my ($buf, $t, $r);

      $r = AE::io $fh, 0, sub {
         my $len = sysread $fh, $buf, 512, length $buf;

         if ($len) {
            for ($buf) {
               for my $v (values %DETECTORS) {
                  if (my $cb = $v->[1]()) {
                     undef $r; undef $t;
                     cf::info "$id: detected protocol $v->[3].\n";
                     $v->[2]($id, $fh, $buf);
                     return;
                  }
               }

               if (length >= $MAX_DETECT) { # unable to detect protocol
                  undef $r; undef $t;
                  cf::debug "$id: data received, but cannot detect protocol, closing.\n"
                     if $LOG_CONNECTS;
               }
            }
         } else {
            undef $r; undef $t;
            cf::info "$id: read error during protocol detection ($!)\n"
               if $LOG_CONNECTS;
         }
      };
      $t = EV::timer $DETECT_TIMEOUT, 0, sub {
         cf::info "$id: protocol detection tiomeout.\n"
            if $LOG_CONNECTS;
         shutdown $fh, 0;
      };
   };
}