cert-service/bin/cert_service_server.ml

60 lines
1.9 KiB
OCaml
Raw Normal View History

2020-12-09 19:28:07 +00:00
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 = "de1.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 ())