ws-server.pl

#!/usr/bin/env perl

use strict;
use warnings;
use FindBin;

use Getopt::Long;
use Pod::Usage;

use AnyEvent::Socket;
use AnyEvent::Handle;
use HTTP::Parser::XS qw(parse_http_request);

GetOptions(
    \my %option,
    qw/help port host/
);
pod2usage(0) if $option{help};
$option{port} ||= 10081;
$option{host} ||= '127.0.0.1';

my @clients;
tcp_server $option{host}, $option{port}, sub {
    my ($fh, $host, $port) = @_;
    die $! unless $fh;

    print "new connection: $host:$port\n";

    my $h = AnyEvent::Handle->new( fh => $fh );
    $h->on_error(sub {
        warn 'err: ', $_[2];
        delete $clients[ fileno($fh) ];
        undef $h;
    });

    $h->push_read( line => qr/\x0d?\x0a\x0d?\x0a/, sub {
        my ($h, $hdr) = @_;

        my $err;
        my $r = parse_http_request($hdr . "\x0d\x0a\x0d\x0a/", \my %env);
        $err++ if $r < 0;
        $err++ unless $env{HTTP_CONNECTION} eq 'Upgrade'
                  and $env{HTTP_UPGRADE} eq 'WebSocket';
        if ($err) {
            undef $h;
            return;
        }

        my $handshake = join "\x0d\x0a",
            'HTTP/1.1 101 Web Socket Protocol Handshake',
            'Upgrade: WebSocket',
            'Connection: Upgrade',
            "WebSocket-Origin: $env{HTTP_ORIGIN}",
            "WebSocket-Location: ws://$env{HTTP_HOST}$env{PATH_INFO}",
            '', '';
        $h->push_write($handshake);

        # connection ready
        $clients[ fileno($fh) ] = $h;

        $h->on_read(sub {
            shift->push_read( line => "\xff", sub {
                my ($h, $msg) = @_;
                for my $c (grep { defined } @clients) {
                    $c->push_write("\x00" . $msg . "\xff");
                }
            });
        });
    });
};

print "Accepting requests at http://$option{host}:$option{port}/\n";
AnyEvent->condvar->recv;

__END__

=head1 NAME

ws-server.pl

=head1 SYNOPSIS

  ws-server.pl [options]
  
  Options:
      --help          show this help
      --host          address to bind (default 127.0.0.1)
      --port          http port number (default: 10081)

=head1 AUTHOR

Kazuhito Hokamura <k.hokamura@gmail.com>

=cut