unikernel/duniverse/ocaml-tls/async/examples/dune

@@ -0,0 +1,15 @@
+(executable
+  (name    test_client)
+  (modules test_client)
+  (public_name tls-test-client)
+  (package tls-async)
+  (preprocess (pps ppx_jane))
+  (libraries async core core_unix.command_unix tls-async))
+
+(executable
+  (name    test_server)
+  (modules test_server)
+  (public_name tls-test-server)
+  (package tls-async)
+  (preprocess (pps ppx_jane))
+  (libraries async core core_unix.command_unix tls-async))

unikernel/duniverse/ocaml-tls/async/examples/test_client.ml

@@ -0,0 +1,34 @@
+open! Core
+open! Async
+open Deferred.Or_error.Let_syntax
+
+let config = match Tls.Config.client ~authenticator:(fun ?ip:_ ~host:_ _ -> Ok None) () with
+  | Ok cfg -> cfg
+  | Error `Msg msg -> invalid_arg msg
+
+let test_client () =
+  let host = "127.0.0.1" in
+  let port = 8443 in
+  let hnp = Host_and_port.create ~host ~port in
+  let%bind (_ : Tls_async.Session.t), rd, wr =
+    (* we can't build a [[ `host ] Domain_name.t] from an IP address *)
+    let host = None in
+    Tls_async.connect config (Tcp.Where_to_connect.of_host_and_port hnp) ~host
+  in
+  let req =
+    String.concat
+      ~sep:"\r\n"
+      [ "GET / HTTP/1.1"; "Host: " ^ host; "Connection: close"; ""; "" ]
+  in
+  Writer.write wr req;
+  let%bind () = Writer.flushed wr |> Deferred.ok in
+  let%bind () =
+    match%map Reader.read_line rd |> Deferred.ok with
+    | `Ok str -> print_endline str
+    | `Eof -> print_endline "Eof reached"
+  in
+  Writer.close wr |> Deferred.ok
+;;
+
+let cmd = Command.async_or_error ~summary:"test client" (Command.Param.return test_client)
+let () = Command_unix.run cmd

unikernel/duniverse/ocaml-tls/async/examples/test_server.ml

@@ -0,0 +1,64 @@
+open! Core
+open! Async
+
+let server_cert = "./certificates/server.pem"
+let server_key = "./certificates/server.key"
+
+let serve_tls ~low_level port handler =
+  let%bind certificate =
+    Tls_async.X509_async.Certificate.of_pem_file server_cert |> Deferred.Or_error.ok_exn
+  in
+  let%bind priv_key =
+    Tls_async.X509_async.Private_key.of_pem_file server_key |> Deferred.Or_error.ok_exn
+  in
+  let config =
+    match Tls.Config.(
+        server
+          ~version:(`TLS_1_0, `TLS_1_2)
+          ~certificates:(`Single (certificate, priv_key))
+          ~ciphers:Ciphers.supported
+          ())
+    with
+    | Ok cfg -> cfg
+    | Error `Msg msg -> invalid_arg msg
+  in
+  let where_to_listen = Tcp.Where_to_listen.of_port port in
+  let on_handler_error = `Ignore in
+  if low_level then
+    Tcp.Server.create
+      ~on_handler_error
+      where_to_listen
+      (fun sa ->
+        printf !"connection establised from %{Socket.Address.Inet} starting TLS\n" sa;
+        Tls_async.upgrade_server_handler ~config (handler sa))
+  else
+    Tls_async.listen ~on_handler_error config where_to_listen handler
+;;
+
+let test_server ~low_level port =
+  let handler (_ : Socket.Address.Inet.t) (_ : Tls_async.Session.t) rd wr =
+    let pipe = Reader.pipe rd in
+    let rec read_from_pipe () =
+      (match%map Pipe.read pipe with
+       | `Ok line -> Writer.write wr line
+       | `Eof -> ())
+      >>= read_from_pipe
+    in
+    read_from_pipe ()
+  in
+  serve_tls ~low_level port handler
+;;
+
+let cmd =
+  let open Command.Let_syntax in
+  Command.async
+    ~summary:"test server"
+    (let%map_open port = anon ("PORT" %: int)
+    and low_level = flag "-low-level" no_arg ~doc:"set up Tcp.server directly" in
+     fun () ->
+       let open Deferred.Let_syntax in
+       let%bind server = test_server ~low_level port in
+       Tcp.Server.close_finished server)
+;;
+
+let () = Command_unix.run cmd