Merge pull request #254 from hannesm/next

dns-certify: update to X509 0.13.0 API

app/ocertify.ml

@@ -8,9 +8,12 @@ let find_or_generate_key key_filename keytype keydata seed bits =
     X509.Private_key.decode_pem (Cstruct.of_string data)
   | false ->
     (match keydata with
-     | None -> Ok None
-     | Some s -> Base64.decode s >>| fun s -> Some s) >>= fun key_data ->
-    let key = Dns_certify.generate ?key_seed:seed ~bits ?key_data keytype in
+     | None ->
+       let seed = match seed with None -> None | Some x -> Some (Cstruct.of_string x) in
+       Ok (X509.Private_key.generate ?seed ~bits keytype)
+     | Some s ->
+       Base64.decode s >>= fun s ->
+       X509.Private_key.of_cstruct (Cstruct.of_string s) keytype) >>= fun key ->
     let pem = X509.Private_key.encode_pem key in
     Bos.OS.File.write ~mode:0o600 key_filename (Cstruct.to_string pem) >>= fun () ->
     Ok key
@@ -49,7 +52,7 @@ let jump _ server_ip port hostname more_hostnames dns_key_opt csr key keytype ke
       X509.Signing_request.decode_pem (Cstruct.of_string data)
     | false ->
       find_or_generate_key key_filename keytype keydata seed bits >>= fun key ->
-      let csr = Dns_certify.signing_request hostname ~more_hostnames key in
+      Dns_certify.signing_request hostname ~more_hostnames key >>= fun csr ->
       let pem = X509.Signing_request.encode_pem csr in
       Bos.OS.File.write csr_filename (Cstruct.to_string pem) >>= fun () ->
       Ok csr) >>= fun csr ->
@@ -169,11 +172,7 @@ let keydata =
 
 let keytype =
   let doc = "keytype to generate" in
-  let types = [
-    ("rsa", `RSA) ; ("ed25519", `ED25519) ;
-    ("p256", `P256) ; ("p384", `P384) ; ("p521", `P521)
-  ] in
-  Arg.(value & opt (enum types) `RSA & info [ "type" ] ~doc)
+  Arg.(value & opt (enum X509.Key_type.strings) `RSA & info [ "type" ] ~doc)
 
 let cert =
   let doc = "certificate filename (defaults to hostname.pem)" in

certify/dns_certify.ml

@@ -205,28 +205,3 @@ let query rng now host csr =
         | Error e -> Error (`Bad_reply (e, reply))
     in
     Ok (out, react)
-
-let generate ?key_seed ?(bits = 4096) ?key_data key_type =
-  let g, print =
-    match key_seed with
-    | None -> None, true
-    | Some seed ->
-      let seed = Cstruct.of_string seed in
-      Some Mirage_crypto_rng.(create ~seed (module Fortuna)), false
-  in
-  let rng c = match key_data with
-    | None -> Mirage_crypto_rng.generate ?g c
-    | Some s -> Cstruct.of_string s
-  in
-  let key =
-    match key_type with
-    | `RSA -> `RSA (Mirage_crypto_pk.Rsa.generate ?g ~bits ())
-    | `ED25519 -> `ED25519 (fst (Mirage_crypto_ec.Ed25519.generate ~rng))
-    | `P256 -> `P256 (fst (Mirage_crypto_ec.P256.Dsa.generate ~rng))
-    | `P384 -> `P384 (fst (Mirage_crypto_ec.P384.Dsa.generate ~rng))
-    | `P521 -> `P521 (fst (Mirage_crypto_ec.P521.Dsa.generate ~rng))
-  in
-  (if print then
-     let pem = X509.Private_key.encode_pem key in
-     Log.info (fun m -> m "using private key@.%s" (Cstruct.to_string pem)));
-  key

certify/dns_certify.mli

@@ -2,7 +2,7 @@ open Dns
 
 val signing_request : [`host] Domain_name.t ->
   ?more_hostnames:([`raw] Domain_name.t list) ->
-  X509.Private_key.t -> X509.Signing_request.t
+  X509.Private_key.t -> (X509.Signing_request.t, [> `Msg of string ]) result
 (** [signing_request name ~more_hostnames key] creates a X509 signing request
     where [name] will be the common name in its subject, and if [more_hostnames]
     is provided and non-empty, [name :: more_hostnames] will be the value of a
@@ -91,10 +91,3 @@ val query : (int -> Cstruct.t) -> Ptime.t -> [ `host ] Domain_name.t ->
 (** [query rng now csr] is a [buffer] with a DNS TLSA query for the name of
    [csr], and a function that decodes a given answer, either returning a X.509
    certificate valid [now] and matching [csr], and a CA chain, or an error. *)
-
-val generate : ?key_seed:string -> ?bits:int -> ?key_data:string ->
-  [ `RSA | `ED25519 | `P256 | `P384 | `P521 ] -> X509.Private_key.t
-(** [generate ~key_seed ~bits ~key_data key_type] generates a private key from
-    [key_seed] of the provided [key_type]. If no [key_seed] is provided, random
-    data is used and the PEM-encoded private key is logged. If [key_type] is a
-    EC key and [key_data] is provided, this is used as private key. *)

dns-certify.opam

@@ -15,7 +15,7 @@ depends: [
   "dns-mirage" {= version}
   "randomconv" {>= "0.1.2"}
   "duration" {>= "0.1.2"}
-  "x509" {>= "0.12.0"}
+  "x509" {>= "0.13.0"}
   "lwt" {>= "4.2.1"}
   "mirage-random" {>= "2.0.0"}
   "mirage-time" {>= "2.0.0"}

dns-cli.opam

@@ -19,7 +19,7 @@ depends: [
   "bos" {>= "0.2.0"}
   "cmdliner" {>= "1.0.0"}
   "fpath" {>= "0.7.2"}
-  "x509" {>= "0.10.0"}
+  "x509" {>= "0.13.0"}
   "mirage-crypto" {>= "0.8.0"}
   "mirage-crypto-pk" {>= "0.8.0"}
   "mirage-crypto-rng" {>= "0.8.0"}

mirage/certify/dns_certify_mirage.ml

@@ -83,19 +83,34 @@ module Make (R : Mirage_random.S) (P : Mirage_clock.PCLOCK) (TIME : Mirage_time.
     in
     let not_sub subdomain = not (Domain_name.is_subdomain ~subdomain ~domain:zone) in
     if not_sub hostname then
-      Lwt.fail_with "hostname not a subdomain of zone provided by dns_key"
+      invalid_arg "hostname not a subdomain of zone provided by dns_key"
     else
-      let key = Dns_certify.generate ?key_seed ?bits ?key_data key_type in
-      let csr = Dns_certify.signing_request hostname ~more_hostnames:additional_hostnames key in
-      S.TCP.create_connection (S.tcp stack) (dns, port) >>= function
-      | Error e ->
-        Log.err (fun m -> m "error %a while connecting to name server, shutting down" S.TCP.pp_error e) ;
-        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 ->
-        S.TCP.close (D.flow flow) >|= fun () ->
-        match certificate with
-        | Error e -> Error e
-        | Ok (cert, chain) -> Ok (cert :: chain, key)
+      let key =
+        match key_data with
+        | None ->
+          let seed = match key_seed with None -> None | Some x -> Some (Cstruct.of_string x) in
+          X509.Private_key.generate ?seed ?bits key_type
+        | Some x ->
+          match X509.Private_key.of_cstruct (Cstruct.of_string x) key_type with
+          | Error (`Msg m) -> invalid_arg ("decoding of key failed: " ^ m)
+          | Ok key -> key
+      in
+      match
+        let more_hostnames = additional_hostnames in
+        Dns_certify.signing_request hostname ~more_hostnames key
+      with
+      | Error (`Msg m) -> invalid_arg ("create signing request failed: " ^ m)
+      | Ok csr ->
+        S.TCP.create_connection (S.tcp stack) (dns, port) >>= function
+        | Error e ->
+          Log.err (fun m -> m "error %a while connecting to name server"
+                      S.TCP.pp_error e);
+          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 ->
+          S.TCP.close (D.flow flow) >|= fun () ->
+          match certificate with
+          | Error e -> Error e
+          | Ok (cert, chain) -> Ok (cert :: chain, key)
 end

mirage/certify/dns_certify_mirage.mli

@@ -4,8 +4,8 @@ module Make (R : Mirage_random.S) (P : Mirage_clock.PCLOCK) (T : Mirage_time.S)
   val retrieve_certificate :
     S.t -> dns_key:string -> hostname:[ `host ] Domain_name.t ->
     ?additional_hostnames:[ `raw ] Domain_name.t list ->
-    ?key_type:[ `RSA | `ED25519 | `P256 | `P384 | `P521 ] ->
-    ?key_data:string -> ?key_seed:string -> ?bits:int -> S.TCP.ipaddr -> int ->
+    ?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]
       generates a private key (using [key_type], [key_data], [key_seed], and