#!/usr/bin/perl 
# require 5.002;

use strict;
BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
use Socket qw( 
   getaddrinfo getnameinfo IN6ADDR_ANY AF_UNSPEC SOCK_STREAM PF_UNSPEC 
   AI_PASSIVE NI_NUMERICHOST  NI_NUMERICSERV SOL_SOCKET SO_REUSEADDR SOMAXCONN
);

use Carp;
use IO::Select;

my $myself = "$0 ";
sub logmsg { print "$myself $$: @_ at ", scalar localtime, "\n" }

my $host = shift || IN6ADDR_ANY;
my $port = shift || 2345;
my $proto = getprotobyname('tcp');

my $select = &bind_sockets($host,$port);

logmsg "server started on port $port";

my %address_list;

my $paddr;

while(my @ready = $select->can_read()) {
    for my $socket ( @ready ) {
        my $paddr =  accept(my $client, $socket);
        next if (! $paddr) ;

        my ($err,$addr,$m) = getnameinfo($paddr,NI_NUMERICHOST); 
        my ($err,$name,$port) = getnameinfo($paddr,NI_NUMERICSERV); 
        $address_list{$addr} = $name;

        my $user = <$client>;
        $user=~ s/[\r\n]//g;
        logmsg "connection from $user \@ $name [",
             $addr, "]
             at port $port";

        print $client "Hello there, $name, it's now ",
                     scalar localtime, "\n";
        foreach my $k (keys %address_list) {
            print $client "$k = $address_list{$k}\n";
        }
        close($client);
    }
}

sub bind_sockets {
    my ($host0,$port0) = @_;
    my $select = IO::Select->new();

    my ($err,@res) = getaddrinfo($host0, $port0,{socktype=>SOCK_STREAM, flags=>AI_PASSIVE});
    my @socket;
    my (@host);
    for my $res (@res) { 
        my ($family, $socktype, $proto, $saddr, $canonname) = ( $res->{family} , $res->{socktype}, $res->{protocol}, $res->{addr}, $res->{canonname} );
        my ($host, $port) = getnameinfo($saddr,NI_NUMERICHOST | NI_NUMERICSERV);
        print STDERR "Trying to bind to $host : $port... ";
        socket(my $fd, $family, $socktype, $proto) || next;
        setsockopt($fd, SOL_SOCKET, SO_REUSEADDR, pack("l", 1))   || die "setsockopt : $!";

        if (bind($fd, $saddr)) { # sockaddr_in($port, INADDR_ANY)
            listen($fd,SOMAXCONN)  || die "listen: $!  ";
            $select->add($fd);
            print STDERR "connected.\n";
        } else {
            print STDERR "failed.\n";
            close($fd);
        }
    }

    if ($select->count == 0) {
        die "connect attempt failed\n";
    }
    return $select;

}


sub accepts {
    my ($c, @sockets) = @_;    # $c is dummy
}