#!/usr/bin/perl -wT
use strict;
use Encode;
use IO::Socket;
use IO::Select;
use Digest::MD5 qw(md5);

my $origin = 'http://damowmow.com';
my $url = 'ws://damowmow.com:11111/tic-tac-toe';

my $server = IO::Socket::INET->new(LocalPort => 11111, Proto => 'tcp', Listen => 5, ReuseAddr => 1) or die;
my $sockets = IO::Select->new($server);
my $clients = {};

my $pendingGame;

my $active = 1;
local $SIG{'TERM'} = sub { $active = 0; };
local $SIG{'INT'} = sub { $active = 0; };

while ($active) {
    foreach my $socket ($sockets->can_read()) {
        if ($socket == $server) {
            if ($socket = $server->accept) {
                $sockets->add($socket);
                $clients->{$socket->fileno} = { socket => $socket, state => 0, closing => 0 };
            }
        } else {
            my $client = $clients->{$socket->fileno};
            eval {
                my $data = '';
                $socket->sysread($data, 1) or die $!;
                if ($client->{state} == 0) {
                    # search for end of handshake
                    $client->{buffer} .= $data;
                    if ($client->{buffer} =~ m/\r\n\r\n........\z/s) {
                        my @lines = split(/\r\n/, $client->{buffer});
                        $lines[0] =~ m/^GET \/demo /os or die 'incorrect opening handshake start';
                        shift @lines;
                        foreach (@lines) {
                            last if $_ eq '';
                            m/^([^:]+): (.*)$/gos or die 'malformed field in handshake';
                            die 'duplicate field' if exists $client->{fields}->{lc $1};
                            $client->{fields}->{lc $1} = $2;
                        }
                        my $key1 = getKey($client->{fields}->{'sec-websocket-key1'});
                        my $key2 = getKey($client->{fields}->{'sec-websocket-key2'});
                        my $key3 = substr($client->{buffer}, -8);
                        my $key = md5(pack("NNa8", $key1, $key2, $key3));
                        $client->{socket}->syswrite("HTTP/1.1 101 WebSocket Protocol Handshake\r\n");
                        $client->{socket}->syswrite("Upgrade: WebSocket\r\n");
                        $client->{socket}->syswrite("Connection: Upgrade\r\n");
                        $client->{socket}->syswrite("Sec-WebSocket-Location: $url\r\n");
                        $client->{socket}->syswrite("Sec-WebSocket-Origin: $origin\r\n");
                        $client->{socket}->syswrite("\r\n");
                        $client->{socket}->syswrite($key);
                        connected($client);
                        $client->{state} = 1;
                    }
                } elsif ($client->{state} == 1) {
                    # expecting start of frame
                    if (bytes::ord($data) == 0x00) {
                        $client->{buffer} = '';
                        $client->{state} = 2;
                    } elsif (bytes::ord($data) == 0xff) {
                        $client->{state} = 3;
                    } else {
                        die 'unknown frame type';
                    }
                } elsif ($client->{state} == 2) {
                    # expecting data from frame of type 0x00
                    if (bytes::ord($data) != 0xff) {
                        $client->{buffer} .= $data;
                    } else {
                        # end of frame
                        process($client, Encode::decode('UTF-8', $client->{buffer}));
                        $client->{state} = 1;
                    }
                } elsif ($client->{state} == 3) {
                    # expecting 0x00 indicating communication termination from client
                    die 'unexpected 0xff frame data' unless bytes::ord($data) == 0x00;
                    sendClose($client);
                    $client->{state} = 4;
                    die;
                }
            };
            if ($@) {
                if ($client->{state} > 0) {
                    disconnected($client);
                }
                if ($client->{state} < 4) {
                    warn $@;
                }
                delete $clients->{$socket->fileno};
                $sockets->remove($socket);
                $socket->shutdown(2) if $socket->connected;
            }
        }
    }
}
print "Terminating...\n";
$server->shutdown(2);

sub getKey {
    my($raw) = @_;
    die 'missing key field' unless defined $raw;
    my $spaces =()= $raw =~ m/ /gos;
    $raw =~ s/[^0-9]//gos;
    return (0+$raw)/$spaces;
}

sub sendText {
    my($client, $data) = @_;
    $client->{socket}->syswrite(bytes::chr(0x00) . encode('UTF-8', $data) . bytes::chr(0xff));
}

sub sendClose {
    my($client) = @_;
    if (not $client->{socket}->{closing}) {
        $client->{socket}->syswrite(bytes::chr(0xff) . bytes::chr(0x00));
        $client->{socket}->{closing} = 1;
    }
}


# server-specific code

sub connected {
    my($client) = @_;
    sendText($client, 'wait');
    if (not $pendingGame) {
        $pendingGame = {
            players => [],
            board => '.........',
            next => $client,
        };
    }
    $client->{game} = $pendingGame;
    push(@{$pendingGame->{players}}, $client);
    if (@{$pendingGame->{players}} == 2) {
        $pendingGame->{players}->[0]->{other} = $pendingGame->{players}->[1];
        $pendingGame->{players}->[0]->{xo} = 'X';
        sendText($pendingGame->{players}->[0], 'start X');
        sendText($pendingGame->{players}->[0], 'board ' . $pendingGame->{board});
        $pendingGame->{players}->[1]->{other} = $pendingGame->{players}->[0];
        $pendingGame->{players}->[1]->{xo} = 'O';
        sendText($pendingGame->{players}->[1], 'start O');
        sendText($pendingGame->{players}->[1], 'board ' . $pendingGame->{board});
        sendText($pendingGame->{next}, 'play');
        $pendingGame = undef;
    }
}

sub disconnected {
    my($client) = @_;
    if (@{$client->{game}->{players}} == 2) {
        sendText($client->{other}, 'abandoned');
        connected($client->{other});
    }
}

sub process {
    my($client, $data) = @_;
    if ($data =~ m/^[0-8]$/os) {
        # trying to move
        if (@{$client->{game}->{players}} < 2) {
            sendText($client, 'error wait');
            return;
        }
        if ($client->{game}->{next} != $client) {
            sendText($client, 'error out of turn');
            return;
        }
        if (substr($client->{game}->{board}, $data, 1) ne '.') {
            sendText($client, 'error not blank');
            return;
        }
        substr($client->{game}->{board}, $data, 1
, $client->{xo});
        sendText($client->{game}->{players}->[1], 'board ' . $client->{game}->{board});
        sendText($client->{game}->{players}->[0], 'board ' . $client->{game}->{board});
        $client->{game}->{next} = $client->{other};
        # TODO win detection, etc
        sendText($client->{game}->{next}, 'play');
    } else {
        # TODO chat, etc
        sendText($client, 'error unrecognised message');
    }
}