From 87039eae84727955b4db3e32af140aee1fc3446c Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Tue, 22 Oct 2024 12:21:35 +0200 Subject: [PATCH] Dns_certify_mirage.retrieve_certificate: use separate dns_key_name and dns_key Avoid the string decoding within this function --- mirage/certify/dns_certify_mirage.ml | 12 +++--------- mirage/certify/dns_certify_mirage.mli | 7 ++++--- 2 files changed, 7 insertions(+), 12 deletions(-) diff --git a/mirage/certify/dns_certify_mirage.ml b/mirage/certify/dns_certify_mirage.ml index ce43f872..95ac2e49 100644 --- a/mirage/certify/dns_certify_mirage.ml +++ b/mirage/certify/dns_certify_mirage.ml @@ -73,14 +73,8 @@ module Make (R : Mirage_crypto_rng_mirage.S) (P : Mirage_clock.PCLOCK) (TIME : M in wait_for_cert () - let retrieve_certificate stack ~dns_key ~hostname ?(additional_hostnames = []) ?(key_type = `RSA) ?key_data ?key_seed ?bits dns port = - let keyname, zone, dnskey = - match Dns.Dnskey.name_key_of_string dns_key with - | Ok (name, key) -> - let zone = Domain_name.(host_exn (drop_label_exn ~amount:2 name)) in - (name, zone, key) - | Error (`Msg m) -> invalid_arg ("failed to parse dnskey: " ^ m) - in + let retrieve_certificate stack ~dns_key_name dns_key ~hostname ?(additional_hostnames = []) ?(key_type = `RSA) ?key_data ?key_seed ?bits dns port = + let zone = Domain_name.(host_exn (drop_label_exn ~amount:2 dns_key_name)) in let not_sub subdomain = not (Domain_name.is_subdomain ~subdomain ~domain:zone) in if not_sub hostname then invalid_arg "hostname not a subdomain of zone provided by dns_key" @@ -109,7 +103,7 @@ module Make (R : Mirage_crypto_rng_mirage.S) (P : Mirage_clock.PCLOCK) (TIME : M Lwt.return (Error (`Msg "couldn't connect to name server")) | Ok flow -> let flow = D.of_flow flow in - query_certificate_or_csr flow hostname keyname zone dnskey csr >>= fun certificate -> + query_certificate_or_csr flow hostname dns_key_name zone dns_key csr >>= fun certificate -> S.TCP.close (D.flow flow) >|= fun () -> match certificate with | Error e -> Error e diff --git a/mirage/certify/dns_certify_mirage.mli b/mirage/certify/dns_certify_mirage.mli index 27019c04..59770ecd 100644 --- a/mirage/certify/dns_certify_mirage.mli +++ b/mirage/certify/dns_certify_mirage.mli @@ -2,16 +2,17 @@ module Make (R : Mirage_crypto_rng_mirage.S) (P : Mirage_clock.PCLOCK) (T : Mirage_time.S) (S : Tcpip.Stack.V4V6) : sig val retrieve_certificate : - S.t -> dns_key:string -> hostname:[ `host ] Domain_name.t -> + S.t -> dns_key_name:[`raw ] Domain_name.t -> Dns.Dnskey.t -> + hostname:[ `host ] Domain_name.t -> ?additional_hostnames:[ `raw ] Domain_name.t list -> ?key_type:X509.Key_type.t -> ?key_data:string -> ?key_seed:string -> ?bits:int -> S.TCP.ipaddr -> int -> (X509.Certificate.t list * X509.Private_key.t, [ `Msg of string ]) result Lwt.t - (** [retrieve_certificate stack ~dns_key ~hostname ~key_type ~key_data ~key_seed ~bits server_ip port] + (** [retrieve_certificate stack ~dns_key_name dns_key ~hostname ~key_type ~key_data ~key_seed ~bits server_ip port] generates a private key (using [key_type], [key_data], [key_seed], and [bits]), a certificate signing request for the given [hostname] and [additional_hostnames], and sends [server_ip] an nsupdate (DNS-TSIG with - [dns_key]) with the csr as TLSA record, awaiting for a matching + [dns_key_name] and [dns_key]) with the csr as TLSA record, awaiting for a matching certificate as TLSA record. Requires a service that interacts with let's encrypt to transform the CSR into a signed certificate. If something fails, an exception (via [Lwt.fail]) is raised. This is meant for