Merge pull request #414 from hannesm/pass-peer

conduit-mirage: pass peer name to Tls.Config.client
mirage · Jul 4, 2022 · de4d624 · de4d624
2 parents c78a719 + 55f06c8
commit de4d624
Show file tree

Hide file tree

Showing 6 changed files with 13 additions and 11 deletions.
diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml
@@ -6,7 +6,7 @@ jobs:
     runs-on: ${{ matrix.operating-system }}
     strategy:
       matrix:
-        ocaml-version: [ '4.08.1', '4.09.0', '4.10.0', '4.11.1' ]
+        ocaml-version: [ '4.11.2', '4.12.1', '4.13.1', '4.14.0' ]
         operating-system: [ ubuntu-latest ]
     steps:
     - uses: actions/checkout@v2

diff --git a/conduit-async.opam b/conduit-async.opam
@@ -10,13 +10,13 @@ bug-reports: "https://github.com/mirage/ocaml-conduit/issues"
 depends: [
   "ocaml" {>= "4.03.0"}
   "dune" {>= "2.0"}
-  "core"
+  "core" {>= "v0.15.0"}
   "uri" {>= "4.0.0"}
   "ppx_here" {>= "v0.9.0"}
   "ppx_sexp_conv" {>="v0.13.0"}
   "sexplib"
   "conduit" {=version}
-  "async" {>= "v0.10.0"}
+  "async" {>= "v0.15.0"}
   "ipaddr" {>= "3.0.0"}
   "ipaddr-sexp" {>= "4.0.0"}
 ]

diff --git a/src/conduit-mirage/conduit_mirage.ml b/src/conduit-mirage/conduit_mirage.ml
@@ -144,7 +144,12 @@ end
 
 (* TLS *)
 
-let tls_client ~authenticator x = `TLS (Tls.Config.client ~authenticator (), x)
+let tls_client ~host ~authenticator x =
+  let peer_name =
+    Result.to_option (Result.bind (Domain_name.of_string host) Domain_name.host)
+  in
+  `TLS (Tls.Config.client ?peer_name ~authenticator (), x)
+
 let tls_server ?authenticator x = `TLS (Tls.Config.server ?authenticator (), x)
 
 module TLS (S : S) = struct
@@ -235,9 +240,9 @@ module Endpoint (P : Mirage_clock.PCLOCK) = struct
     | `TCP (x, y) -> tcp_client x y
     | `Unix_domain_socket _ -> err_domain_sockets_not_supported "client"
     | (`Vchan_direct _ | `Vchan_domain_socket _) as x -> vchan_client x
-    | `TLS (_host, y) ->
+    | `TLS (host, y) ->
         client ~tls_authenticator y
-        >|= tls_client ~authenticator:tls_authenticator
+        >|= tls_client ~host ~authenticator:tls_authenticator
     | `Unknown s -> err_unknown s
 
   let rec server ?tls_authenticator e =

diff --git a/tests/conduit-async/build.sh b/tests/conduit-async/build.sh
diff --git a/tests/conduit-async/dune b/tests/conduit-async/dune
@@ -1,5 +1,5 @@
 (executable
- (libraries async conduit-async)
+ (libraries async core_unix.command_unix conduit-async)
  (name ssl_echo))
 
 (rule

diff --git a/tests/conduit-async/ssl_echo.ml b/tests/conduit-async/ssl_echo.ml
@@ -54,4 +54,4 @@ let () =
       +> flag "-cert-file" (optional string) ~doc:"file Certificate file"
       +> flag "-key-file" (optional string) ~doc:"File Private key file")
     start_server
-  |> Command.run
+  |> Command_unix.run