#! perl # mandatory depends=tcp

# websocket protocol server (RFC6455), actually only the handshake part
# the framing is implemented in socket/lowlevel.C
# this implementations doesn't even try to completely implement th RFC,
# it tries only to be good enough.

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\.]+).*\015\012\015\012}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;
};