61 lines
1.9 KiB
OCaml
61 lines
1.9 KiB
OCaml
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 =
|
|
Result.bind
|
|
(Bos.OS.File.read f)
|
|
(fun s -> X509.Certificate.decode_pem (Cstruct.of_string s))
|
|
|
|
let load_cakey f =
|
|
Result.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 = Result.get_ok (load_cacert (Fpath.v cacert_path)) in
|
|
let cakey = Result.get_ok (load_cakey (Fpath.v cakey_path)) in
|
|
let t = { Cert_service.host = "hashbang.sh";
|
|
organization = "HashBang"; 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 ())
|