#!/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 $origin = 'http://software.hixie.ch'; # test with http://software.hixie.ch/utilities/js/websocket/
my $url = 'ws://damowmow.com:11111/demo';

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 $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 $!;
                # print "$data";
                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) = @_;
    # ...
}

sub disconnected {
    my($client) = @_;
    # ...
}

sub process {
    my($client, $data) = @_;
    # this server just echos everything:
    sendText($client, "You said: $data");
}