Adapt code to new mirage-crypto (CP-308222)

Unfortunately mirage-crypto has accumulated breaking changes:
- Cstructs have been replaced with strings
- The digestif library has replaced ad-hoc hash implementation

A deprecation has happened as well:
- RNG initialization has changed

Signed-off-by: Pau Ruiz Safont <[email protected]>

Author: psafont

ocaml/gencert/dune

@@ -6,7 +6,7 @@
   (libraries
     angstrom
     astring
-    cstruct
+    digestif
     forkexec
     mirage-crypto
     mirage-crypto-pk
@@ -52,7 +52,7 @@
   (modules test_lib test_pem)
   (libraries
     alcotest
-    cstruct
+    digestif
     fmt
     gencertlib
     mirage-crypto

ocaml/gencert/lib.ml

@@ -34,8 +34,7 @@ let validate_private_key pkcs8_private_key =
         let key_type = X509.(Key_type.to_string (Private_key.key_type key)) in
         Error (`Msg (server_certificate_key_algorithm_not_supported, [key_type]))
   in
-  let raw_pem = Cstruct.of_string pkcs8_private_key in
-  X509.Private_key.decode_pem raw_pem
+  X509.Private_key.decode_pem pkcs8_private_key
   |> R.reword_error (fun (`Msg err_msg) ->
          let unknown_algorithm = "Unknown algorithm " in
          if Astring.String.is_prefix ~affix:"multi-prime RSA" err_msg then
@@ -56,9 +55,8 @@ let validate_private_key pkcs8_private_key =
      )
   >>= ensure_rsa_key_length
 
-let pem_of_string x ~error_invalid =
-  let raw_pem = Cstruct.of_string x in
-  X509.Certificate.decode_pem raw_pem
+let decode_cert pem ~error_invalid =
+  X509.Certificate.decode_pem pem
   |> R.reword_error (fun (`Msg err_msg) ->
          D.info {|Failed to validate certificate because "%s"|} err_msg ;
          `Msg (error_invalid, [])
@@ -76,7 +74,7 @@ let assert_not_expired ~now certificate ~error_not_yet ~error_expired =
 
 let _validate_not_expired ~now (blob : string) ~error_invalid ~error_not_yet
     ~error_expired =
-  pem_of_string blob ~error_invalid >>= fun cert ->
+  decode_cert blob ~error_invalid >>= fun cert ->
   assert_not_expired ~now cert ~error_not_yet ~error_expired
 
 let validate_not_expired x ~error_not_yet ~error_expired ~error_invalid =
@@ -101,8 +99,7 @@ let validate_pem_chain ~pem_leaf ~pem_chain now private_key =
         Error (`Msg (server_certificate_signature_not_supported, []))
   in
   let validate_chain pem_chain =
-    let raw_pem = Cstruct.of_string pem_chain in
-    X509.Certificate.decode_pem_multiple raw_pem |> function
+    X509.Certificate.decode_pem_multiple pem_chain |> function
     | Ok (_ :: _ as certs) ->
         Ok certs
     | Ok [] ->
@@ -135,17 +132,13 @@ let install_server_certificate ~pem_chain ~pem_leaf ~pkcs8_private_key
     ~server_cert_path ~cert_gid =
   let now = Ptime_clock.now () in
   validate_private_key pkcs8_private_key >>= fun priv ->
-  let pkcs8_private_key =
-    X509.Private_key.encode_pem priv |> Cstruct.to_string
-  in
+  let pkcs8_private_key = X509.Private_key.encode_pem priv in
   validate_pem_chain ~pem_leaf ~pem_chain now priv >>= fun (cert, chain) ->
-  let pem_leaf = X509.Certificate.encode_pem cert |> Cstruct.to_string in
+  let pem_leaf = X509.Certificate.encode_pem cert in
   Option.fold
     ~none:(Ok [pkcs8_private_key; pem_leaf])
     ~some:(fun chain ->
-      let pem_chain =
-        X509.Certificate.encode_pem_multiple chain |> Cstruct.to_string
-      in
+      let pem_chain = X509.Certificate.encode_pem_multiple chain in
       Ok [pkcs8_private_key; pem_leaf; pem_chain]
     )
     chain

ocaml/gencert/selfcert.ml

@@ -43,7 +43,7 @@ let valid_from' date =
 
 (* Needed to initialize the rng to create random serial codes when signing
    certificates *)
-let () = Mirage_crypto_rng_unix.initialize (module Mirage_crypto_rng.Fortuna)
+let () = Mirage_crypto_rng_unix.use_default ()
 
 (** [write_cert] writes a PKCS12 file to [path]. The typical file
  extension would be ".pem". It attempts to do that atomically by
@@ -117,7 +117,6 @@ let generate_pub_priv_key length =
   in
   let* privkey =
     rsa_string
-    |> Cstruct.of_string
     |> X509.Private_key.decode_pem
     |> R.reword_error (fun _ -> R.msg "decoding private key failed")
   in
@@ -132,9 +131,7 @@ let selfsign' issuer extensions key_length expiration =
   let* cert = sign expiration privkey pubkey issuer req extensions in
   let key_pem = X509.Private_key.encode_pem privkey in
   let cert_pem = X509.Certificate.encode_pem cert in
-  let pkcs12 =
-    String.concat "\n\n" [Cstruct.to_string key_pem; Cstruct.to_string cert_pem]
-  in
+  let pkcs12 = String.concat "\n\n" [key_pem; cert_pem] in
   Ok (cert, pkcs12)
 
 let selfsign issuer extensions key_length expiration certfile cert_gid =

ocaml/gencert/selfcert.mli

@@ -23,7 +23,7 @@ val write_certs : string -> int -> string -> (unit, [> Rresult.R.msg]) result
 val host :
      name:string
   -> dns_names:string list
-  -> ips:Cstruct.t list
+  -> ips:string list
   -> ?valid_from:Ptime.t (* default: now *)
   -> valid_for_days:int
   -> string

ocaml/gencert/test_lib.ml

@@ -8,7 +8,7 @@ open Rresult.R.Infix
 let ( let* ) = Rresult.R.bind
 
 (* Initialize RNG for testing certificates *)
-let () = Mirage_crypto_rng_unix.initialize (module Mirage_crypto_rng.Fortuna)
+let () = Mirage_crypto_rng_unix.use_default ()
 
 let time_of_rfc3339 date =
   match Ptime.of_rfc3339 date with
@@ -204,7 +204,7 @@ let test_invalid_cert pem_leaf time pkey error reason =
         "Error must match" (error, reason) msg
 
 let load_pkcs8 name =
-  X509.Private_key.decode_pem (Cstruct.of_string (load_test_data name))
+  X509.Private_key.decode_pem (load_test_data name)
   |> Rresult.R.reword_error (fun (`Msg msg) ->
          `Msg
            (Printf.sprintf "Could not load private key with name '%s': %s" name
@@ -222,7 +222,6 @@ let sign_leaf_cert host_name digest pkey_leaf =
   load_pkcs8 "pkey_rsa_4096" >>= fun pkey_sign ->
   sign_cert host_name ~pkey_sign digest pkey_leaf
   >>| X509.Certificate.encode_pem
-  >>| Cstruct.to_string
 
 let valid_leaf_cert_tests =
   List.map
@@ -300,8 +299,7 @@ let valid_chain_cert_tests =
         (pkey_root, Ok []) key_chain
     in
     sign_leaf_cert host_name `SHA256 pkey_leaf >>= fun pem_leaf ->
-    chain >>| X509.Certificate.encode_pem_multiple >>| Cstruct.to_string
-    >>| fun pem_chain ->
+    chain >>| X509.Certificate.encode_pem_multiple >>| fun pem_chain ->
     test_valid_cert_chain ~pem_leaf ~pem_chain time pkey_leaf
   in
   [("Validation of a supported certificate chain", `Quick, test_cert)]

ocaml/tests/dune

@@ -15,7 +15,7 @@
     angstrom
     astring
     cstruct
-
+    digestif
     fmt
     http_lib
     httpsvr

ocaml/tests/test_certificates.ml

@@ -13,7 +13,7 @@ let pp_hash_test =
     (fun (hashable, expected) ->
       let test_hash () =
         let digest =
-          Cstruct.of_string hashable |> Mirage_crypto.Hash.digest `SHA256
+          Digestif.SHA256.(digest_string hashable |> to_raw_string)
         in
         Alcotest.(check string)
           "fingerprints must match" expected

ocaml/xapi-aux/networking_info.ml

@@ -55,11 +55,13 @@ let dns_names () =
      )
   |> Astring.String.uniquify
 
-let ipaddr_to_cstruct = function
+let ipaddr_to_octets = function
   | Ipaddr.V4 addr ->
-      Cstruct.of_string (Ipaddr.V4.to_octets addr)
+      Ipaddr.V4.to_octets addr
   | Ipaddr.V6 addr ->
-      Cstruct.of_string (Ipaddr.V6.to_octets addr)
+      Ipaddr.V6.to_octets addr
+
+let ipaddr_to_cstruct c = ipaddr_to_octets c |> Cstruct.of_string
 
 let get_management_ip_addrs ~dbg =
   let iface = Inventory.lookup Inventory._management_interface in
@@ -113,7 +115,7 @@ let get_host_certificate_subjects ~dbg =
     | Ok (preferred, others) ->
         let ips = List.(rev_append (rev preferred) others) in
         Option.fold ~none:(Error IP_missing)
-          ~some:(fun ip -> Ok (List.map ipaddr_to_cstruct ips, ip))
+          ~some:(fun ip -> Ok (List.map ipaddr_to_octets ips, ip))
           (List.nth_opt ips 0)
   in
   let dns_names = dns_names () in

ocaml/xapi-aux/networking_info.mli

@@ -31,6 +31,6 @@ val get_management_ip_addr : dbg:string -> (string * Cstruct.t) option
 
 val get_host_certificate_subjects :
      dbg:string
-  -> (string * string list * Cstruct.t list, management_ip_error) Result.t
+  -> (string * string list * string list, management_ip_error) Result.t
 (** [get_host_certificate_subjects ~dbg] returns the main, dns names and ip
     addresses that identify the host in secure connections. *)

ocaml/xapi/cert_refresh.ml

@@ -79,7 +79,7 @@ let host ~__context ~type' =
         Server_error
           (cannot_contact_host, [Ref.string_of (HostSet.choose unreachable)])
       ) ;
-  let content = X509.Certificate.encode_pem cert |> Cstruct.to_string in
+  let content = X509.Certificate.encode_pem cert in
   (* distribute public part of new cert in pool *)
   Cert_distrib.distribute_new_host_cert ~__context ~host ~content ;
   (* replace certs in file system on host *)

ocaml/xapi/certificates.ml

@@ -32,7 +32,7 @@ open D
 type t_trusted = CA_Certificate | CRL
 
 let pem_of_string x =
-  match Cstruct.of_string x |> X509.Certificate.decode_pem with
+  match X509.Certificate.decode_pem x with
   | Error _ ->
       D.error "pem_of_string: failed to parse certificate string" ;
       raise
@@ -75,7 +75,7 @@ let to_string = function CA_Certificate -> "CA certificate" | CRL -> "CRL"
     adding a colon between every octet, in uppercase.
  *)
 let pp_hash hash =
-  let hex = Hex.(show @@ of_cstruct hash) in
+  let hex = Hex.(show @@ of_string hash) in
   let length = (3 * String.length hex / 2) - 1 in
   let value_of i =
     match (i + 1) mod 3 with
@@ -441,9 +441,7 @@ let get_internal_server_certificate () =
 open Rresult
 
 let hostnames_of_pem_cert pem =
-  Cstruct.of_string pem
-  |> X509.Certificate.decode_pem
-  >>| X509.Certificate.hostnames
+  X509.Certificate.decode_pem pem >>| X509.Certificate.hostnames
 
 let install_server_certificate ~pem_chain ~pem_leaf ~pkcs8_private_key ~path =
   let installation =

ocaml/xapi/certificates.mli

@@ -18,10 +18,9 @@ type t_trusted = CA_Certificate | CRL
 
 val pem_of_string : string -> X509.Certificate.t
 
-val pp_hash : Cstruct.t -> string
+val pp_hash : string -> string
 
-val pp_fingerprint :
-  hash_type:Mirage_crypto.Hash.hash -> X509.Certificate.t -> string
+val pp_fingerprint : hash_type:Digestif.hash' -> X509.Certificate.t -> string
 
 val validate_name : t_trusted -> string -> unit
 

ocaml/xapi/certificates_sync.ml

@@ -57,10 +57,8 @@ let get_server_cert path =
   | Error msg ->
       Error (`Msg (msg, []))
   | Ok cert ->
-      let host_pem = cert.GP.host_cert in
       let* host_cert =
-        Cstruct.of_string host_pem
-        |> X509.Certificate.decode_pem
+        X509.Certificate.decode_pem cert.GP.host_cert
         |> R.reword_error (fun (`Msg msg) ->
                D.info {|Failed to decode certificate because "%s"|} msg ;
                `Msg (server_certificate_invalid, [])

ocaml/xapi/dune

@@ -138,6 +138,7 @@
   clock
   cohttp
   cohttp_posix
+  digestif
   domain-name
   ezxenstore.core
   fmt

ocaml/xapi/xapi_db_upgrade.ml

@@ -930,7 +930,6 @@ let upgrade_ca_fingerprints =
               try
                 let* certificate =
                   Xapi_stdext_unix.Unixext.string_of_file filename
-                  |> Cstruct.of_string
                   |> X509.Certificate.decode_pem
                 in
                 let sha1 =

ocaml/xapi/xapi_session.ml

@@ -801,12 +801,12 @@ module Caching = struct
        and type password = string
        and type session = external_auth_result
 
-  let () = Mirage_crypto_rng_unix.initialize (module Mirage_crypto_rng.Fortuna)
+  let () = Mirage_crypto_rng_unix.use_default ()
 
   let create_salt () =
     (* Creates a Cstruct of length 8. *)
     let data = Mirage_crypto_rng.generate 8 in
-    let bytes = Cstruct.to_bytes data in
+    let bytes = Bytes.of_string data in
     (* Encode the salt as a hex string. Each byte becomes 2
        hexadecimal digits, so the length is 16 (the maximum for
        crypt_r). *)