Merge pull request #356 from hannesm/fix-name-key-of-to-string

Provide Dns.Dnskey.to_string and Dns.Dnskey.name_key_to_string

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

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

src/dns.ml

@@ -900,6 +900,10 @@ module Dnskey = struct
     | [ algo ; key ] -> parse algo key
     | _ -> Error (`Msg ("invalid DNSKEY string " ^ key))
 
+  let to_string key =
+    let algo = algorithm_to_string key.algorithm in
+    algo ^ ":" ^ key.key
+
   let name_key_of_string str =
     match String.split_on_char ':' str with
     | name :: key ->
@@ -908,8 +912,8 @@ module Dnskey = struct
       Ok (name, dnskey)
     | [] -> Error (`Msg ("couldn't parse name:key in " ^ str))
 
-  let pp_name_key ppf (name, key) =
-    Fmt.pf ppf "%a %a" Domain_name.pp name pp key
+  let name_key_to_string (name, key) =
+    Domain_name.to_string name ^ ":" ^ to_string key
 end
 
 (** RRSIG *)

src/dns.mli

@@ -361,15 +361,20 @@ module Dnskey : sig
 
   val of_string : string -> (t, [> `Msg of string ]) result
   (** [of_string str] attempts to parse [str] to a dnskey. The colon character
-      ([:]) is used as separator, supported format is: [algo:keydata] where
-      keydata is a base64 string. *)
+      ([:]) is used as separator, supported format is: [algorithm:keydata].
+      Flags are not supported. *)
+
+  val to_string : t -> string
+  (** [to_string key] is a string where the colon character ([:]) is used as
+      separator. The output is [algorithm:keydata]. Flags are not supported. *)
 
   val name_key_of_string : string -> ([ `raw ] Domain_name.t * t, [> `Msg of string ]) result
   (** [name_key_of_string str] attempts to parse [str] to a domain name and a
       dnskey. The colon character ([:]) is used as separator. *)
 
-  val pp_name_key : ([ `raw ] Domain_name.t * t) Fmt.t
-  (** [pp_name_key (name, key)] pretty-prints the dnskey and name pair. *)
+  val name_key_to_string : [ `raw ] Domain_name.t * t -> string
+  (** [name_key_to_string (name, key)] is a string [name:algorithm:keydata].
+      The colon character ([:]) is used as separater. *)
 
   val digest_prep : [ `raw ] Domain_name.t -> t -> string
   (** [digest_prep name key] encodes name and key into a buffer, as preparation
@@ -794,7 +799,7 @@ end
 (** Loc
 
     A locator record (LOC) is used to express location information associated with domain.
-    
+
     See RFC 1876. *)
 module Loc : sig
   type t = {

test/tests.ml

@@ -2408,6 +2408,29 @@ ff 6b 3d 72 73 61 3b 20 70 3d 4d 49 49 42 49 6a
     in
     loc_encode_helper loc
 
+  let dnskey_t = Alcotest.testable Dnskey.pp (fun a b -> Dnskey.compare a b = 0)
+
+  let domain_name_t = Alcotest.testable Domain_name.pp Domain_name.equal
+
+  let name_key_t =
+    Alcotest.pair domain_name_t dnskey_t
+
+  let err_t =
+    Alcotest.testable
+      (fun ppf (`Msg m) -> Fmt.string ppf m)
+      (fun _ _ -> true)
+
+  let dnskey_name_to_of_string () =
+    let name = n_of_s "example.com" in
+    let keydata = "abcd" in
+    let key = Dnskey.{ flags = F.empty ; algorithm = SHA256 ; key = keydata } in
+    let keydata = Domain_name.to_string name ^ ":SHA256:" ^ keydata in
+    Alcotest.(check string "dnskey name_key_to_string is good" keydata
+                (Dnskey.name_key_to_string (name, key)));
+    Alcotest.(check (result name_key_t err_t)
+                "dnskey name_key_of_string is good" (Ok (name, key))
+                (Dnskey.name_key_of_string keydata))
+
   let code_tests = [
     "bad query", `Quick, bad_query ;
     "regression0", `Quick, regression0 ;
@@ -2487,6 +2510,7 @@ ff 6b 3d 72 73 61 3b 20 70 3d 4d 49 49 42 49 6a
     "loc encode min negated", `Quick, loc_encode_min_negated ;
     "loc encode max", `Quick, loc_encode_max ;
     "loc encode max inverted", `Quick, loc_encode_max_inverted ;
+    "dnskey to/of_string", `Quick, dnskey_name_to_of_string ;
   ]
 end