#! perl # mandatory depends=tcp # websocket protocol server, actually only the handshake part use Digest::SHA1 (); # websocket requests can be very long, and we want the tcp code to buffer for us our $detector = ext::tcp::register websocket => 4096, sub { m{^(?i:GET) \ (?i:http://[^/]+)? /ws \ (?:(?i)HTTP/[0-9\.]+)}xs }, sub { my ($id, $fh, $buf) = @_; $buf =~ /^Sec-WebSocket-Version\s*:\s*([0-9]+)/mi or return; my $version = $1; # 8 ff10, 13 rfc $buf =~ /^Sec-WebSocket-Key\s*:\s*(\S+)/mi or return; my $key = $1; if ($version != 8 && $version != 13) { syswrite $fh, "HTTP/1.1 400 version mismatch\015\012" . "connection: close\015\012" . "sec-websocket-version: 13, 8\015\012\015\012"; return; } my $res = "HTTP/1.1 101 upgrading\015\012" . "connection: upgrade\015\012" . "upgrade: websocket\015\012" . "sec-websocket-accept: " . (Digest::SHA1::sha1_base64 $key . "258EAFA5-E914-47DA-95CA-C5AB0DC85B11") . "=\015\012" . "\015\012"; syswrite $fh, $res; my $ns = cf::client::create fileno $_[1], $_[0]; $ns->ws_version ($version); $ns->run; };