use mirage-crypto and modern tls

.merlin

@@ -1,10 +0,0 @@
-S src
-S stats
-S app
-S provision
-
-B _build/**
-
-PKG topkg logs ipaddr x509 tls rresult bos lwt cmdliner hex duration
-PKG ptime ptime.clock.os ipaddr.unix decompress
-PKG lwt.unix

.travis.yml

@@ -10,10 +10,9 @@ env:
     - DISTRO=ubuntu
     - TESTS=false
   matrix:
-    - OCAML_VERSION=4.05
-    - OCAML_VERSION=4.06
     - OCAML_VERSION=4.07
     - OCAML_VERSION=4.08
     - OCAML_VERSION=4.09
+    - OCAML_VERSION=4.10
 notifications:
   email: false

albatross.opam

@@ -6,8 +6,8 @@ dev-repo: "git+https://github.com/hannesm/albatross.git"
 bug-reports: "https://github.com/hannesm/albatross/issues"
 
 depends: [
-  "ocaml" {>= "4.05.0"}
+  "ocaml" {>= "4.07.0"}
-  "dune" {build}
+  "dune"
   "lwt" {>= "3.0.0"}
   "ipaddr" {>= "4.0.0"}
   "hex"
@@ -20,9 +20,10 @@ depends: [
   "fmt"
   "astring"
   "jsonm"
-  "x509" {>= "0.9.0"}
+  "x509" {>= "0.10.0"}
-  "tls" {>= "0.9.0"}
+  "tls" {>= "0.11.0"}
-  "nocrypto"
+  "mirage-crypto-pk"
+  "mirage-crypto-rng"
   "asn1-combinators" {>= "0.2.0"}
   "duration"
   "decompress" {>= "0.9.0" & < "1.0.0"}

client/albatross_client_bistro.ml

@@ -47,7 +47,7 @@ let handle (host, port) cert key ca id (cmd : Vmm_commands.t) =
   | _, Error (`Msg e) ->
     Lwt.fail_with ("couldn't parse private key (" ^ key ^ "): "  ^ e)
   | Ok cert, Ok key ->
-    let tmpkey = Nocrypto.Rsa.generate 4096 in
+    let tmpkey = Mirage_crypto_pk.Rsa.generate ~bits:4096 () in
     let name = Vmm_core.Name.to_string id in
     let extensions =
       let v = Vmm_asn.to_cert_extension cmd in
@@ -65,7 +65,7 @@ let handle (host, port) cert key ca id (cmd : Vmm_commands.t) =
     in
     let valid_from, valid_until = timestamps 300 in
     let extensions =
-      let capub = match key with `RSA key -> Nocrypto.Rsa.pub_of_priv key in
+      let capub = match key with `RSA key -> Mirage_crypto_pk.Rsa.pub_of_priv key in
       key_ids extensions Signing_request.((info csr).public_key) (`RSA capub)
     in
     let issuer = Certificate.subject cert in

client/albatross_client_remote_tls.ml

@@ -14,7 +14,6 @@ let rec read_tls_write_cons t =
     read_tls_write_cons t
 
 let client cas host port cert priv_key =
-  Nocrypto_entropy_lwt.initialize () >>= fun () ->
   let auth = if Sys.is_directory cas then `Ca_dir cas else `Ca_file cas in
   X509_lwt.authenticator auth >>= fun authenticator ->
   Lwt.catch (fun () ->
@@ -52,6 +51,7 @@ let run_client _ cas cert key (host, port) =
       | Tls_lwt.Tls_failure f -> Some ("TLS failure: " ^ Tls.Engine.string_of_failure f)
       | _ -> None) ;
   Sys.(set_signal sigpipe Signal_ignore) ;
+  Mirage_crypto_rng_unix.initialize ();
   Lwt_main.run (client cas host port cert key)
 
 open Cmdliner

provision/albatross_provision.ml

@@ -49,7 +49,7 @@ let sign ?dbname ?certname extensions issuer key csr delta =
     | Some _ ->
       match key with
       | `RSA priv ->
-        let capub = `RSA (Nocrypto.Rsa.pub_of_priv priv) in
+        let capub = `RSA (Mirage_crypto_pk.Rsa.pub_of_priv priv) in
         key_ids extensions X509.Signing_request.((info csr).public_key) capub
   in
   X509.Signing_request.sign csr ~valid_from ~valid_until ~extensions key issuer >>= fun cert ->
@@ -69,7 +69,7 @@ let priv_key ?(bits = 2048) fn name =
   Bos.OS.File.exists file >>= function
   | false ->
     Logs.info (fun m -> m "creating new RSA key %a" Fpath.pp file) ;
-    let priv = `RSA (Nocrypto.Rsa.generate bits) in
+    let priv = `RSA (Mirage_crypto_pk.Rsa.generate ~bits ()) in
     Bos.OS.File.write ~mode:0o400 file (Cstruct.to_string (X509.Private_key.encode_pem priv)) >>= fun () ->
     Ok priv
   | true ->

provision/albatross_provision_ca.ml

@@ -59,7 +59,7 @@ let sign_csr dbname cacert key csr days =
   | Error e -> Error e
 
 let sign_main _ db cacert cakey csrname days =
-  Nocrypto_entropy_unix.initialize () ;
+  Mirage_crypto_rng_unix.initialize () ;
   Bos.OS.File.read (Fpath.v cacert) >>= fun cacert ->
   Certificate.decode_pem (Cstruct.of_string cacert) >>= fun cacert ->
   Bos.OS.File.read (Fpath.v cakey) >>= fun pk ->
@@ -74,7 +74,7 @@ let help _ man_format cmds = function
   | Some _ -> List.iter print_endline cmds; `Ok ()
 
 let generate _ name db days sname sdays =
-  Nocrypto_entropy_unix.initialize () ;
+  Mirage_crypto_rng_unix.initialize () ;
   priv_key ~bits:4096 None name >>= fun key ->
   let name = [ Distinguished_name.(Relative_distinguished_name.singleton (CN name)) ] in
   let csr = Signing_request.create name key in

provision/albatross_provision_request.ml

@@ -16,7 +16,7 @@ let csr priv name cmd =
   X509.Signing_request.create name ~extensions priv
 
 let jump id cmd =
-  Nocrypto_entropy_unix.initialize () ;
+  Mirage_crypto_rng_unix.initialize () ;
   let name = Vmm_core.Name.to_string id in
   priv_key None name >>= fun priv ->
   let csr = csr priv name cmd in

provision/dune

@@ -4,7 +4,7 @@
   (public_name albatross.provision)
   (wrapped false)
   (modules albatross_provision)
-  (libraries albatross.cli x509 nocrypto.unix))
+  (libraries albatross.cli x509 mirage-crypto-pk mirage-crypto-rng.unix))
 
 (executable
   (name albatross_provision_ca)

stats/dune

@@ -26,7 +26,8 @@ let () =
   (package albatross)
   (modules albatross_stat_client)
   %s
-  (libraries albatross.cli albatross.stats albatross)) |}
+  (libraries albatross.cli albatross.stats albatross))
+ |}
   (if freebsd then "(link_flags (-ccopt \"-lvmmapi\"))" else "")
   (if freebsd then "(link_flags (-ccopt \"-lvmmapi\"))" else "")
 

tls/albatross_tls_common.ml

@@ -15,7 +15,7 @@ let tls_config cacert cert priv_key =
 
 let client_auth ca tls =
   let authenticator =
-    let time = Ptime_clock.now () in
+    let time () = Some (Ptime_clock.now ()) in
     X509.Authenticator.chain_of_trust ~time (* ~crls:!state.Vmm_engine.crls *) [ca]
   in
   Lwt.catch

tls/albatross_tls_endpoint.ml

@@ -15,10 +15,10 @@ let server_socket port =
 
 let jump _ cacert cert priv_key port tmpdir =
   Sys.(set_signal sigpipe Signal_ignore);
+  Mirage_crypto_rng_unix.initialize ();
   Albatross_cli.set_tmpdir tmpdir;
   Lwt_main.run
-    (Nocrypto_entropy_lwt.initialize () >>= fun () ->
+    (server_socket port >>= fun socket ->
-     server_socket port >>= fun socket ->
      tls_config cacert cert priv_key >>= fun (config, ca) ->
      let rec loop () =
        Lwt.catch (fun () ->

tls/albatross_tls_inetd.ml

@@ -5,10 +5,10 @@ open Albatross_tls_common
 
 let jump cacert cert priv_key tmpdir =
   Sys.(set_signal sigpipe Signal_ignore) ;
+  Mirage_crypto_rng_unix.initialize ();
   Albatross_cli.set_tmpdir tmpdir;
   Lwt_main.run
-    (Nocrypto_entropy_lwt.initialize () >>= fun () ->
+    (tls_config cacert cert priv_key >>= fun (config, ca) ->
-     tls_config cacert cert priv_key >>= fun (config, ca) ->
      let fd = Lwt_unix.of_unix_file_descr Unix.stdin in
      Lwt.catch
        (fun () -> Tls_lwt.Unix.server_of_fd config fd)