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

@@ -0,0 +1,47 @@
+
+open Lwt
+open Ex_common
+
+let serve_ssl port callback =
+
+  let tag = "server" in
+
+  X509_lwt.private_of_pems
+    ~cert:server_cert
+    ~priv_key:server_key >>= fun certificate ->
+  X509_lwt.private_of_pems
+    ~cert:server_ec_cert
+    ~priv_key:server_ec_key >>= fun ec_certificate ->
+  let certificates = `Multiple [ certificate ; ec_certificate ] in
+  let config =
+    get_ok (Tls.Config.(server ~version:(`TLS_1_0, `TLS_1_3) ~certificates ~ciphers:Ciphers.supported ()))
+  in
+
+  let server_s =
+    let open Lwt_unix in
+    let s = socket PF_INET SOCK_STREAM 0 in
+    setsockopt s Unix.SO_REUSEADDR true ;
+    bind s (ADDR_INET (Unix.inet_addr_any, port)) >|= fun () ->
+    listen s 10 ;
+    s in
+
+  yap ~tag ("-> start @ " ^ string_of_int port) >>= fun () ->
+  server_s >>= fun s ->
+  Tls_lwt.Unix.accept config s >>= fun (t, addr) ->
+  let channels = Tls_lwt.of_t t in
+  yap ~tag "-> connect" >>= fun () ->
+  callback channels addr >>= fun () ->
+  yap ~tag "<- handler done"
+
+let test_server port =
+  serve_ssl port @@ fun (ic, oc) _addr ->
+    yap ~tag:"handler" "accepted" >>= fun () ->
+    Lwt_io.read_line ic >>= fun line ->
+    yap ~tag:"handler" ("+ " ^ line) >>= fun () ->
+    Lwt_io.write_line oc line
+
+let () =
+  let port =
+    try int_of_string Sys.argv.(1) with _ -> 4433
+  in
+  Lwt_main.run (test_server port)