use defunctorised version of the rng (#257)

* add next generation mirage-crypto-rng-mirage

* Defunctorise mirage-crypto-rng-mirage, use mirage-sleep and mirage-mtime instead

* fix test

* adapt to mirage how it'll be in the future (no functor)

mirage-crypto-rng-mirage.opam

@@ -20,11 +20,9 @@ depends: [
   "logs"
   "lwt" {>= "4.0.0"}
   "mirage-runtime" {>= "3.8.0"}
-  "mirage-time" {>= "2.0.0"}
-  "mirage-clock" {>= "3.0.0"}
+  "mirage-sleep" {>= "4.0.0"}
+  "mirage-mtime" {>= "4.0.0"}
   "mirage-unix" {with-test & >= "5.0.0"}
-  "mirage-time-unix" {with-test & >= "2.0.0"}
-  "mirage-clock-unix" {with-test & >= "3.0.0"}
   "ohex" {with-test & >= "0.2.0"}
 ]
 description: """

mirage/config.ml

@@ -9,7 +9,7 @@ let main =
     package "ohex" ;
   ]
   in
-  main ~packages "Unikernel.Main" (random @-> job)
+  main ~packages "Unikernel" job
 
 let () =
-  register "crypto-test" [main $ default_random]
+  register "crypto-test" [main]

mirage/unikernel.ml

@@ -1,27 +1,25 @@
-module Main (R : Mirage_crypto_rng_mirage.S) = struct
-  let start _r =
-    Logs.info (fun m -> m "using Fortuna, entropy sources: %a"
-                  Fmt.(list ~sep:(any ", ") Mirage_crypto_rng.Entropy.pp_source)
-                  (Mirage_crypto_rng.Entropy.sources ())) ;
-    Logs.info (fun m -> m "64 byte random:@ %a" (Ohex.pp_hexdump ())
-                  (R.generate 64)) ;
-    let n = Bytes.(unsafe_to_string (create 32)) in
-    let key = Mirage_crypto.Chacha20.of_secret n
-    and nonce = Bytes.(unsafe_to_string (create 12))
-    in
-    Logs.info (fun m -> m "Chacha20/Poly1305 of 32*0, key 32*0, nonce 12*0: %a"
-                  (Ohex.pp_hexdump ())
-                  (Mirage_crypto.Chacha20.authenticate_encrypt ~key ~nonce n));
-    let key = Mirage_crypto_pk.Rsa.generate ~bits:4096 () in
-    let signature =
-      Mirage_crypto_pk.Rsa.PKCS1.sign ~hash:`SHA256 ~key (`Message n)
-    in
-    let verified =
-      let key = Mirage_crypto_pk.Rsa.pub_of_priv key in
-      let hashp = function `SHA256 -> true | _ -> false in
-      Mirage_crypto_pk.Rsa.PKCS1.verify ~hashp ~key ~signature (`Message n)
-    in
-    Logs.info (fun m -> m "Generated a RSA key of %d bits (sign + verify %B)"
-                  (Mirage_crypto_pk.Rsa.priv_bits key) verified);
-    Lwt.return_unit
-end
+let start () =
+  Logs.info (fun m -> m "using Fortuna, entropy sources: %a"
+                Fmt.(list ~sep:(any ", ") Mirage_crypto_rng.Entropy.pp_source)
+                (Mirage_crypto_rng.Entropy.sources ())) ;
+  Logs.info (fun m -> m "64 byte random:@ %a" (Ohex.pp_hexdump ())
+                (Mirage_crypto_rng.generate 64)) ;
+  let n = Bytes.(unsafe_to_string (create 32)) in
+  let key = Mirage_crypto.Chacha20.of_secret n
+  and nonce = Bytes.(unsafe_to_string (create 12))
+  in
+  Logs.info (fun m -> m "Chacha20/Poly1305 of 32*0, key 32*0, nonce 12*0: %a"
+                (Ohex.pp_hexdump ())
+                (Mirage_crypto.Chacha20.authenticate_encrypt ~key ~nonce n));
+  let key = Mirage_crypto_pk.Rsa.generate ~bits:4096 () in
+  let signature =
+    Mirage_crypto_pk.Rsa.PKCS1.sign ~hash:`SHA256 ~key (`Message n)
+  in
+  let verified =
+    let key = Mirage_crypto_pk.Rsa.pub_of_priv key in
+    let hashp = function `SHA256 -> true | _ -> false in
+    Mirage_crypto_pk.Rsa.PKCS1.verify ~hashp ~key ~signature (`Message n)
+  in
+  Logs.info (fun m -> m "Generated a RSA key of %d bits (sign + verify %B)"
+                (Mirage_crypto_pk.Rsa.priv_bits key) verified);
+  Lwt.return_unit

rng/mirage/dune

@@ -1,5 +1,5 @@
 (library
  (name mirage_crypto_rng_mirage)
  (public_name mirage-crypto-rng-mirage)
- (libraries lwt mirage-runtime mirage-crypto-rng mirage-time mirage-clock
+ (libraries lwt mirage-runtime mirage-crypto-rng mirage-sleep mirage-mtime
    duration logs))

rng/mirage/mirage_crypto_rng_mirage.ml

@@ -27,66 +27,47 @@
  * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  *)
 
-module type S = sig
-  type g = Mirage_crypto_rng.g
-  module Entropy :
-    sig
-      type source = Mirage_crypto_rng.Entropy.source
-      val sources : unit -> source list
-      val pp_source : Format.formatter -> source -> unit
-      val register_source : string -> source
-    end
-
-  val generate_into : ?g:g -> bytes -> ?off:int -> int -> unit
-  val generate : ?g:g -> int -> string
-
-  val accumulate : g option -> Entropy.source -> [`Acc of string -> unit]
-end
-
 let src = Logs.Src.create "mirage-crypto-rng-mirage" ~doc:"Mirage crypto RNG mirage"
 module Log = (val Logs.src_log src : Logs.LOG)
 
-module Make (T : Mirage_time.S) (M : Mirage_clock.MCLOCK) = struct
-  include Mirage_crypto_rng
+open Mirage_crypto_rng
 
-  let rdrand_task delta =
-    match Entropy.cpu_rng with
-    | Error `Not_supported -> ()
-    | Ok cpu_rng ->
-      let open Lwt.Infix in
-      let rdrand = cpu_rng None in
-      Lwt.async (fun () ->
-          let rec one () =
-            rdrand ();
-            T.sleep_ns delta >>=
-            one
-          in
-          one ())
+let rdrand_task delta =
+  match Entropy.cpu_rng with
+  | Error `Not_supported -> ()
+  | Ok cpu_rng ->
+    let open Lwt.Infix in
+    let rdrand = cpu_rng None in
+    Lwt.async (fun () ->
+        let rec one () =
+          rdrand ();
+          Mirage_sleep.ns delta >>=
+          one
+        in
+        one ())
 
-  let bootstrap_functions () =
-    [ Entropy.bootstrap ; Entropy.bootstrap ;
-      Entropy.whirlwind_bootstrap ; Entropy.bootstrap ]
+let bootstrap_functions () =
+  Entropy.[ bootstrap ; bootstrap ; whirlwind_bootstrap ; bootstrap ]
 
-  let running = ref false
+let running = ref false
 
-  let initialize (type a) ?g ?(sleep = Duration.of_sec 1) (rng : a generator) =
-    if !running then
-      Lwt.fail_with "entropy collection already running"
-    else begin
-      (try
-         let _ = default_generator () in
-         Log.warn (fun m -> m "Mirage_crypto_rng.default_generator has already \
-                               been set, check that this call is intentional");
-       with
-         No_default_generator -> ());
-      running := true;
-      let seed =
-        List.mapi (fun i f -> f i) (bootstrap_functions ()) |> String.concat ""
-      in
-      let rng = create ?g ~seed ~time:M.elapsed_ns rng in
-      set_default_generator rng;
-      rdrand_task sleep;
-      Mirage_runtime.at_enter_iter (Entropy.timer_accumulator None);
-      Lwt.return_unit
-    end
-end
+let initialize (type a) ?g ?(sleep = Duration.of_sec 1) (rng : a generator) =
+  if !running then
+    Lwt.fail_with "entropy collection already running"
+  else begin
+    (try
+       let _ = default_generator () in
+       Log.warn (fun m -> m "Mirage_crypto_rng.default_generator has already \
+                             been set, check that this call is intentional");
+     with
+       No_default_generator -> ());
+    running := true;
+    let seed =
+      List.mapi (fun i f -> f i) (bootstrap_functions ()) |> String.concat ""
+    in
+    let rng = create ?g ~seed ~time:Mirage_mtime.elapsed_ns rng in
+    set_default_generator rng;
+    rdrand_task sleep;
+    Mirage_runtime.at_enter_iter (Entropy.timer_accumulator None);
+    Lwt.return_unit
+  end

rng/mirage/mirage_crypto_rng_mirage.mli

@@ -26,49 +26,10 @@
  * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  *)
 
-module type S = sig
-  type g = Mirage_crypto_rng.g
-  (** A generator (PRNG) with its state. *)
-
-  (** Entropy sources and collection *)
-  module Entropy :
-    sig
-      (** Entropy sources. *)
-      type source = Mirage_crypto_rng.Entropy.source
-
-      val sources : unit -> source list
-      (** [sources ()] returns the list of available sources. *)
-
-      val pp_source : Format.formatter -> source -> unit
-      (** [pp_source ppf source] pretty-prints the entropy [source] on [ppf]. *)
-
-      val register_source : string -> source
-      (** [register_source name] registers [name] as entropy source. *)
-    end
-
-  val generate_into : ?g:g -> bytes -> ?off:int -> int -> unit
-  (** [generate_into ~g buf ~off len] invokes
-      {{!Generator.generate_into}generate_into} on [g] or
-      {{!generator}default generator}. The random data is put into [buf] starting
-      at [off] (defaults to 0) with [len] bytes. *)
-
-  val generate : ?g:g -> int -> string
-  (** Invoke {!generate_into} on [g] or {{!generator}default generator} and a
-      freshly allocated string. *)
-
-  val accumulate : g option -> Entropy.source -> [`Acc of string -> unit]
-  (** [accumulate g source] is a function [data -> unit] to feed entropy to the
-      RNG. This is useful if your system has a special entropy source. *)
-end
-
-module Make (T : Mirage_time.S) (M : Mirage_clock.MCLOCK) : sig
-  include S
-
-  val initialize :
-    ?g:'a -> ?sleep:int64 -> 'a Mirage_crypto_rng.generator -> unit Lwt.t
-  (** [initialize ~g ~sleep generator] sets the default generator to the
-      [generator] and sets up periodic entropy feeding for that rng. This
-      function fails ([Lwt.fail]) if it is called a second time. The argument
-      [~sleep] is measured in ns, and used as sleep between cpu assisted random
-      number collection. It defaults to one second. *)
-end
+val initialize :
+  ?g:'a -> ?sleep:int64 -> 'a Mirage_crypto_rng.generator -> unit Lwt.t
+(** [initialize ~g ~sleep generator] sets the default generator to the
+    [generator] and sets up periodic entropy feeding for that rng. This
+    function fails ([Lwt.fail]) if it is called a second time. The argument
+    [~sleep] is measured in ns, and used as sleep between cpu assisted random
+    number collection. It defaults to one second. *)

tests/dune

@@ -28,8 +28,7 @@
  (name test_entropy_collection)
  (modules test_entropy_collection)
  (package mirage-crypto-rng-mirage)
- (libraries mirage-crypto-rng-mirage mirage-unix mirage-time-unix
-   mirage-clock-unix duration ohex))
+ (libraries mirage-crypto-rng-mirage mirage-unix duration ohex))
 
 (test
  (name test_entropy)

tests/test_entropy_collection.ml

@@ -23,10 +23,8 @@ module Printing_rng = struct
   let pools = 1
 end
 
-module E = Mirage_crypto_rng_mirage.Make(Time)(Mclock)
-
 let with_entropy act =
-  E.initialize (module Printing_rng) >>= fun () ->
+  Mirage_crypto_rng_mirage.initialize (module Printing_rng) >>= fun () ->
   Format.printf "entropy sources: %a@,%!"
     (fun ppf -> List.iter (fun x ->
          Mirage_crypto_rng.Entropy.pp_source ppf x;