#!/usr/bin/perl
# dispatcher.pl
use strict;
use warnings;
use Inline 'C';
use IO::Socket::INET;
use IO::Socket::UNIX;
use Socket;
use IO::Select;


my $dispatcher_pid = $$;
my $debug_prefix = 'dispatcher';

sub debug ($) {
    warn "[$debug_prefix] @_\n";
}

socketpair (my $child_end, my $parent_end, AF_UNIX, SOCK_DGRAM, PF_UNSPEC) or die $!;
bless $_, 'IO::Socket::UNIX' for $child_end, $parent_end;

my $listen = IO::Socket::INET->new(
    Listen => 2,
    Proto => 'tcp',
    LocalPort => 40001,
    ReuseAddr => 1,
) or die $!;

# Unschoene Methode, um nach unserem Tod sicherzustellen, dass keine Kinder ueberleben
END {
    system('fuser', '-k', $listen->sockport . '/tcp') if defined $listen and $$ == $dispatcher_pid;
}

my @children;
my $available_children=0;

for my $child_id (0..1) {
    my $pid = fork;
    defined $pid or die $!;
    unless ($pid) {
        $debug_prefix = "child $child_id";
        run_child($child_id);
        exit;
    }
    $children[$child_id] = {
        pid => $pid,
        id => $child_id,
    };
}
debug 'forked all children';

run_dispatcher();
exit;

sub run_dispatcher {
    my $sel = IO::Select->new;
    $sel->add($parent_end);
    $sel->add($listen);
    debug 'running dispatcher';
    while (my @r = $sel->can_read()) {
        INCOMING: for (@r) {
            if ($_ == $listen) {
                my $accept = $listen->accept;
                debug 'incoming connection from ' . $accept->peerhost;
                if ($available_children) {
                    debug "$available_children children are available.  Dispatching connection";
                    my $ret = send_fd(fileno($parent_end), fileno($accept));
                    debug "send_fd returned $ret";
                    0 == $ret and --$available_children;
                    next INCOMING;
                }
                debug 'no-one available.  Shutting down the connection.';
                $accept->shutdown(SHUT_RDWR);
            } elsif ($_ == $parent_end) {
                defined $parent_end->recv(my $dgram, 20, 0) or die $!;
                debug "got $dgram";
                if ($dgram =~ /^\d+ available$/) {
                    ++$available_children;
                }
            }
        }
    }
}

sub run_child {
    my ($child_id) = @_;
    debug "running child (pid $$)";
    for (;;) {
        $child_end->send("$child_id available") or die $!;
        my $fd = get_fd(fileno($child_end));
        die $! if -1 == $fd;
        debug "get_fd returned $fd";
        open my $client, "+<&$fd" or die $!;
        serve_client($client);
    }
}


sub serve_client {
    my ($client) = @_;
    local $_;
    while (<$client>) {
        chomp;
        debug "client sent $_";
        syswrite ($client, "I already know everything about $_.\n");
    }
}


__END__
__C__
#include <sys/types.h>
#include <sys/socket.h>

int get_fd (int sock) {
  struct cmsghdr *cmsg = alloca(CMSG_LEN(sizeof(int)));
  struct msghdr hdr = {
    .msg_name       = NULL,
    .msg_namelen    = 0,
    .msg_iov        = NULL,
    .msg_iovlen     = 0,
    .msg_control    = cmsg,
    .msg_controllen = CMSG_LEN(sizeof(int)),
    .msg_flags      = 0,
  };
  int ret;
  int *fdptr;

  ret = recvmsg (sock, &hdr, 0);
  if (0 != ret)
      return -1;

  cmsg = CMSG_FIRSTHDR(&hdr);
  if (NULL == cmsg)
      return -1;

  fdptr = (int*) CMSG_DATA(cmsg);

  return *fdptr;
}

int send_fd (int sock, int fd) {
  char buf [CMSG_SPACE(sizeof(fd))];
  struct msghdr hdr = {
    .msg_control    = buf,
    .msg_controllen = sizeof(buf),
  };
  struct cmsghdr *cmsg = CMSG_FIRSTHDR(&hdr);
  int *fdptr;

  cmsg->cmsg_level = SOL_SOCKET;
  cmsg->cmsg_type  = SCM_RIGHTS;
  cmsg->cmsg_len   = CMSG_LEN(sizeof(fd));
  fdptr = (int*) CMSG_DATA(cmsg);
  *fdptr = fd;

  return sendmsg(sock, &hdr, 0);
}