diff --git a/CHANGES.md b/CHANGES.md index 73f2fcf1..9a1d31e5 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -17,6 +17,11 @@ Unreleased - h2: in the client implementation, call the stream level error handler when receiving an `RST_STREAM` frame ([#42](https://github.com/anmonteiro/ocaml-h2/pull/42)) +- h2-lwt-unix: fail earlier when setting up a SSL/TLS server without the + depopts being available + ([#46](https://github.com/anmonteiro/ocaml-h2/pull/46)) +- h2-lwt-unix: improve the default ALPN negotiation mechanism in the SSL + binding ([#46](https://github.com/anmonteiro/ocaml-h2/pull/46)) 0.2.0 2019-04-06 -------------- diff --git a/esy.lock/index.json b/esy.lock/index.json index acb5f355..60daa658 100644 --- a/esy.lock/index.json +++ b/esy.lock/index.json @@ -1004,8 +1004,8 @@ ], "devDependencies": [ "ocaml@4.7.1004@d41d8cd9" ] }, - "@opam/octavius@opam:1.2.0@4840f5a0": { - "id": "@opam/octavius@opam:1.2.0@4840f5a0", + "@opam/octavius@opam:1.2.0@70279919": { + "id": "@opam/octavius@opam:1.2.0@70279919", "name": "@opam/octavius", "version": "opam:1.2.0", "source": { @@ -1119,7 +1119,7 @@ "dependencies": [ "ocaml@4.7.1004@d41d8cd9", "@opam/uutf@opam:1.0.2@4440868f", "@opam/stdio@opam:v0.12.0@1d18adcb", - "@opam/octavius@opam:1.2.0@4840f5a0", + "@opam/octavius@opam:1.2.0@70279919", "@opam/ocaml-migrate-parsetree@opam:1.2.0@23e55f71", "@opam/fpath@opam:0.7.2@45477b93", "@opam/dune@opam:1.9.0@a7408d38", "@opam/cmdliner@opam:1.0.3@96d31520", @@ -1130,7 +1130,7 @@ "devDependencies": [ "ocaml@4.7.1004@d41d8cd9", "@opam/uutf@opam:1.0.2@4440868f", "@opam/stdio@opam:v0.12.0@1d18adcb", - "@opam/octavius@opam:1.2.0@4840f5a0", + "@opam/octavius@opam:1.2.0@70279919", "@opam/ocaml-migrate-parsetree@opam:1.2.0@23e55f71", "@opam/fpath@opam:0.7.2@45477b93", "@opam/cmdliner@opam:1.0.3@96d31520", diff --git a/esy.lock/opam/octavius.1.2.0/opam b/esy.lock/opam/octavius.1.2.0/opam index 77d50feb..5b5d3422 100644 --- a/esy.lock/opam/octavius.1.2.0/opam +++ b/esy.lock/opam/octavius.1.2.0/opam @@ -11,7 +11,7 @@ bug-reports: "https://github.com/ocaml-doc/octavius/issues" tags: ["doc" "ocamldoc" "org:ocaml-doc"] depends: [ - "ocaml" {>= "4.03.0"} + "ocaml" {>= "4.03.0" & < "4.08.0"} "ocamlfind" {build} "jbuilder" {build & >= "1.0+beta7"} ] diff --git a/lwt-unix/h2_lwt_unix.ml b/lwt-unix/h2_lwt_unix.ml index 0f3575f2..a21de8ec 100644 --- a/lwt-unix/h2_lwt_unix.ml +++ b/lwt-unix/h2_lwt_unix.ml @@ -116,17 +116,16 @@ module Server = struct ?(config = Config.default) ~request_handler ~error_handler - client_addr - socket = - Tls_io.make_server ?server ?certfile ?keyfile socket - >>= fun tls_server -> - create_connection_handler - ~config - ~request_handler - ~error_handler - client_addr - (socket, tls_server) + let make_tls_server = Tls_io.make_server ?server ?certfile ?keyfile in + fun client_addr socket -> + make_tls_server socket >>= fun tls_server -> + create_connection_handler + ~config + ~request_handler + ~error_handler + client_addr + (socket, tls_server) end module SSL = struct @@ -139,17 +138,16 @@ module Server = struct ?(config = Config.default) ~request_handler ~error_handler - client_addr - socket = - Ssl_io.make_server ?server ?certfile ?keyfile socket - >>= fun ssl_server -> - create_connection_handler - ~config - ~request_handler - ~error_handler - client_addr - ssl_server + let make_ssl_server = Ssl_io.make_server ?server ?certfile ?keyfile in + fun client_addr socket -> + make_ssl_server socket >>= fun ssl_server -> + create_connection_handler + ~config + ~request_handler + ~error_handler + client_addr + ssl_server end end @@ -160,23 +158,27 @@ module Client = struct include H2_lwt.Client (Tls_io.Io) let create_connection - ?client ?(config = Config.default) ?push_handler ~error_handler socket + ?client ?(config = Config.default) ?push_handler ~error_handler = - Tls_io.make_client ?client socket >>= fun tls_client -> - create_connection - ~config - ?push_handler - ~error_handler - (socket, tls_client) + let make_tls_client = Tls_io.make_client ?client in + fun socket -> + make_tls_client socket >>= fun tls_client -> + create_connection + ~config + ?push_handler + ~error_handler + (socket, tls_client) end module SSL = struct include H2_lwt.Client (Ssl_io.Io) let create_connection - ?client ?(config = Config.default) ?push_handler ~error_handler socket + ?client ?(config = Config.default) ?push_handler ~error_handler = - Ssl_io.make_client ?client socket >>= fun ssl_client -> - create_connection ~config ?push_handler ~error_handler ssl_client + let make_ssl_client = Ssl_io.make_client ?client in + fun socket -> + make_ssl_client socket >>= fun ssl_client -> + create_connection ~config ?push_handler ~error_handler ssl_client end end diff --git a/lwt-unix/ssl_io_dummy.ml b/lwt-unix/ssl_io_dummy.ml index 8c400d8e..b04c44b5 100644 --- a/lwt-unix/ssl_io_dummy.ml +++ b/lwt-unix/ssl_io_dummy.ml @@ -57,7 +57,10 @@ type client = nothing type server = nothing -let make_client ?client:_ _socket = Lwt.fail_with "Ssl not available" +let[@ocaml.warning "-21"] make_client ?client:_ = + failwith "Ssl not available"; + fun _socket -> Lwt.fail_with "Ssl not available" -let make_server ?server:_ ?certfile:_ ?keyfile:_ _socket = - Lwt.fail_with "Ssl not available" +let[@ocaml.warning "-21"] make_server ?server:_ ?certfile:_ ?keyfile:_ = + failwith "Ssl not available"; + fun _socket -> Lwt.fail_with "Ssl not available" diff --git a/lwt-unix/ssl_io_real.ml b/lwt-unix/ssl_io_real.ml index 9b500785..939f5aa1 100644 --- a/lwt-unix/ssl_io_real.ml +++ b/lwt-unix/ssl_io_real.ml @@ -126,7 +126,8 @@ let make_client ?client socket = Ssl.honor_cipher_order client_ctx; Lwt_ssl.ssl_connect socket client_ctx -(* TODO: this needs error handling or it'll crash the server *) +(* This function does not perform error handling and will therefore crash a + * server in case e.g. the handshake fails. *) let make_server ?server ?certfile ?keyfile socket = match server, certfile, keyfile with | Some server, _, _ -> @@ -135,11 +136,17 @@ let make_server ?server ?certfile ?keyfile socket = let server_ctx = Ssl.create_context Ssl.TLSv1_3 Ssl.Server_context in Ssl.disable_protocols server_ctx [ Ssl.SSLv23 ]; Ssl.use_certificate server_ctx cert priv_key; - (* let rec first_match l1 = function | [] -> None | x::_ when List.mem x l1 - -> Some x | _::xs -> first_match l1 xs in *) + let rec first_match l1 = function + | [] -> + None + | x :: _ when List.mem x l1 -> + Some x + | _ :: xs -> + first_match l1 xs + in Ssl.set_context_alpn_protos server_ctx [ "h2" ]; - (* Ssl.set_context_alpn_select_callback server_ctx (fun client_protos -> - first_match client_protos ["h2"] ); *) + Ssl.set_context_alpn_select_callback server_ctx (fun client_protos -> + first_match client_protos [ "h2" ]); Lwt_ssl.ssl_accept socket server_ctx | _ -> Lwt.fail diff --git a/lwt-unix/tls_io_dummy.ml b/lwt-unix/tls_io_dummy.ml index c942ec1e..eee532b7 100644 --- a/lwt-unix/tls_io_dummy.ml +++ b/lwt-unix/tls_io_dummy.ml @@ -57,7 +57,10 @@ type client = nothing type server = nothing -let make_client ?client:_ _socket = Lwt.return `Tls_not_available +let[@ocaml.warning "-21"] make_client ?client:_ = + failwith "TLS not available"; + fun _socket -> Lwt.return `Tls_not_available -let make_server ?server:_ ?certfile:_ ?keyfile:_ _socket = - Lwt.return `Tls_not_available +let[@ocaml.warning "-21"] make_server ?server:_ ?certfile:_ ?keyfile:_ = + failwith "TLS not available"; + fun _socket -> Lwt.fail_with "TLS not available" diff --git a/lwt-unix/tls_io_real.ml b/lwt-unix/tls_io_real.ml index 93186a24..a7fa3113 100644 --- a/lwt-unix/tls_io_real.ml +++ b/lwt-unix/tls_io_real.ml @@ -120,6 +120,8 @@ let make_client ?client socket = in Tls_lwt.Unix.client_of_fd config socket +(* This function does not perform error handling and will therefore crash a + * server in case e.g. the handshake fails. *) let make_server ?server ?certfile ?keyfile socket = let server = match server, certfile, keyfile with