#!/usr/bin/env perl use strict; use warnings; use FindBin; use Pod::Usage; use AnyEvent::Socket; use AnyEvent::Handle; use Text::MicroTemplate::File; use Path::Class qw/file dir/; use JSON; use Plack::Request; use Plack::Builder; my $mtf = Text::MicroTemplate::File->new( include_path => ["templates"], ); my(@clients, %room); my $app = sub { my $env = shift; my $req = Plack::Request->new($env); my $res = $req->new_response(200); if ($req->path eq '/') { $res->content_type('text/html; charset=utf-8'); $res->content($mtf->render_file('index.mt')); } elsif ($req->path =~ m!^/chat!) { my $room = ($req->path =~ m!^/chat/(.+)!)[0]; my $host = $req->header('Host'); $res->content_type('text/html;charset=utf-8'); $res->content($mtf->render_file('room.mt', $host, $room)); } elsif ($req->path =~ m!^/ws!) { my $room = ($req->path =~ m!^/ws/(.+)!)[0]; unless ( $env->{HTTP_CONNECTION} eq 'Upgrade' and $env->{HTTP_UPGRADE} eq 'WebSocket') { $res->code(400); return $res->finalize; } return sub { my $respond = shift; # XXX: we could use $respond to send handshake response # headers, but 101 status message should be 'Web Socket # Protocol Handshake' rather than 'Switching Protocols' # and we should send HTTP/1.1 response which Twiggy # doesn't implement yet. my $hs = join "\015\012", "HTTP/1.1 101 Web Socket Protocol Handshake", "Upgrade: WebSocket", "Connection: Upgrade", "WebSocket-Origin: $env->{HTTP_ORIGIN}", "WebSocket-Location: ws://$env->{HTTP_HOST}$env->{SCRIPT_NAME}$env->{PATH_INFO}", '', ''; my $fh = $env->{'psgix.io'} or return $respond->([ 501, [ "Content-Type", "text/plain" ], [ "This server does not support psgix.io extension" ] ]); my $h = AnyEvent::Handle->new( fh => $fh ); $h->on_error(sub { warn 'err: ', $_[2]; delete $room{ $room }[fileno($fh)] if $room; undef $h; }); $h->push_write($hs); # connection ready $room{ $room }[ fileno($fh) ] = $h; $h->on_read(sub { shift->push_read( line => "\xff", sub { my ($h, $json) = @_; $json =~ s/^\0//; my $data = JSON::decode_json($json); $data->{address} = $req->address; $data->{time} = time; my $msg = JSON::encode_json($data); # broadcast for my $c (grep { defined } @{ $room{$room} || [] }) { $c->push_write("\x00" . $msg . "\xff"); } }); }); }; } else { $res->code(404); } $res->finalize; }; builder { enable "Static", path => sub { s!^/static/!! }, root => 'static'; $app; };