Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Enable certificate validation in the Lwt unix SSL backend #291

Merged
merged 1 commit into from
Jul 15, 2019
Merged
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
14 changes: 11 additions & 3 deletions lwt-unix/conduit_lwt_unix_ssl_real.ml
Original file line number Diff line number Diff line change
Expand Up @@ -29,7 +29,12 @@ let chans_of_fd sock =
module Client = struct
(* SSL TCP connection *)
let default_ctx = Ssl.create_context Ssl.SSLv23 Ssl.Client_context
let () = Ssl.disable_protocols default_ctx [Ssl.SSLv23]
let () =
Ssl.disable_protocols default_ctx [Ssl.SSLv23];
(* Use default CA certificates *)
ignore (Ssl.set_default_verify_paths default_ctx);
(* Enable peer verification *)
Ssl.set_verify default_ctx [Ssl.Verify_peer] None

let connect ?(ctx=default_ctx) ?src ?hostname sa =
Conduit_lwt_server.with_socket sa (fun fd ->
Expand All @@ -41,8 +46,11 @@ module Client = struct
begin match hostname with
| Some host ->
let s = Lwt_ssl.embed_uninitialized_socket fd ctx in
Ssl.set_client_SNI_hostname
(Lwt_ssl.ssl_socket_of_uninitialized_socket s) host;
let ssl = Lwt_ssl.ssl_socket_of_uninitialized_socket s in
Ssl.set_client_SNI_hostname ssl host;
(* Enable hostname verification *)
Ssl.set_hostflags ssl [Ssl.No_partial_wildcards];
Ssl.set_host ssl host;
Lwt_ssl.ssl_perform_handshake s
| None ->
Lwt_ssl.ssl_connect fd ctx
Expand Down