albatross/tls/albatross_tls_inetd.ml

33 lines
1,001 B
OCaml
Raw Normal View History

2018-11-23 19:28:33 +00:00
(* (c) 2018 Hannes Mehnert, all rights reserved *)
open Lwt.Infix
2019-03-27 23:11:43 +00:00
open Albatross_tls_common
2018-11-23 19:28:33 +00:00
let jump cacert cert priv_key tmpdir =
2018-11-23 19:28:33 +00:00
Sys.(set_signal sigpipe Signal_ignore) ;
2020-03-13 15:24:52 +00:00
Mirage_crypto_rng_unix.initialize ();
Albatross_cli.set_tmpdir tmpdir;
2018-11-23 19:28:33 +00:00
Lwt_main.run
(tls_config cacert cert priv_key >>= fun config ->
2018-11-23 19:28:33 +00:00
let fd = Lwt_unix.of_unix_file_descr Unix.stdin in
Lwt.catch
(fun () -> Tls_lwt.Unix.server_of_fd config fd)
(fun exn ->
Vmm_lwt.safe_close fd >>= fun () ->
Lwt.fail exn) >>= fun t ->
Lwt.catch
(fun () ->
handle t >>= fun () ->
2018-11-23 19:28:33 +00:00
Vmm_tls_lwt.close t)
(fun e ->
Logs.err (fun m -> m "error while handle() %s" (Printexc.to_string e)) ;
Vmm_tls_lwt.close t))
2018-11-23 19:28:33 +00:00
open Cmdliner
let cmd =
Term.(const jump $ cacert $ cert $ key $ Albatross_cli.tmpdir),
Term.info "albatross_tls_inetd" ~version:Albatross_cli.version
2018-11-23 19:28:33 +00:00
let () = match Term.eval cmd with `Ok () -> exit 0 | _ -> exit 1