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

@@ -0,0 +1,55 @@
+
+open Lwt
+
+let o f g x = f (g x)
+
+let ca_cert_dir = "./certificates"
+let server_cert = "./certificates/server.pem"
+let server_key  = "./certificates/server.key"
+let server_ec_cert = "./certificates/server-ec.pem"
+let server_ec_key  = "./certificates/server-ec.key"
+
+let yap ~tag msg = Lwt_io.printf "(%s %s)\n%!" tag msg
+
+let lines ic =
+  Lwt_stream.from @@ fun () ->
+    Lwt_io.read_line_opt ic >>= function
+      | None -> Lwt_io.close ic >>= fun () -> return_none
+      | line -> return line
+
+let print_alert where alert =
+    Printf.eprintf "(TLS ALERT (%s): %s)\n%!"
+      where (Tls.Packet.alert_type_to_string alert)
+
+let print_fail where fail =
+  Printf.eprintf "(TLS FAIL (%s): %s)\n%!"
+    where (Tls.Engine.string_of_failure fail)
+
+let null_auth ?ip:_ ~host:_ _ = Ok None
+
+let auth ?ca ?fp () =
+  match ca with
+  | Some "NONE" when fp = None -> Lwt.return null_auth
+  | _ ->
+    let a = match ca, fp with
+      | None, Some fp  -> `Hex_key_fingerprint (`SHA256, fp)
+      | None, _ -> `Ca_dir ca_cert_dir
+      | Some f, _ -> `Ca_file f
+    in
+    X509_lwt.authenticator a
+
+let setup_log style_renderer level =
+  Fmt_tty.setup_std_outputs ?style_renderer ();
+  Logs.set_level level;
+  Logs.set_reporter (Logs_fmt.reporter ~dst:Format.std_formatter ())
+
+open Cmdliner
+
+let setup_log =
+  Term.(const setup_log
+        $ Fmt_cli.style_renderer ()
+        $ Logs_cli.level ())
+
+let get_ok = function
+  | Ok cfg -> cfg
+  | Error `Msg msg -> invalid_arg msg