Merge pull request #418 from psafont/dummy-ctx

conduit-lwt-unix: do not use directly the Ssl module
mirage · Dec 15, 2022 · b3c60ca · b3c60ca
2 parents 4282d74 + d685010
commit b3c60ca
Show file tree

Hide file tree

Showing 6 changed files with 19 additions and 8 deletions.
diff --git a/src/conduit-lwt-unix/conduit_lwt_unix.ml b/src/conduit-lwt-unix/conduit_lwt_unix.ml
@@ -109,7 +109,7 @@ type ctx = {
   tls_own_key : tls_own_key;
   tls_authenticator : Conduit_lwt_tls.X509.authenticator;
   ssl_client_verify : Conduit_lwt_unix_ssl.Client.verify;
-  ssl_ctx : Ssl.context;
+  ssl_ctx : Conduit_lwt_unix_ssl.Client.context;
 }
 
 let string_of_unix_sockaddr sa =

diff --git a/src/conduit-lwt-unix/conduit_lwt_unix.mli b/src/conduit-lwt-unix/conduit_lwt_unix.mli
@@ -161,7 +161,7 @@ val init :
   ?src:string ->
   ?tls_own_key:tls_own_key ->
   ?tls_authenticator:Conduit_lwt_tls.X509.authenticator ->
-  ?ssl_ctx:Ssl.context ->
+  ?ssl_ctx:Conduit_lwt_unix_ssl.Client.context ->
   ?ssl_client_verify:Conduit_lwt_unix_ssl.Client.verify ->
   unit ->
   ctx io

diff --git a/src/conduit-lwt-unix/conduit_lwt_unix_ssl.dummy.ml b/src/conduit-lwt-unix/conduit_lwt_unix_ssl.dummy.ml
@@ -19,7 +19,10 @@ module Client = struct
   type verify = { hostname : bool; ip : bool }
 
   let default_verify = { hostname = true; ip = true }
-  let default_ctx = `Ssl_not_available
+
+  type context = Ssl_not_available
+
+  let default_ctx = Ssl_not_available
   let create_ctx ?certfile:_ ?keyfile:_ ?password:_ () = default_ctx
 
   let connect ?(ctx = default_ctx) ?src:_ ?hostname:_ ?ip:_ ?verify:_ _sa =

diff --git a/src/conduit-lwt-unix/conduit_lwt_unix_ssl.dummy.mli b/src/conduit-lwt-unix/conduit_lwt_unix_ssl.dummy.mli
@@ -21,17 +21,20 @@ module Client : sig
   type verify = { hostname : bool; ip : bool }
 
   val default_verify : verify
-  val default_ctx : [ `Ssl_not_available ]
+
+  type context = Ssl_not_available
+
+  val default_ctx : context
 
   val create_ctx :
     ?certfile:string ->
     ?keyfile:string ->
     ?password:(bool -> string) ->
     unit ->
-    [ `Ssl_not_available ]
+    context
 
   val connect :
-    ?ctx:[ `Ssl_not_available ] ->
+    ?ctx:context ->
     ?src:Lwt_unix.sockaddr ->
     ?hostname:string ->
     ?ip:Ipaddr.t ->

diff --git a/src/conduit-lwt-unix/conduit_lwt_unix_ssl.real.ml b/src/conduit-lwt-unix/conduit_lwt_unix_ssl.real.ml
@@ -35,6 +35,8 @@ let chans_of_fd sock =
   (Lwt_ssl.get_fd sock, ic, oc)
 
 module Client = struct
+  type context = Ssl.context
+
   let create_ctx ?certfile ?keyfile ?password () =
     let ctx = Ssl.create_context Ssl.SSLv23 Ssl.Client_context in
     Ssl.disable_protocols ctx [ Ssl.SSLv23 ];

diff --git a/src/conduit-lwt-unix/conduit_lwt_unix_ssl.real.mli b/src/conduit-lwt-unix/conduit_lwt_unix_ssl.real.mli
@@ -21,7 +21,10 @@ module Client : sig
   type verify = { hostname : bool; ip : bool }
 
   val default_verify : verify
-  val default_ctx : Ssl.context
+
+  type context = Ssl.context
+
+  val default_ctx : context
 
   val create_ctx :
     ?certfile:string ->
@@ -31,7 +34,7 @@ module Client : sig
     Ssl.context
 
   val connect :
-    ?ctx:Ssl.context ->
+    ?ctx:context ->
     ?src:Lwt_unix.sockaddr ->
     ?hostname:string ->
     ?ip:Ipaddr.t ->