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 ())