#!/usr/bin/perl
use strict;

$| = 1;
system('stty', '-icanon', 'eol', "\001");

use Socket;
use Fcntl;
use Errno;

########################################################
# set these variables
########################################################

my %FIXED_DATA_ID = (
		     'id-1' => 0,
		     'id-2' => 1,
		     );

my $NONFIXED_DATA_ID_START = 2;

my @SEL_SUB = ( "M.M.M.1:3000", "M.M.M.2:3000" );
my @NOTSEL_SUB = ( "M.M.M.3:3000", "M.M.M.4:3000" );
my @REM = ( "M.M.M.5:3000", "M.M.M.6:3000" );
my @AUDIO = ( "M.M.M.7:3000", "M.M.M.8:3000" );

########################################################
# server
########################################################

local *SSOCK;
socket(SSOCK, &PF_INET, &SOCK_STREAM, 0) || die "ERROR: $!, socket\n";
bind(SSOCK, packaddr($ARGV[0])) || die "ERROR: $!, bind\n";
listen(SSOCK, SOMAXCONN) || die "ERROR: $!, listen\n";
my $ssin = getsockname(SSOCK) || die "ERROR: $!, getsockname\n";
print "server listening on ".unpackaddr($ssin)."\n";

my $connset = connset_init(*SSOCK);

my ($rout, $wout, $eout, $nfound, $conn, $sin, $timeleft);
while(1) {
    ($nfound, $timeleft) = select($rout=$connset->{'rbits'}, $wout=$connset->{'wbits'},
				  $eout=$connset->{'ebits'}, 5.0);
    if($nfound) {
	if(vec($rout, fileno(SSOCK), 1)) {
	    local *CSOCK;
	    accept(CSOCK, SSOCK) || die "ERROR: $!, accept\n";
	    defined($sin = getpeername(CSOCK)) || die "ERROR: $!, getpeername\n";
	    print "connection from ".unpackaddr($sin)."\n";
	    connset_create($connset, *CSOCK, $sin);
	}
	vec($eout, fileno(SSOCK), 1) && die "ERROR: ebit set on SSOCK\n";

	for $conn (@{$connset->{'conns'}}) {
	    vec($rout, fileno($conn->{'sock'}), 1) && conn_recv($conn);
	    vec($wout, fileno($conn->{'sock'}), 1) && conn_send($conn);
	    vec($eout, fileno($conn->{'sock'}), 1) && conn_ebit($conn);
	}
    } else {
	for $conn (@{$connset->{'conns'}}) { conn_timeout($conn); }
    }
}

sub packaddr {
    my ($host, $port) = split(/:/, $_[0]);
    my (undef, undef, undef, undef, $hostaddr) = gethostbyname($host);
    return pack('S n a4 x8', &AF_INET, $port, $hostaddr);
}

sub unpackaddr {
    my ($port, $ip) = sockaddr_in($_[0]);
    return inet_ntoa($ip).':'.$port;
}

sub connset_init {
    my ($ssock) = @_;
    
    my $connset = {
	'rbits' => '',
	'wbits' => '',
	'ebits' => '',
	'conns' => [],
    };
    vec($connset->{'rbits'}, fileno($ssock), 1) = 1;
    vec($connset->{'ebits'}, fileno($ssock), 1) = 1;
    return $connset;
}

sub connset_create {
    my ($connset, $sock, $sin) = @_;

    my $conn = {
	# socket io stuff
	'connset' => $connset,
	'id' => unpackaddr($sin),
	'sock' => $sock,
	'rbuf' => '',
	'sbuf' => '',
    };
    vec($connset->{'rbits'}, fileno($sock), 1) = 1;
    vec($connset->{'ebits'}, fileno($sock), 1) = 1;
    push(@{$connset->{'conns'}}, $conn);
}

sub conn_free {
    my ($conn) = @_;

    if($conn->{'connset'}->{'sel'} == $conn) { $conn->{'connset'}->{'sel'} = undef; }
    delete($conn->{'connset'}->{'data_id_hash'}->{$conn->{'data_id'}});
    delete($conn->{'connset'}->{'reg_id_hash'}->{$conn->{'reg_id'}});

    vec($connset->{'rbits'}, fileno($conn->{'sock'}), 1) = 0;
    vec($connset->{'wbits'}, fileno($conn->{'sock'}), 1) = 0;
    vec($connset->{'ebits'}, fileno($conn->{'sock'}), 1) = 0;
    @{$connset->{'conns'}} = grep { $_ != $conn } @{$connset->{'conns'}};
    shutdown($conn->{'sock'}, 2);
    close($conn->{'sock'});
}

sub conn_recv {
    my ($conn) = @_;

    my $buf;
    if(defined(recv($conn->{'sock'}, $buf, 8192, 0))) {
	if(length($buf)) {
	    $conn->{'rbuf'} .= $buf;
	    conn_process_rbuf($conn);
	} else {
	    print "$conn->{'id'}: EOF\n";
	    conn_free($conn);
	}
    } else {
	print "$conn->{'id'}: ERROR: $!, recv\n";
	conn_free($conn);
    }    
}

sub conn_send {
    my ($conn) = @_;

    my $len = send($conn->{'sock'}, $conn->{'sbuf'}, 0);
    if(! defined($len)) {
	print "$conn->{'id'}: ERROR: $!, send\n";
	conn_free($conn);
    }
    $conn->{'sbuf'} = substr($conn->{'sbuf'}, $len);
    if(! length($conn->{'sbuf'})) {
	if(defined($conn->{'cb'})) {
	    &{$conn->{'cb'}}($conn->{'cb_arg'});
	    $conn->{'cb'} = undef;
	    $conn->{'cb_arg'} = undef;
	}
	vec($connset->{'wbits'}, fileno($conn->{'sock'}), 1) = 0;
	vec($connset->{'rbits'}, fileno($conn->{'sock'}), 1) = 1;
	conn_process_rbuf($conn);
    }
}

sub conn_ebit {
    my ($conn) = @_;

    print "$conn->{'id'}: ERROR: ebit set\n";
    conn_free($conn);
}

sub conn_timeout {
    my ($conn) = @_;
    
    $conn->{'obey'} && return conn_respond($conn, "AGAIN\n");
}

sub conn_process_rbuf {
    my ($conn) = @_;
    
    my $i = index($conn->{'rbuf'}, "\n");
    if($i >= 0) {
	vec($connset->{'rbits'}, fileno($conn->{'sock'}), 1) = 0;
	$conn->{'cmd'} = substr($conn->{'rbuf'}, 0, $i + 1);
	$conn->{'rbuf'} = substr($conn->{'rbuf'}, $i + 1);
	conn_cmd($conn);
    }
}

sub conn_respond {
    my ($conn, $str, $cb, $cb_arg) = @_;
    
    $conn->{'obey'} = undef;
    
    $conn->{'cb'} = $cb;
    $conn->{'cb_arg'} = $cb_arg;
    $conn->{'sbuf'} = $str;
    vec($connset->{'wbits'}, fileno($conn->{'sock'}), 1) = 1;
}

sub conn_nothing {
    my ($conn) = @_;
    return "$conn->{'data_id'},,,,,,";
}

sub conn_notsel {
    my ($conn) = @_;
    return "$conn->{'data_id'},$NOTSEL_SUB[0],$NOTSEL_SUB[1],,,$AUDIO[0],$AUDIO[1]";
}

sub conn_sel {
    my ($conn) = @_;
    return "$conn->{'data_id'},$SEL_SUB[0],$SEL_SUB[1],$REM[0],$REM[1],$AUDIO[0],$AUDIO[1]";
}

sub conn_cmd {
    my ($conn) = @_;

    print "$conn->{'id'}: COMMAND: $conn->{'cmd'}";
    my @words = split(/\s+/, $conn->{'cmd'});

    if($words[0] eq 'register') {
	conn_cmd_register($conn, $words[1], $words[2]);
    } elsif($words[0] eq 'obey') {
	$conn->{'obey'} = 1;
    } elsif($words[0] eq 'select') {
	conn_cmd_select($conn, $words[1]);
    } elsif($words[0] eq 'quit') {
	conn_cmd_quit($conn);
    }  else {
	conn_respond($conn, "ERROR invalid command\n");
    }
}

sub conn_cmd_register {
    my ($conn, $mode, $reg_id) = @_;
    
    if($mode eq 'send') {
    } elsif($mode eq 'recv') {
    } else { return conn_respond($conn, "ERROR invalid mode\n"); }

    length($reg_id) || return conn_respond($conn, "ERROR invalid reg_id\n");
    defined($conn->{'reg_id'}) && return conn_respond($conn, "ERROR already registered\n");
    $conn->{'connset'}->{'reg_id_hash'}->{$reg_id} &&
	return conn_respond($conn, "ERROR reg_id already in use\n");

    # determine data id
    my $data_id = $FIXED_DATA_ID{$reg_id};
    if(! defined($data_id)) {
	$data_id = $NONFIXED_DATA_ID_START; 
	while($conn->{'connset'}->{'data_id_hash'}->{$data_id}) { $data_id++; }
    }

    $conn->{'mode'} = $mode;
    $conn->{'reg_id'} = $reg_id;
    $conn->{'connset'}->{'reg_id_hash'}->{$reg_id} = $conn;		    
    $conn->{'data_id'} = $data_id;
    $conn->{'connset'}->{'data_id_hash'}->{$data_id} = $conn;

    my $config = conn_notsel($conn);
    print "$conn->{'id'}: reg_id=$conn->{'reg_id'} data_id=$conn->{'data_id'}\n";
    print "$conn->{'id'}: config=$config\n";
    conn_respond($conn, "OK config=$config\n");
}

sub conn_cmd_quit {
    my ($conn) = @_;

    $conn->{'connset'}->{'sel'} = undef;
    $conn->{'connset'}->{'quit_count'} = 0;
    $conn->{'connset'}->{'quit_conn'} = $conn;
    for my $oconn (@{$conn->{'connset'}->{'conns'}}) {
	$oconn->{'connset'}->{'quit_count'}++;
	my $config = conn_nothing($oconn);
	print "$oconn->{'id'}: config=$config\n";
	conn_respond($oconn, "OK config=$config\n", \&conn_cmd_quit2, $oconn);
    }
}

sub conn_cmd_quit2 {
    my ($conn) = @_;

    $conn->{'connset'}->{'quit_count'}--;
    if(! $conn->{'connset'}->{'quit_count'}) {
	conn_respond($conn->{'connset'}->{'quit_conn'}, "OK\n");
	$conn->{'connset'}->{'quit_conn'} = undef;
    }
}

sub conn_cmd_select {
    my ($conn, $id) = @_;

    # find new selected conn
    my $sel = $conn->{'connset'}->{'reg_id_hash'}->{$id};
    $sel || ($sel = $conn->{'connset'}->{'data_id_hash'}->{$id});
    if($sel) {
	($sel == $conn->{'connset'}->{'sel'}) && return conn_cmd_select3($conn);
	$conn->{'sel_new'} = $sel;
    }
	
    # if current one close it
    my $sel = $conn->{'connset'}->{'sel'};
    $sel || return conn_cmd_select2($conn);
    $sel->{'obey'} || return conn_cmd_select3($conn);
    $conn->{'connset'}->{'sel'} = undef;
    my $config = conn_notsel($sel);
    print "$sel->{'id'}: config=$config\n";
    conn_respond($sel, "OK config=$config\n", \&conn_cmd_select2, $conn);
}

sub conn_cmd_select2 {
    my ($conn) = @_;
    
    # start new one if possible
    my $sel = $conn->{'sel_new'};
    $sel || return conn_cmd_select3($conn);
    $sel->{'obey'} || return conn_cmd_select3($conn);
    $conn->{'connset'}->{'sel'} = $sel;
    my $config = conn_sel($sel);
    print "$sel->{'id'}: config=$config\n";
    conn_respond($sel, "OK config=$config\n", \&conn_cmd_select3, $conn);
}

sub conn_cmd_select3 {
    my ($conn) = @_;

    $conn->{'sel_new'} = undef;
    conn_respond($conn, "OK\n");
}