cert-service/lib/cert_service.ml

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