ocaml-rpc/unix/vat_config.ml

let docs = "CAP'N PROTO OPTIONS"

module Auth = Capnp_rpc_net.Auth
module Log = Capnp_rpc.Debug.Log

module Listen_address = struct
  include Network.Location

  open Cmdliner

  let cmd =
    let i = Arg.info ~docs ["capnp-listen-address"] ~docv:"ADDR" ~doc:"Address to listen on, e.g. $(b,unix:/run/my.socket)." in
    Arg.(required @@ opt (some cmdliner_conv) None i)
end

module Secret_hash : sig
  type t

  val of_pem_data : string -> t
  val to_string : t -> string
end = struct
  type t = string

  let of_pem_data data = Digestif.SHA256.digest_string data |> Digestif.SHA256.to_raw_string
  let to_string x = x
end

type t = {
  net : Network.t;
  backlog : int;
  secret_key : (Auth.Secret_key.t * Secret_hash.t) Lazy.t;
  serve_tls : bool;
  listen_address : Listen_address.t;
  public_address : Network.Location.t;
}

let secret_key t = fst @@ Lazy.force t.secret_key

let hashed_secret t = Secret_hash.to_string @@ snd @@ Lazy.force t.secret_key

let secret_key_file =
  let open Cmdliner in
  let i = Arg.info ~docs ["capnp-secret-key-file"] ~docv:"PATH"
      ~doc:"File in which to store secret key (or \"\" for an ephemeral key)." in
  Arg.(required @@ opt (some string) None i)

let init_secret_key_file key_file =
  if Eio.Path.is_file key_file then (
    Log.info (fun f -> f "Restoring saved secret key from existing file %a" Eio.Path.pp key_file);
    let data = Eio.Path.load key_file in
    (Auth.Secret_key.of_pem_data data, Secret_hash.of_pem_data data)
  ) else (
    Log.info (fun f -> f "Generating new secret key to store in %a" Eio.Path.pp key_file);
    let secret_key = Auth.Secret_key.generate () in
    let data = Auth.Secret_key.to_pem_data secret_key in
    Eio.Path.save ~create:(`Exclusive 0o600) key_file data;
    (secret_key, Secret_hash.of_pem_data data)
  )

let create ?(backlog=5) ?public_address ~secret_key ?(serve_tls=true) ~net listen_address =
  let public_address =
    match public_address with
    | Some x -> x
    | None -> listen_address
  in
  Network.Location.validate_public public_address;
  let secret_key = lazy (
    match secret_key with
    | `File path -> init_secret_key_file path
    | `PEM data -> (Auth.Secret_key.of_pem_data data, Secret_hash.of_pem_data data)
    | `Ephemeral ->
      let key = Auth.Secret_key.generate () in
      let data = Auth.Secret_key.to_pem_data key in
      (key, Secret_hash.of_pem_data data)
  ) in
  let net = Network.v net in
  { net; backlog; secret_key; serve_tls; listen_address; public_address }

let secret_key_term fs =
  let ( / ) = Eio.Path.( / ) in
  let get = function
    | "" -> `Ephemeral
    | path -> `File (fs / path)
  in
  Cmdliner.Term.(const get $ secret_key_file)

let derived_id t name =
  let secret = hashed_secret t in
  Capnp_rpc_net.Restorer.Id.derived ~secret name

let auth t =
  if t.serve_tls then Capnp_rpc_net.Auth.Secret_key.digest (secret_key t)
  else Capnp_rpc_net.Auth.Digest.insecure

let sturdy_uri t service =
  let address = (t.public_address, auth t) in
  Network.Address.to_uri (address, Capnp_rpc_net.Restorer.Id.to_string service)

type 'a env = 'a constraint 'a = <
    net : _ Eio.Net.t;
    fs : _ Eio.Path.t;
    ..
  > as 'a

open Cmdliner

let pp f {backlog; secret_key; serve_tls; listen_address; public_address; net = _} =
  Fmt.pf f "{backlog=%d; fingerprint=%a; serve_tls=%b; listen_address=%a; public_address=%a}"
    backlog
    (Auth.Secret_key.pp_fingerprint `SHA256) (fst @@ Lazy.force secret_key)
    serve_tls
    Listen_address.pp listen_address
    Network.Location.pp public_address

let equal {backlog; secret_key; serve_tls; listen_address; public_address; net} b =
  net == b.net &&
  backlog = b.backlog &&
  serve_tls = serve_tls &&
  Listen_address.equal listen_address b.listen_address &&
  Network.Location.equal public_address b.public_address &&
  Auth.Secret_key.equal (fst @@ Lazy.force secret_key) (fst @@ Lazy.force b.secret_key)

let public_address =
  let i = Arg.info ~docs ["capnp-public-address"] ~docv:"ADDR" ~doc:"Address to tell others to connect on." in
  Arg.(value @@ opt (some Network.Location.cmdliner_conv) None i)

let disable_tls =
  let i = Arg.info ~docs ["capnp-disable-tls"] ~doc:"Do not use TLS for incoming connections." in
  Arg.(value @@ flag i)

let cmd env =
  let make secret_key disable_tls listen_address public_address =
    let public_address =
      match public_address with
      | None -> listen_address
      | Some x -> x
    in
    create ~net:env#net ~secret_key ~serve_tls:(not disable_tls) ~public_address listen_address
  in
  Term.(const make $ secret_key_term env#fs $ disable_tls $ Listen_address.cmd $ public_address)