cert-service/bin/cert_service_server.ml

open Lwt.Syntax

let sock_path = "/home/reynir/cert.sock"
let cacert_path = "/home/reynir/CA/cert.pem"
let cakey_path = "/home/reynir/CA/key.pem"

let handler t _sockaddr fd =
  let _pid, _gid, uid = ExtUnix.Specific.read_credentials
      (Lwt_unix.unix_file_descr fd) in
  let pwentry = Unix.getpwuid uid in
  let* () = Lwt_io.printf "Connect by %s\n" pwentry.pw_name in
  let* w = Cert_service.Wire_lwt.read_wire fd in
  match w with
  | Ok ({ version = `V1 }, `Failure _)
  | Ok ({ version = `V1 }, `Sign _)
  | Error _ ->
    Lwt.return_unit
  | Ok ({ version = `V1 }, `Command (`Sign_request csr)) ->
    match Cert_service.sign t csr pwentry.pw_name with
    | Ok cert ->
      let+ _ = Cert_service.Wire_lwt.write_wire fd ({ version = `V1 }, (`Sign cert)) in
      ()
    | Error (`Msg e) ->
      let+ _ = Cert_service.Wire_lwt.write_wire fd ({ version = `V1 }, (`Failure e)) in
      ()

let load_cacert f =
  Rresult.R.bind
    (Bos.OS.File.read f)
    (fun s -> X509.Certificate.decode_pem (Cstruct.of_string s))

let load_cakey f =
  Rresult.R.bind
    (Bos.OS.File.read f)
    (fun s -> X509.Private_key.decode_pem (Cstruct.of_string s))

let main () =
  Mirage_crypto_rng_lwt.initialize ();
  let cacert = Rresult.R.get_ok (load_cacert (Fpath.v cacert_path)) in
  let cakey = Rresult.R.get_ok (load_cakey (Fpath.v cakey_path)) in
  let t = { Cert_service.host = "hashbang.sh"; cacert; cakey } in
  let server_fd = Lwt_unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in
  let old_umask = Unix.umask 0o011 in
  let () = try Unix.unlink sock_path
    with Unix.Unix_error (Unix.ENOENT, _, _) -> () in
  let* _server =
    Lwt_io.establish_server_with_client_socket
      ~server_fd
      (Unix.ADDR_UNIX sock_path)
      (handler t)
  in
  Lwt_main.at_exit (fun () ->
      Lwt_unix.unlink sock_path);
  let _ = Unix.umask old_umask in
  let forever, _ = Lwt.wait () in
  forever


let () = Lwt_main.run (main ())