#きっかけ
今回、WebSocketを使ってみようと思ったのは、業務用の管理ソフトのWeb化を行っていたときに、クライアント様にこう言われたことに端を発します。

『この画面って他の人が編集してるとき、Excel Online』みたいに画面も同期されるんですよね？』
『えっ・・・』

そういえば、WebSocketなんていうのがあったはずだし何とかなるだろう。

思い立ったが吉日。早速、JQueryからの接続やサーバーコードを漁ってみると、どれも非常に簡単そうでなんとも魅力的！

とりあえず、適当に慣れ親しんでいるC#のサーバーコードをコピペして動かしてみる。
おほー！簡単じゃない！わくわくするね！！ (JQueryクライアントはこちらの記事のコードを使用しました)

しかし、私は一通り触ったあとに、ふと気づいた・・・・
#「これって・・・認証どうやんの？」

さて困った。
プロトコルを見てみるが、認証に使われているIDはプロトコル内部で使う為のもののようで、接続時に指定したりはできそうにない。
RFC 6455 - ハンドシェイク

既存のWebSocketサーバーライブラリ群はハンドシェイクのイベントこそあれ、ハンドシェイクに引数なりを受け渡せるような仕組みはなさそうだ。

そこで私が目をつけたのが、ハンドシェイクの GET で渡される Originセクションだ。

GET /chat HTTP/1.1
Host: server.example.com
Upgrade: websocket
Connection: Upgrade
Sec-WebSocket-Key: dGhlIHNhbXBsZSBub25jZQ==
Origin: http://example.com
Sec-WebSocket-Protocol: chat, superchat
Sec-WebSocket-Version: 13

ふつうのhttp::GETみたいに ? のあとのURL引数にセッションIDくっつけたらどうだろう？
はたしてハンドシェイクはうまくいくのだろうか？

試しにJQueryにダミーのSessionIDを付けてC#のサーバーへ接続させてみると。
（下記コードはC#のサーバーのハンドシェイク部分。Urlを表示させてみる）

Program.cs

            while (true)
            {
                /// 接続待機
                var listenerContext = await httpListener.GetContextAsync();
                if (listenerContext.Request.IsWebSocketRequest)
                {
                    /// httpのハンドシェイクがWebSocketならWebSocket接続開始
                    ProcessRequest(listenerContext);
+                    Console.WriteLine("{0}: Origin: {1}", DateTime.Now.ToString(), listenerContext.Request.Url.ToString());
                }
                else
                {
                    /// httpレスポンスを返す
                    listenerContext.Response.StatusCode = 400;
                    listenerContext.Response.Close();
                }
            }

・・・何事もなくハンドシェイク成功。

うわーい！

今回の業務用管理ソフトの場合はPerlである。
そしてセッション管理はPerlモジュールのCGI::Session。

そうなると、私のワクワクは止まらない。

器用貧乏のPerlさん、キミならどうせあるのであろう？ WebSocket Server も。
ほら、あった！
Net::WebSocket::Server

#さっそくインストールだ！
コマンドプロンプトでcpanのinstallを叩きます。
# cpan install Net::WebSocket::Server

そして、C#では長かったコードも、こんなに少ないコードでほぼ同等機能。キミ大好き！

ポート番号12345はNEC社製ブロードバンドルーターではデフォルトでフィルタリングされているらしいので注意。一部の人からだけ「PCから繋がらねー！スマホからはつながるのに！」と謎のクレームを受けました。謎の解明に1週間以上かかりましたとさ。

test.pl

use Net::WebSocket::Server;
Net::WebSocket::Server->new(
	listen => 12345,
	on_connect => sub {
		my ($serv, $conn) = @_;
		$conn->on(
			handshake => sub {
				my ($conn, $handshake) = @_;
				print "connect:(addr:" . $conn->socket->peerhost(). ":". $conn->socket->peerport() . ", query:" . $q . ")\n";
			},
			utf8 => sub {
				my ($conn, $msg) = @_;
				$_->send_utf8($msg) for $conn->server->connections;
			},
			disconnect => sub {
				my ($conn, $code, $reason) = @_;
				print "disconnect:(" . $conn->socket->peerhost(). ":". $conn->socket->peerport(). ", code:" . $code . ")\n";
			}
		);
	},
)->start;

ちょっとわかりにくいですが、$conn は Net::IP::Socket ですので、$conn->socket->peerhost() などとすれば、IPアドレスも取れます。

そして、肝心なCGI::Sessionの認証を入れてみたよ！

ws.pl

use Net::WebSocket::Server;
use CGI::Session qw/-ip_match/;

my %clients = ();

Net::WebSocket::Server->new(
	listen => 12345,
	on_connect => sub {
		my ($serv, $conn) = @_;
		$conn->on(
			handshake => sub {
				my ($conn, $handshake) = @_;
				# URLからセッションIDを取り出す
				my ($q) = $handshake->req->resource_name =~ /\?(.*)$/;
				# CGI::Session を使って通常のCGI同様にセッションIDの生存確認
				my $session = new CGI::Session(undef, $q, {Directory=>'/.session'});
				if (!(defined $session->id) || $q ne $session->id) {
					$conn->disconnect(); #お前はもう死んでいる
					return;
				}
				# クライアントのアドレスとポートをKeyに、セッションIDを入れておく
				$clients{$conn->socket->peerhost(). ":". $conn->socket->peerport()} = $q;
				print "connect:(addr:" . $conn->socket->peerhost(). ":". $conn->socket->peerport() . ", query:" . $q . ")\n";
			},
			utf8 => sub {
				my ($conn, $msg) = @_;
				# IPアドレスとポートからセッションIDを取り出す
				my $q = $clients{$conn->socket->peerhost(). ":". $conn->socket->peerport()};
				my $session = new CGI::Session(undef, $q, {Directory=>'/.session'});
				# 生存チェック
				if (!(defined $session->id) || $q ne $session->id) {
					undef $clients{$conn->socket->peerhost(). ":". $conn->socket->peerport()}; #セッションIDも消す
					$conn->disconnect(); #はい死んだー！
					return;
				}
				$_->send_utf8($msg) for $conn->server->connections;
			},
			disconnect => sub {
				my ($conn, $code, $reason) = @_;
				print "disconnect:" . $conn->socket->peerhost(). ":". $conn->socket->peerport(). " code:" . $code . "\n";
			}
		);
	},
)->start;

いけるぜ！！やっぱりPerlさん大好きだ。

追記:セッション切れてもメッセージは受け取れてしまうじゃん！って気付いたので修正
チェック関数が３箇所から違った呼ばれ方するからちょっとややこしい
grep中にsubを使った場合、引数渡すと$_が上書きされてreturn後に左辺が破壊されるのは知らなかった・・・

ws.pl

use Net::WebSocket::Server;
use CGI::Session qw/-ip_match/;
#no warnings 'redefine';
#use Data::Dumper;{package Data::Dumper;sub qquote{return shift;}}$Data::Dumper::Useperl=1;

my %clients = ();
my $directory = '/ws/';

Net::WebSocket::Server->new(
	listen => 12345,
	on_connect => sub {
		my ($serv, $conn) = @_;
		$conn->on(
			handshake => sub {
				my ($conn, $handshake) = @_;
				# URLを分解 RFC 2396 http://tools.ietf.org/html/rfc2396#appendix-B
				my @uri = $handshake->req->resource_name =~ m|^(([^:/?#]+):)?(//([^/?#]*))?([^?#]*)(\?([^#]*))?(#(.*))?|;
				# ディレクトリを比較
				if($directory ne $uri[4]) {
					$conn->disconnect($conn->socket);
					return;
				}
				# セッション生存確認
				my $q = $uri[6];
				return if (!check_session($conn, $q));
				# クライアントのアドレスとポートをKeyに、セッションIDを入れておく
				$clients{$conn->socket->peerhost(). ":". $conn->socket->peerport()} = $q;
#				print Dumper($conn)."\n";
				print "connect:(addr:" . $conn->socket->peerhost(). ":". $conn->socket->peerport() . ", query:" . $q . ")\n";
			},
			utf8 => sub {
				my ($conn, $msg) = @_;
				# セッション生存確認
				my $sid = $clients{$conn->socket->peerhost(). ":". $conn->socket->peerport()};
				check_session($_) for grep {$conn != $_} $conn->server->connections; #自分以外のチェック
				return if !check_session($conn, $sid); #自分自身のチェック
				# メッセージ送信
				$_->send_utf8($msg) for $conn->server->connections;
			},
			disconnect => sub {
				my ($conn, $code, $reason) = @_;
				print "disconnect:(" . $conn->socket->peerhost(). ":". $conn->socket->peerport(). " code:" . $code . ")\n";
			}
		);
	},
)->start;

sub check_session {
	# IPアドレスとポートからセッションIDを取り出す
	my $conn = $_ && $_->can("socket") || !$_[1] ? $_: $_[0];
	my $addr = $conn->socket->peerhost(). ":". $conn->socket->peerport();
	my $sid = $_ && $_->can("socket") || !$_[1] ? $clients{$addr} : $_[1];
	my $session = CGI::Session->load(undef, $sid, {Directory=>'/.session'});
	# 生存チェック
	if (!(defined $session->id) || $sid ne $session->id) {
		$conn->disconnect($conn->socket); #お前はもう死んでいる
		undef $clients{$addr}; #セッションIDも消す
		return 0;
	}
	return 1;
}

#終わりに
とりあえず、私はめんどくさがり屋なので、今回は一番カンタンそうな方法を見つけてうまく行った感じです。
でも、もう少し深く掘り下げれば、ハンドシェイクのソースコードをいじって、Sec-WebSocket-Accept セクションにCGI::SessionのSessionIDを突っ込んだりするのが、カッコイイのかもしれないのですが

そんな技術なんか無いってば！

Perlはもともとデーモンも得意だから素敵ですね～。
PHPでもWebSocket Serverを立てることができるらしいですが、PHPのデーモンというのは余り聞かないですよね・・・。
セッションIDだけで接続管理を行うのはPerl以外では難しそうです。