module Commands = Wire_commands module Wire_lwt = Wire_lwt let wire_of_cstruct = Wire_asn.wire_of_cstruct let wire_to_cstruct = Wire_asn.wire_to_cstruct type t = { host : string; organization : string; cacert : X509.Certificate.t; cakey : X509.Private_key.t; } let ( >>= ) = Result.bind let check_csr_dn csr dn = let subject = (X509.Signing_request.info csr).subject in if X509.Distinguished_name.equal dn subject then Ok () else Error (`Msg (Fmt.str "Bad subject in csr: %a" X509.Distinguished_name.pp subject)) let sign t csr user = let subject = [X509.Distinguished_name.( Relative_distinguished_name.singleton (CN user) |> Relative_distinguished_name.add (O t.organization) )] in check_csr_dn csr subject >>= fun () -> let issuer = X509.Certificate.subject t.cacert in let email = Printf.sprintf "%s@%s" user t.host in let valid_from = Ptime_clock.now () in let valid_until = Ptime.add_span valid_from (Ptime.Span.of_int_s (Duration.of_day 90 |> Duration.to_sec)) |> Option.get in let extensions = let open X509.Extension in let auth = Some (X509.Public_key.id (X509.Certificate.public_key t.cacert)), X509.General_name.empty, None in X509.Extension.empty |> add Authority_key_id (false, auth) |> add Subject_key_id (false, X509.(Public_key.id (Signing_request.info csr).public_key)) |> add Subject_alt_name (false, X509.General_name.singleton Rfc_822 [email]) |> add Ext_key_usage (true, [`Client_auth]) in X509.Signing_request.sign csr ~valid_from ~valid_until ~extensions t.cakey issuer |> Result.map_error (fun ve -> `Msg (Fmt.str "Signing failed: %a" X509.Validation.pp_signature_error ve))