From 9cb57e95c60f7bc8f284ade6ee035c7101deaf86 Mon Sep 17 00:00:00 2001 From: Andreas Garnaes Date: Thu, 3 Jan 2019 21:29:55 +0100 Subject: [PATCH] Add server connection functionality --- lib/server_connection.ml | 101 ++++++++++++++++++++++++++++++++++++++ lib/server_connection.mli | 24 +++++++++ lib/server_handshake.ml | 39 +++++++++++++++ lib/server_handshake.mli | 19 +++++++ lib/server_websocket.ml | 43 ++++++++++++++++ lib/server_websocket.mli | 22 +++++++++ lib/websocketaf.ml | 3 +- 7 files changed, 250 insertions(+), 1 deletion(-) create mode 100644 lib/server_connection.ml create mode 100644 lib/server_connection.mli create mode 100644 lib/server_handshake.ml create mode 100644 lib/server_handshake.mli create mode 100644 lib/server_websocket.ml create mode 100644 lib/server_websocket.mli diff --git a/lib/server_connection.ml b/lib/server_connection.ml new file mode 100644 index 0000000..4bc4d10 --- /dev/null +++ b/lib/server_connection.ml @@ -0,0 +1,101 @@ +module IOVec = Httpaf.IOVec + +type 'handle state = + | Uninitialized + | Handshake of 'handle Server_handshake.t + | Websocket of Server_websocket.t + +type 'handle t = 'handle state ref + +type input_handlers = Server_websocket.input_handlers = + { frame : opcode:Websocket.Opcode.t -> is_fin:bool -> Bigstring.t -> off:int -> len:int -> unit + ; eof : unit -> unit } + +let passes_scrutiny _headers = + true (* XXX(andreas): missing! *) + +let create ~sha1 ~websocket_handler = + let t = ref Uninitialized in + let request_handler reqd = + let request = Httpaf.Reqd.request reqd in + if passes_scrutiny request.headers then begin + let key = Httpaf.Headers.get_exn request.headers "sec-websocket-key" in + let accept = sha1 (key ^ "258EAFA5-E914-47DA-95CA-C5AB0DC85B11") in + let headers = Httpaf.Headers.of_list [ + "upgrade", "websocket"; + "connection", "upgrade"; + "sec-websocket-accept", accept + ] in + let response = Httpaf.(Response.create ~headers `Switching_protocols) in + (* XXX(andreas): this is a hacky workaround for a missing flush hook *) + let body = Httpaf.Reqd.respond_with_streaming reqd response in + Httpaf.Body.write_string body " "; + Httpaf.Body.flush body (fun () -> + t := Websocket (Server_websocket.create ~websocket_handler); + Httpaf.Body.close_writer body + ) + end + in + let handshake = + Server_handshake.create + ~request_handler + in + t := Handshake handshake; + t +;; + +let next_read_operation t = + match !t with + | Uninitialized -> assert false + | Handshake handshake -> Server_handshake.next_read_operation handshake + | Websocket websocket -> (Server_websocket.next_read_operation websocket :> [ `Read | `Yield | `Close ]) +;; + +let read t bs ~off ~len = + match !t with + | Uninitialized -> assert false + | Handshake handshake -> Server_handshake.read handshake bs ~off ~len + | Websocket websocket -> Server_websocket.read websocket bs ~off ~len +;; + +let read_eof t bs ~off ~len = + match !t with + | Uninitialized -> assert false + | Handshake handshake -> Server_handshake.read_eof handshake bs ~off ~len + | Websocket websocket -> Server_websocket.read_eof websocket bs ~off ~len +;; + +let yield_reader t f = + match !t with + | Uninitialized -> assert false + | Handshake handshake -> Server_handshake.yield_reader handshake f + | Websocket _ -> assert false +;; + +let next_write_operation t = + match !t with + | Uninitialized -> assert false + | Handshake handshake -> Server_handshake.next_write_operation handshake + | Websocket websocket -> Server_websocket.next_write_operation websocket +;; + +let report_write_result t result = + match !t with + | Uninitialized -> assert false + | Handshake handshake -> Server_handshake.report_write_result handshake result + | Websocket websocket -> Server_websocket.report_write_result websocket result +;; + +let yield_writer t f = + match !t with + | Uninitialized -> assert false + | Handshake handshake -> Server_handshake.yield_writer handshake f + | Websocket websocket -> Server_websocket.yield_writer websocket f +;; + +let close t = + match !t with + | Uninitialized -> assert false + | Handshake handshake -> Server_handshake.close handshake + | Websocket websocket -> Server_websocket.close websocket +;; diff --git a/lib/server_connection.mli b/lib/server_connection.mli new file mode 100644 index 0000000..d771234 --- /dev/null +++ b/lib/server_connection.mli @@ -0,0 +1,24 @@ +module IOVec = Httpaf.IOVec + +type 'handle t + +type input_handlers = + { frame : opcode:Websocket.Opcode.t -> is_fin:bool -> Bigstring.t -> off:int -> len:int -> unit + ; eof : unit -> unit } + +val create + : sha1 : (string -> string) + -> websocket_handler : (Wsd.t -> input_handlers) + -> 'handle t + +val next_read_operation : _ t -> [ `Read | `Yield | `Close ] +val next_write_operation : _ t -> [ `Write of Bigstring.t IOVec.t list | `Yield | `Close of int ] + +val read : _ t -> Bigstring.t -> off:int -> len:int -> int +val read_eof : _ t -> Bigstring.t -> off:int -> len:int -> int +val report_write_result : _ t -> [`Ok of int | `Closed ] -> unit + +val yield_reader : _ t -> (unit -> unit) -> unit +val yield_writer : _ t -> (unit -> unit) -> unit + +val close : _ t -> unit diff --git a/lib/server_handshake.ml b/lib/server_handshake.ml new file mode 100644 index 0000000..4fced0d --- /dev/null +++ b/lib/server_handshake.ml @@ -0,0 +1,39 @@ +module IOVec = Httpaf.IOVec + +type 'handle t = + { connection : 'handle Httpaf.Server_connection.t + } + +let create + ~request_handler + = + let connection = + Httpaf.Server_connection.create + request_handler + in + { connection } +;; + +let next_read_operation t = + Httpaf.Server_connection.next_read_operation t.connection + +let next_write_operation t = + Httpaf.Server_connection.next_write_operation t.connection + +let read t = + Httpaf.Server_connection.read t.connection + +let read_eof t = + Httpaf.Server_connection.read_eof t.connection + +let report_write_result t = + Httpaf.Server_connection.report_write_result t.connection + +let yield_reader t = + Httpaf.Server_connection.yield_reader t.connection + +let yield_writer t = + Httpaf.Server_connection.yield_writer t.connection + +let close t = + Httpaf.Server_connection.shutdown t.connection diff --git a/lib/server_handshake.mli b/lib/server_handshake.mli new file mode 100644 index 0000000..6fe0f22 --- /dev/null +++ b/lib/server_handshake.mli @@ -0,0 +1,19 @@ +module IOVec = Httpaf.IOVec + +type 'handle t + +val create + : request_handler : 'handle Httpaf.Server_connection.request_handler + -> 'handle t + +val next_read_operation : _ t -> [ `Read | `Close | `Yield ] +val next_write_operation : _ t -> [ `Write of Bigstring.t IOVec.t list | `Yield | `Close of int ] + +val read : _ t -> Bigstring.t -> off:int -> len:int -> int +val read_eof : _ t -> Bigstring.t -> off:int -> len:int -> int +val report_write_result : _ t -> [`Ok of int | `Closed ] -> unit + +val yield_reader : _ t -> (unit -> unit) -> unit +val yield_writer : _ t -> (unit -> unit) -> unit + +val close : _ t -> unit diff --git a/lib/server_websocket.ml b/lib/server_websocket.ml new file mode 100644 index 0000000..414f972 --- /dev/null +++ b/lib/server_websocket.ml @@ -0,0 +1,43 @@ +module IOVec = Httpaf.IOVec + +type t = + { reader : [`Parse of string list * string] Reader.t + ; wsd : Wsd.t } + +type input_handlers = + { frame : opcode:Websocket.Opcode.t -> is_fin:bool -> Bigstring.t -> off:int -> len:int -> unit + ; eof : unit -> unit } + +let create ~websocket_handler = + let mode = `Server in + let wsd = Wsd.create mode in + let { frame; _ } = websocket_handler wsd in + { reader = Reader.create frame + ; wsd + } + +let next_read_operation t = + Reader.next t.reader + +let next_write_operation t = + Wsd.next t.wsd + +let read t bs ~off ~len = + Reader.read_with_more t.reader bs ~off ~len Incomplete + +let read_eof t bs ~off ~len = + Reader.read_with_more t.reader bs ~off ~len Complete + +let report_write_result t result = + Wsd.report_result t.wsd result + +let yield_writer t k = + if Wsd.is_closed t.wsd + then begin + Wsd.close t.wsd; + k () + end else + Wsd.when_ready_to_write t.wsd k + +let close { wsd; _ } = + Wsd.close wsd diff --git a/lib/server_websocket.mli b/lib/server_websocket.mli new file mode 100644 index 0000000..0e8047d --- /dev/null +++ b/lib/server_websocket.mli @@ -0,0 +1,22 @@ +module IOVec = Httpaf.IOVec + +type t + +type input_handlers = + { frame : opcode:Websocket.Opcode.t -> is_fin:bool -> Bigstring.t -> off:int -> len:int -> unit + ; eof : unit -> unit } + +val create + : websocket_handler : (Wsd.t -> input_handlers) + -> t + +val next_read_operation : t -> [ `Read | `Close ] +val next_write_operation : t -> [ `Write of Bigstring.t IOVec.t list | `Yield | `Close of int ] + +val read : t -> Bigstring.t -> off:int -> len:int -> int +val read_eof : t -> Bigstring.t -> off:int -> len:int -> int +val report_write_result : t -> [`Ok of int | `Closed ] -> unit + +val yield_writer : t -> (unit -> unit) -> unit + +val close : t -> unit diff --git a/lib/websocketaf.ml b/lib/websocketaf.ml index 5b596a2..fa5430f 100644 --- a/lib/websocketaf.ml +++ b/lib/websocketaf.ml @@ -1,4 +1,5 @@ module Client_handshake = Client_handshake -module Client_connetion = Client_connection +module Client_connection = Client_connection +module Server_connection = Server_connection module Wsd = Wsd module Websocket = Websocket