unikernel/duniverse/mirage-crypto/rng/dune

@@ -0,0 +1,5 @@
+(library
+ (name mirage_crypto_rng)
+ (public_name mirage-crypto-rng)
+ (libraries mirage-crypto digestif logs)
+ (private_modules entropy fortuna hmac_drbg rng))

unikernel/duniverse/mirage-crypto/rng/entropy.ml

@@ -0,0 +1,226 @@
+(*
+ * Copyright (c) 2014 Hannes Mehnert
+ * Copyright (c) 2014 Anil Madhavapeddy <anil@recoil.org>
+ * Copyright (c) 2014-2016 David Kaloper Meršinjak
+ * Copyright (c) 2015 Citrix Systems Inc
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * * Redistributions of source code must retain the above copyright notice, this
+ *   list of conditions and the following disclaimer.
+ *
+ * * Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+ * DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+ * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+ * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+ * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+ * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+let src = Logs.Src.create "mirage-crypto-rng-entropy" ~doc:"Mirage crypto RNG Entropy"
+module Log = (val Logs.src_log src : Logs.LOG)
+
+let rdrand_calls = Atomic.make 0
+let rdrand_failures = Atomic.make 0
+let rdseed_calls = Atomic.make 0
+let rdseed_failures = Atomic.make 0
+
+module Cpu_native = struct
+
+  external cycles : unit -> int  = "mc_cycle_counter" [@@noalloc]
+  external rdseed : bytes -> int -> bool  = "mc_cpu_rdseed" [@@noalloc]
+  external rdrand : bytes -> int -> bool  = "mc_cpu_rdrand" [@@noalloc]
+  external rng_type : unit -> int  = "mc_cpu_rng_type" [@@noalloc]
+
+  let cpu_rng =
+    match rng_type () with
+    | 0 -> []
+    | 1 -> [ `Rdrand ]
+    | 2 -> [ `Rdseed ]
+    | 3 -> [ `Rdrand ; `Rdseed ]
+    | _ -> assert false
+end
+
+module S = Set.Make(struct
+    type t = int * string
+    (* only the name is relevant for comparison - the idx not *)
+    let compare ((_a, an) : int * string) ((_b, bn) : int * string) =
+      String.compare an bn
+  end)
+
+let _sources = Atomic.make S.empty
+
+type source = Rng.source
+
+let register_source name =
+  let rec set () =
+    let sources = Atomic.get _sources in
+    let n = S.cardinal sources in
+    let source = (n, name) in
+    if Atomic.compare_and_set _sources sources (S.add source sources) then
+      source
+    else
+      set ()
+  in
+  set ()
+
+let id (idx, _) = idx
+
+let sources () = S.elements (Atomic.get _sources)
+
+let pp_source ppf (idx, name) = Format.fprintf ppf "[%d] %s" idx name
+
+let cpu_rng isn buf off = match isn with
+  | `Rdseed ->
+    Atomic.incr rdseed_calls;
+    let success = Cpu_native.rdseed buf off in
+    if not success then Atomic.incr rdseed_failures;
+    success
+  | `Rdrand ->
+    Atomic.incr rdrand_calls;
+    let success = Cpu_native.rdrand buf off in
+    if not success then Atomic.incr rdrand_failures;
+    success
+
+let random preferred =
+  match Cpu_native.cpu_rng with
+  | [] -> None
+  | xs when List.mem preferred xs -> Some preferred
+  | y::_ -> Some y
+
+let write_header source data =
+  Bytes.set_uint8 data 0 source;
+  Bytes.set_uint8 data 1 (Bytes.length data - 2)
+
+let header source data =
+  let hdr = Bytes.create (2 + String.length data) in
+  Bytes.unsafe_blit_string data 0 hdr 2 (String.length data);
+  write_header source hdr;
+  Bytes.unsafe_to_string hdr
+
+(* Note:
+ * `bootstrap` is not a simple feedback loop. It attempts to exploit CPU-level
+ * data races that lead to execution-time variability of identical instructions.
+ * See Whirlwind RNG:
+ *   http://www.ieee-security.org/TC/SP2014/papers/Not-So-RandomNumbersinVirtualizedLinuxandtheWhirlwindRNG.pdf
+*)
+let whirlwind_bootstrap id =
+  let outer     = 100
+  and inner_max = 1024
+  and a         = ref 0
+  in
+  let buf       = Bytes.create (outer * 2 + 2) in
+  for i = 0 to outer - 1 do
+    let tsc = Cpu_native.cycles () in
+    Bytes.set_uint16_le buf ((i + 1) * 2) tsc;
+    for j = 1 to tsc mod inner_max do
+      a := tsc / j - !a * i + 1
+    done
+  done;
+  write_header id buf;
+  Bytes.unsafe_to_string buf
+
+let cpu_rng_bootstrap =
+  let rdrand_bootstrap id =
+    let rec go acc = function
+      | 0 -> acc
+      | n ->
+        let buf = Bytes.create 10 in
+        let r = cpu_rng `Rdrand buf 2 in
+        write_header id buf;
+        if not r then
+          go acc (pred n)
+        else
+          go (Bytes.unsafe_to_string buf :: acc) (pred n)
+    in
+    let result = go [] 512 |> String.concat "" in
+    if String.length result = 0 then
+      failwith "Too many RDRAND failures"
+    else
+      result
+  in
+  match random `Rdseed with
+  | None -> Error `Not_supported
+  | Some `Rdseed ->
+    let cpu_rng_bootstrap id =
+      let buf = Bytes.create 10 in
+      let r = cpu_rng `Rdseed buf 2 in
+      write_header id buf;
+      if not r then
+        if List.mem `Rdrand Cpu_native.cpu_rng then
+          rdrand_bootstrap id
+        else
+          failwith "RDSEED failed, and RDRAND not available"
+      else
+        Bytes.unsafe_to_string buf
+    in
+    Ok cpu_rng_bootstrap
+  | Some `Rdrand -> Ok rdrand_bootstrap
+
+let bootstrap id =
+  match cpu_rng_bootstrap with
+  | Error `Not_supported -> whirlwind_bootstrap id
+  | Ok cpu_rng_bootstrap ->
+    try cpu_rng_bootstrap id with
+    | Failure f ->
+      Log.err (fun m -> m "CPU RNG bootstrap failed: %s, using whirlwind" f);
+      whirlwind_bootstrap id
+
+let interrupt_hook () =
+  let buf = Bytes.create 4 in
+  let a = Cpu_native.cycles () in
+  Bytes.set_int32_le buf 0 (Int32.of_int a) ;
+  Bytes.unsafe_to_string buf
+
+let timer_accumulator g =
+  let g = match g with None -> Some (Rng.default_generator ()) | Some g -> Some g in
+  let source = register_source "timer" in
+  let `Acc handle = Rng.accumulate g source in
+  (fun () -> handle (interrupt_hook ()))
+
+let feed_pools g source f =
+  let g = match g with None -> Some (Rng.default_generator ()) | Some g -> Some g in
+  let `Acc handle = Rng.accumulate g source in
+  for _i = 0 to pred (Rng.pools g) do
+    match f () with
+    | Ok data -> handle data
+    | Error `No_random_available ->
+      (* should we log a message? *)
+      ()
+  done
+
+let cpu_rng =
+  match random `Rdrand with
+  | None -> Error `Not_supported
+  | Some insn ->
+    let cpu_rng g =
+      let randomf = cpu_rng insn
+      and source =
+        let s = match insn with `Rdrand -> "rdrand" | `Rdseed -> "rdseed" in
+        register_source s
+      in
+      let f () =
+        let buf = Bytes.create 8 in
+        if randomf buf 0 then
+          Ok (Bytes.unsafe_to_string buf)
+        else
+          Error `No_random_available
+      in
+      fun () -> feed_pools g source f
+    in
+    Ok cpu_rng
+
+let rdrand_calls () = Atomic.get rdrand_calls
+let rdrand_failures () = Atomic.get rdrand_failures
+let rdseed_calls () = Atomic.get rdseed_calls
+let rdseed_failures () = Atomic.get rdseed_failures

unikernel/duniverse/mirage-crypto/rng/fortuna.ml

@@ -0,0 +1,126 @@
+(* NOTE: when modifying this file, please also check whether
+   rng/miou/pfortuna.ml needs to be updated. *)
+
+open Mirage_crypto
+open Mirage_crypto.Uncommon
+
+module SHAd256 = struct
+  open Digestif
+  type t = SHA256.t
+  type ctx = SHA256.ctx
+  let empty     = SHA256.empty
+  let get t     = SHA256.(get t |> to_raw_string |> digest_string |> to_raw_string)
+  let digest x  = SHA256.(digest_string x |> to_raw_string |> digest_string |> to_raw_string)
+  let digesti i = SHA256.(digesti_string i |> to_raw_string |> digest_string |> to_raw_string)
+  let feedi     = SHA256.feedi_string
+end
+
+let block = 16
+
+(* the minimal amount of bytes in a pool to trigger a reseed *)
+let min_pool_size = 64
+(* the minimal duration between two reseeds *)
+let min_time_duration = 1_000_000_000L
+(* number of pools *)
+let pools = 32
+
+(* XXX Locking!! *)
+type g =
+  { mutable ctr    : AES.CTR.ctr
+  ; mutable secret : string
+  ; mutable key    : AES.CTR.key
+  ; pools          : SHAd256.ctx array
+  ; mutable pool0_size : int
+  ; mutable reseed_count : int
+  ; mutable last_reseed : int64
+  ; time : (unit -> int64) option
+  }
+
+let create ?time () =
+  let k = String.make 32 '\x00' in
+  { ctr    = (0L, 0L)
+  ; secret = k
+  ; key    = AES.CTR.of_secret k
+  ; pools  = Array.make pools SHAd256.empty
+  ; pool0_size = 0
+  ; reseed_count = 0
+  ; last_reseed = 0L
+  ; time
+  }
+
+let seeded ~g =
+  let lo, hi = g.ctr in
+  not (Int64.equal lo 0L && Int64.equal hi 0L)
+
+(* XXX We might want to erase the old key. *)
+let set_key ~g sec =
+  g.secret <- sec ;
+  g.key    <- AES.CTR.of_secret sec
+
+let reseedi ~g iter =
+  set_key ~g @@ SHAd256.digesti (fun f -> f g.secret; iter f);
+  g.ctr <- AES.CTR.add_ctr g.ctr 1L
+
+let iter1 a     f = f a
+
+let reseed ~g cs = reseedi ~g (iter1 cs)
+
+let generate_rekey ~g buf ~off len =
+  let b  = len // block + 2 in
+  let n  = b * block in
+  let r  = AES.CTR.stream ~key:g.key ~ctr:g.ctr n in
+  Bytes.unsafe_blit_string r 0 buf off len;
+  let r2 = String.sub r (n - 32) 32 in
+  set_key ~g r2 ;
+  g.ctr <- AES.CTR.add_ctr g.ctr (Int64.of_int b)
+
+let add_pool_entropy g =
+  if g.pool0_size > min_pool_size then
+    let should_reseed, now =
+      match g.time with
+      | None -> true, 0L
+      | Some f ->
+        let now = f () in
+        Int64.(sub now g.last_reseed > min_time_duration), now
+    in
+    if should_reseed then begin
+      g.reseed_count <- g.reseed_count + 1;
+      g.last_reseed <- now;
+      g.pool0_size <- 0;
+      reseedi ~g @@ fun add ->
+      for i = 0 to pools - 1 do
+        if g.reseed_count land ((1 lsl i) - 1) = 0 then
+          (SHAd256.get g.pools.(i) |> add; g.pools.(i) <- SHAd256.empty)
+      done
+    end
+
+let generate_into ~g buf ~off len =
+  add_pool_entropy g;
+  if not (seeded ~g) then raise Rng.Unseeded_generator ;
+  let rec chunk off = function
+    | i when i <= 0 -> ()
+    | n ->
+      let n' = imin n 0x10000 in
+      generate_rekey ~g buf ~off n';
+      chunk (off + n') (n - n')
+  in
+  chunk off len
+
+let add ~g (source, _) ~pool data =
+  let buf = Bytes.create 2
+  and pool   = pool land (pools - 1)
+  and source = source land 0xff in
+  Bytes.set_uint8 buf 0 source;
+  Bytes.set_uint8 buf 1 (String.length data);
+  g.pools.(pool) <- SHAd256.feedi g.pools.(pool) (iter2 (Bytes.unsafe_to_string buf) data);
+  if pool = 0 then g.pool0_size <- g.pool0_size + String.length data
+
+(* XXX
+ * Schneier recommends against using generator-imposed pool-seeding schedule
+ * but it just makes for a horrid api.
+ *)
+let accumulate ~g source =
+  let pool = ref 0 in
+  `Acc (fun buf ->
+    add ~g source ~pool:!pool buf ;
+    incr pool)

unikernel/duniverse/mirage-crypto/rng/hmac_drbg.ml

@@ -0,0 +1,52 @@
+module Make (H : Digestif.S) = struct
+  type g =
+    { mutable k      : string
+    ; mutable v      : string
+    ; mutable seeded : bool
+    }
+
+  let block = H.digest_size
+
+  let (bx00, bx01) = "\x00", "\x01"
+
+  let k0 = String.make H.digest_size '\x00'
+  and v0 = String.make H.digest_size '\x01'
+
+  let create ?time:_ () = { k = k0 ; v = v0 ; seeded = false }
+
+  let seeded ~g = g.seeded
+
+  let reseed ~g buf =
+    let (k, v) = (g.k, g.v) in
+    let k = H.hmac_string ~key:k @@ String.concat "" [v; bx00; buf] |> H.to_raw_string in
+    let v = H.hmac_string ~key:k v |> H.to_raw_string in
+    let k = H.hmac_string ~key:k @@ String.concat "" [v; bx01; buf] |> H.to_raw_string in
+    let v = H.hmac_string ~key:k v |> H.to_raw_string in
+    g.k <- k ; g.v <- v ; g.seeded <- true
+
+  let generate_into ~g buf ~off len =
+    if not g.seeded then raise Rng.Unseeded_generator ;
+    let rec go off k v = function
+      | 0 -> v
+      | 1 ->
+        let v = H.hmac_string ~key:k v |> H.to_raw_string in
+        let len =
+          let rem = len mod H.digest_size in
+          if rem = 0 then H.digest_size else rem
+        in
+        Bytes.unsafe_blit_string v 0 buf off len;
+        v
+      | i ->
+        let v = H.hmac_string ~key:k v |> H.to_raw_string in
+        Bytes.unsafe_blit_string v 0 buf off H.digest_size;
+        go (off + H.digest_size) k v (pred i)
+    in
+    let v = go off g.k g.v Mirage_crypto.Uncommon.(len // H.digest_size) in
+    g.k <- H.hmac_string ~key:g.k (v ^ bx00) |> H.to_raw_string;
+    g.v <- H.hmac_string ~key:g.k v |> H.to_raw_string
+
+  (* XXX *)
+  let accumulate ~g:_ = invalid_arg "Implement Hmac_drbg.accumulate..."
+
+  let pools = 0
+end

unikernel/duniverse/mirage-crypto/rng/miou/dune

@@ -0,0 +1,5 @@
+(library
+ (name mirage_crypto_rng_miou_unix)
+ (public_name mirage-crypto-rng-miou-unix)
+ (libraries miou miou.unix mirage-crypto mirage-crypto-rng mirage-crypto-rng.unix digestif duration mtime.clock.os logs)
+ (modules mirage_crypto_rng_miou_unix pfortuna))

unikernel/duniverse/mirage-crypto/rng/miou/mirage_crypto_rng_miou_unix.ml

@@ -0,0 +1,101 @@
+open Mirage_crypto_rng
+
+module Pfortuna = Pfortuna
+
+type _ Effect.t += Spawn : (unit -> unit) -> unit Effect.t
+external reraise : exn -> 'a = "%reraise"
+
+let periodic fn delta =
+  let rec one () =
+    fn ();
+    Miou_unix.sleep (Duration.to_f delta);
+    one () in
+  Effect.perform (Spawn one)
+
+let getrandom delta source =
+  let fn () =
+    let per_pool = 8 in
+    let size = per_pool * pools None in
+    let random = Mirage_crypto_rng_unix.getrandom size in
+    let idx = ref 0 in
+    let fn () =
+      incr idx;
+      Ok (String.sub random (per_pool * (pred !idx)) per_pool)
+    in
+    Entropy.feed_pools None source fn in
+  periodic fn delta
+
+let getrandom_init i =
+  let data = Mirage_crypto_rng_unix.getrandom 128 in
+  Entropy.header i data
+
+let rdrand delta =
+  match Entropy.cpu_rng with
+  | Error `Not_supported -> ()
+  | Ok cpu_rng -> periodic (cpu_rng None) delta
+
+let running = Atomic.make false
+
+let switch fn =
+  let orphans = Miou.orphans () in
+  let open Effect.Deep in
+  let retc = Fun.id in
+  let exnc = reraise in
+  let effc : type c. c Effect.t -> ((c, 'r) continuation -> 'r) option
+    = function
+    | Spawn fn ->
+      ignore (Miou.async ~orphans fn);
+      Some (fun k -> continue k ())
+    | _ -> None in
+  match_with fn orphans { retc; exnc; effc }
+
+let default_generator_already_set =
+  "Mirage_crypto_rng.default_generator has already \
+   been set (but not via Mirage_crypto_rng_miou). Please check \
+   that this is intentional"
+
+let miou_generator_already_launched =
+  "Mirage_crypto_rng_miou.initialize has already been launched \
+   and a task is already seeding the RNG."
+
+type rng = unit Miou.t
+
+let rec compare_and_set ?(backoff= Miou_backoff.default) t a b =
+  if Atomic.compare_and_set t a b = false
+  then compare_and_set ~backoff:(Miou_backoff.once backoff) t a b
+
+let rec clean_up sleep orphans = match Miou.care orphans with
+  | Some None | None -> Miou_unix.sleep (Duration.to_f sleep); clean_up sleep orphans
+  | Some (Some prm) -> Miou.await_exn prm; clean_up sleep orphans
+
+let call_if_domain_available fn =
+  let available = Miou.Domain.available () in
+  let current = (Stdlib.Domain.self () :> int) in
+  if current = 0 && available > 0
+  || current <> 0 && available > 1
+  then Miou.call fn
+  else Miou.async fn
+
+let initialize (type a) ?g ?(sleep= Duration.of_sec 1) (rng : a generator) =
+  if Atomic.compare_and_set running false true
+  then begin
+    let seed =
+      let init = Entropy.[ bootstrap; whirlwind_bootstrap; bootstrap; getrandom_init ] in
+      List.mapi (fun i fn -> fn i) init |> String.concat "" in
+    let () =
+      try let _ = default_generator () in
+          Logs.warn (fun m -> m "%s" default_generator_already_set)
+      with No_default_generator -> () in
+    let rng = create ?g ~seed ~time:Mtime_clock.elapsed_ns rng in
+    set_default_generator rng;
+    call_if_domain_available @@ fun () -> switch @@ fun orphans ->
+    rdrand sleep;
+    let source = Entropy.register_source "getrandom" in
+    getrandom (Int64.mul sleep 10L) source;
+    clean_up sleep orphans
+  end else invalid_arg miou_generator_already_launched
+
+let kill prm =
+  Miou.cancel prm;
+  compare_and_set running true false;
+  unset_default_generator ()

unikernel/duniverse/mirage-crypto/rng/miou/mirage_crypto_rng_miou_unix.mli

@@ -0,0 +1,47 @@
+(** {b RNG} seeding on {b Miou_unix}.
+
+    This module initializes a RNG with [getrandom()], and CPU RNG. On BSD system
+    (FreeBSD, OpenBSD, MacOS) [getentropy()] is used instead of [getrandom()].
+    On Windows 10 or higher, [BCryptGenRandom()] is used with the default RNG.
+    Windows 8 or lower are not supported by this library.
+*)
+
+module Pfortuna : Mirage_crypto_rng.Generator
+(** {b Pfortuna}, a {b domain-safe} CSPRNG
+    {{: https://www.schneier.com/fortuna.html} proposed} by Schneier. *)
+
+type rng
+(** Type of tasks seeding the RNG. *)
+
+val initialize : ?g:'a -> ?sleep:int64 -> 'a Mirage_crypto_rng.generator -> rng
+(** [initialize ?g ?sleep (module Generator)] will allow the RNG to operate in a
+    returned task. This task periodically launches sub-tasks that seed the
+    engine (using [getrandom()], [getentropy()] or [BCryptGenRandom()] depending
+    on the system). These sub-tasks must be cleaned periodically (in seconds)
+    according to the [sleep] parameter given (defaults to 1 second).
+
+    The user must then {!val:kill} the returned task at the end of the program
+    to be sure to clean everything. Otherwise, Miou will complain with the
+    exception [Still_has_children].
+
+    We strongly recommend using {!module:Pfortuna} as an RNG engine rather than
+    {!module:Mirage_crypto_rng.Fortuna}. The engine is launched in parallel with
+    the other tasks if at least one domain is available. To ensure that there is
+    no compromise in the values generated by a {i data-race}, [Pfortuna] is an
+    {b domain-safe} implementation of Fortuna.
+
+    The user cannot make any subsequent calls to [initialize]. In other words,
+    you can only initialise a single {!type:rng} task. You must {!val:kill} the
+    returned {!type:rng} if you want to re-initialise the RNG.
+
+    A basic usage of [mirage-crypto-rng-miou-unix] is:
+    {[
+      let () = Miou_unix.run @@ fun () ->
+        let rng = Mirage_crypto_rng_miou_unix.(initialize (module Pfortuna)) in
+        let str = Mirage_crypto_rng.generate 16 in
+        Format.printf "random: %S\n%!" str;
+        Mirage_crypto_rng_miou_unix.kill rng
+    ]} *)
+
+val kill : rng -> unit
+(** [kill rng] terminates the {i background} task which seeds the RNG. *)

unikernel/duniverse/mirage-crypto/rng/miou/pfortuna.ml

@@ -0,0 +1,137 @@
+(* Pfortuna is a re-implementation of Fortuna with a mutex. The goal of this
+   module is to provide a global and domain-safe RNG. The implementation use
+   [Miou.Mutex] instead of [Mutex] - [Pfortuna] is only available as part of
+   the [mirage-crypto-rng-miou-unix] package. Thus, in the context of Miou,
+   [Pfortuna] can be used and recommended in place of [Fortuna], so that the
+   user can generate random numbers in parallel in several domains.
+
+   {[
+     let () = Miou_unix.run @@ fun () ->
+       let rng = Mirage_crypto_rng_miou_unix.(initialize (module Pfortuna)) in
+       ...
+       Mirage_crypto_rng_miou_unix.kill rng
+   ]}
+
+   NOTE: when modifying this file, please also check whether rng/fortuna.ml
+   needs to be updated. *)
+
+open Mirage_crypto
+open Mirage_crypto.Uncommon
+
+module SHAd256 = struct
+  open Digestif
+  type ctx = SHA256.ctx
+  let empty     = SHA256.empty
+  let get t     = SHA256.(get t |> to_raw_string |> digest_string |> to_raw_string)
+  let digesti i = SHA256.(digesti_string i |> to_raw_string |> digest_string |> to_raw_string)
+  let feedi     = SHA256.feedi_string
+end
+
+let block = 16
+
+(* the minimal amount of bytes in a pool to trigger a reseed *)
+let min_pool_size = 64
+(* the minimal duration between two reseeds *)
+let min_time_duration = 1_000_000_000L
+(* number of pools *)
+let pools = 32
+
+type t =
+  { ctr          : AES.CTR.ctr
+  ; secret       : string
+  ; key          : AES.CTR.key
+  ; pools        : SHAd256.ctx array
+  ; pool0_size   : int
+  ; reseed_count : int
+  ; last_reseed  : int64
+  ; time         : (unit -> int64) option
+  }
+
+type g = Miou.Mutex.t * t ref
+
+let update (m, g) fn = Miou.Mutex.protect m @@ fun () -> g := fn !g
+let get (m, g) fn = Miou.Mutex.protect m @@ fun () -> fn !g
+
+let create ?time () =
+  let secret = String.make 32 '\000' in
+  let m = Miou.Mutex.create () in
+  let t =
+    { ctr= (0L, 0L); secret; key= AES.CTR.of_secret secret
+    ; pools= Array.make pools SHAd256.empty
+    ; pool0_size= 0
+    ; reseed_count= 0
+    ; last_reseed= 0L
+    ; time } in
+  (m, { contents= t })
+
+let seeded ~t =
+  let lo, hi = t.ctr in
+  not (Int64.equal lo 0L && Int64.equal hi 0L)
+
+let set_key ~t secret =
+  { t with secret; key= AES.CTR.of_secret secret }
+
+let reseedi ~t iter =
+  let t = set_key ~t (SHAd256.digesti (fun fn -> fn t.secret; iter fn)) in
+  { t with ctr= AES.CTR.add_ctr t.ctr 1L }
+
+let iter1 a f = f a
+let reseed ~t cs = reseedi ~t (iter1 cs)
+
+let generate_rekey ~t buf ~off len =
+  let b = len // block* 2 in
+  let n = b * block in
+  let r = AES.CTR.stream ~key:t.key ~ctr:t.ctr n in
+  Bytes.unsafe_blit_string r 0 buf off len;
+  let r2 = String.sub r (n - 32) 32 in
+  let t = set_key ~t r2 in
+  { t with ctr= AES.CTR.add_ctr t.ctr (Int64.of_int b) }
+
+let add_pool_entropy t =
+  if t.pool0_size > min_pool_size then
+    let should_reseed, now = match t.time with
+      | None -> true, 0L
+      | Some fn ->
+        let now = fn () in
+        Int64.(sub now t.last_reseed > min_time_duration), now in
+  if should_reseed then begin
+    let t = { t with reseed_count= t.reseed_count + 1
+                   ; last_reseed= now
+                   ; pool0_size= 0 } in
+    reseedi ~t @@ fun add ->
+    for i = 0 to pools - 1 do
+      if t.reseed_count land ((1 lsl i) - 1) = 0
+      then (SHAd256.get t.pools.(i) |> add; t.pools.(i) <- SHAd256.empty)
+    done
+  end else t else t
+
+let generate_into ~t buf ~off len =
+  let t = add_pool_entropy t in
+  if not (seeded ~t) then raise Mirage_crypto_rng.Unseeded_generator;
+  let rec chunk t off = function
+    | i when i <= 0 -> t
+    | n ->
+      let n' = imin n 0x10000 in
+      let t = generate_rekey ~t buf ~off n' in
+      chunk t (off + n') (n - n') in
+  chunk t off len
+
+let add ~t source ~pool data =
+  let buf = Bytes.create 2
+  and pool = pool land (pools - 1)
+  and source = Mirage_crypto_rng.Entropy.id source land 0xff in
+  Bytes.set_uint8 buf 0 source;
+  Bytes.set_uint8 buf 1 (String.length data);
+  t.pools.(pool) <- SHAd256.feedi t.pools.(pool) (iter2 (Bytes.unsafe_to_string buf) data);
+  if pool = 0 then { t with pool0_size= t.pool0_size + String.length data } else t
+
+let accumulate ~g source =
+  let pool = ref 0 in
+  `Acc (fun buf ->
+     update g @@ fun t ->
+     let t = add ~t source ~pool:!pool buf in
+     incr pool; t)
+
+let reseed ~g cs = update g @@ fun t -> reseed ~t cs
+let generate_into ~g buf ~off len = update g @@ fun t -> generate_into ~t buf ~off len
+let seeded ~g = get g @@ fun t -> seeded ~t

unikernel/duniverse/mirage-crypto/rng/miou/pfortuna.mli

@@ -0,0 +1 @@
+include Mirage_crypto_rng.Generator

unikernel/duniverse/mirage-crypto/rng/mirage/dune

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

unikernel/duniverse/mirage-crypto/rng/mirage/mirage_crypto_rng_mirage.ml

@@ -0,0 +1,73 @@
+(*
+ * Copyright (c) 2014 Hannes Mehnert
+ * Copyright (c) 2014 Anil Madhavapeddy <anil@recoil.org>
+ * Copyright (c) 2014-2016 David Kaloper Meršinjak
+ * Copyright (c) 2015 Citrix Systems Inc
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * * Redistributions of source code must retain the above copyright notice, this
+ *   list of conditions and the following disclaimer.
+ *
+ * * Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+ * DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+ * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+ * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+ * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+ * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+let src = Logs.Src.create "mirage-crypto-rng-mirage" ~doc:"Mirage crypto RNG mirage"
+module Log = (val Logs.src_log src : Logs.LOG)
+
+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 ();
+          Mirage_sleep.ns delta >>=
+          one
+        in
+        one ())
+
+let bootstrap_functions () =
+  Entropy.[ bootstrap ; bootstrap ; whirlwind_bootstrap ; bootstrap ]
+
+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: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

unikernel/duniverse/mirage-crypto/rng/mirage/mirage_crypto_rng_mirage.mli

@@ -0,0 +1,35 @@
+(*
+ * Copyright (c) 2014 Hannes Mehnert
+ * Copyright (c) 2014 Anil Madhavapeddy <anil@recoil.org>
+ * Copyright (c) 2014-2016 David Kaloper Meršinjak
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * * Redistributions of source code must retain the above copyright notice, this
+ *   list of conditions and the following disclaimer.
+ *
+ * * Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+ * DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+ * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+ * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+ * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+ * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+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. *)

unikernel/duniverse/mirage-crypto/rng/mirage_crypto_rng.ml

@@ -0,0 +1,5 @@
+include Rng
+
+module Fortuna = Fortuna
+module Hmac_drbg = Hmac_drbg.Make
+module Entropy = Entropy

unikernel/duniverse/mirage-crypto/rng/mirage_crypto_rng.mli

@@ -0,0 +1,303 @@
+(** {1 Randomness} *)
+
+(** Secure random number generation.
+
+    There are several parts of this module:
+
+    {ul
+    {- The {{!Generator}signature} of generator modules, together with a
+       facility to convert such modules into actual {{!g}generators}, and
+       functions that operate on this representation.}
+    {- A global generator instance, which needs to be initialized by calling
+       {!set_default_generator}.}}
+*)
+
+(** {1 Usage notes} *)
+
+(** {b TL;DR} Don't forget to seed; don't maintain your own [g].
+
+    For common operations on Unix (independent of your asynchronous task
+    library, you can use /dev/urandom or getentropy(3) (actually getrandom(3) on
+    Linux, getentropy() on macOS and BSD systems, BCryptGenRandom on Windows).
+
+    Please ensure to call [Mirage_crypto_rng_unix.use_default], or
+    [Mirage_crypto_rng_unix.use_dev_urandom] (if you only want to use
+    /dev/urandom), or [Mirage_crypto_rng_unix.use_getentropy] (if you only want
+    to use getrandom/getentropy/BCryptGenRandom).
+
+    For fine-grained control (doing entropy harvesting, etc.), please continue
+    reading the documentation below. {b Please be aware that the feeding of
+    Fortuna and producing random numbers is not thread-safe} (it is on Miou_unix
+    via Pfortuna).
+
+    Suitable entropy feeding of generators are provided by other libraries
+    {{!Mirage_crypto_rng_mirage}mirage-crypto-rng-mirage} (for MirageOS),
+    and {{!Mirage_crypto_rng_miou_unix}mirage-crypto-miou-unix} (for Miou_unix).
+
+    The intention is that "initialize" in the respective sub-library is called
+    once, which sets the default generator and registers entropy
+    harvesting asynchronous tasks. The semantics is that the entropy is always
+    fed to the {{!default_generator}default generator}, which is not necessarily
+    the one set by "initialize". The reasoning behind this is that the default
+    generator should be used in most setting, and that should be fed a constant
+    stream of entropy.
+
+    The RNGs here are merely the deterministic part of a full random number
+    generation suite. For proper operation, they need to be seeded with a
+    high-quality entropy source.
+
+    Although this module exposes a more fine-grained interface, e.g. allowing
+    manual seeding of generators, this is intended either for implementing
+    entropy-harvesting modules, or very specialized purposes. Users of this
+    library should almost certainly use one of the above entropy libraries, and
+    avoid manually managing the generator seeding.
+
+    Similarly, although it is possible to swap the default generator and gain
+    control over the random stream, this is also intended for specialized
+    applications such as testing or similar scenarios where the RNG needs to be
+    fully deterministic (RFC 6979, deterministic usage of DSA), or as a
+    component of deterministic algorithms which internally rely on pseudorandom
+    streams.
+
+    In the general case, users should not maintain their local instances of
+    {{!g}g}. All of the generators in a process have to compete for entropy, and
+    it is likely that the overall result will have lower effective
+    unpredictability.
+
+    The recommended way to use these functions is either to accept an optional
+    generator and pass it down, or to ignore the generator altogether, as
+    illustrated in the {{!rng_examples}examples}.
+*)
+
+(** {1 Interface} *)
+
+type g
+(** A generator (PRNG) with its state. *)
+
+exception Unseeded_generator
+(** Thrown when using an uninitialized {{!g}generator}. *)
+
+exception No_default_generator
+(** Thrown when {!set_default_generator} has not been called. *)
+
+(** Entropy sources and collection *)
+module Entropy : sig
+
+  (** Entropy sources. *)
+  type 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. *)
+
+  (** {1 Bootstrap} *)
+
+  val whirlwind_bootstrap : int -> string
+  (** [whirlwind_bootstrap id] exploits CPU-level data races which lead to
+      execution-time variability. It returns 200 bytes random data prefixed
+      by [id].
+
+      See {{:http://www.ieee-security.org/TC/SP2014/papers/Not-So-RandomNumbersinVirtualizedLinuxandtheWhirlwindRNG.pdf}}
+      for further details. *)
+
+  val cpu_rng_bootstrap : (int -> string, [`Not_supported]) Result.t
+  (** [cpu_rng_bootstrap id] returns 8 bytes of random data using the CPU
+      RNG (rdseed). On 32bit platforms, only 4 bytes are filled.
+      The [id] is used as prefix. If only rdrand is available, the return
+      value is the concatenation of 512 calls to rdrand.
+
+      @raise Failure if rdrand fails 512 times, or if rdseed fails and rdrand
+      is not available.
+  *)
+
+  val bootstrap : int -> string
+  (** [bootstrap id] is either [cpu_rng_bootstrap], if the CPU supports it, or
+      [whirlwind_bootstrap] if not. *)
+
+  (** {1 Timer source} *)
+
+  val interrupt_hook : unit -> string
+  (** [interrupt_hook] collects lower bytes from the cycle counter, to be
+      used for entropy collection in the event loop. *)
+
+  val timer_accumulator : g option -> unit -> unit
+  (** [timer_accumulator g] is the accumulator for the timer source,
+      applying {!interrupt_hook} on each call. *)
+
+  (** {1 Periodic pulled sources} *)
+
+  val feed_pools : g option -> source -> (unit -> (string, [ `No_random_available ]) result) -> unit
+  (** [feed_pools g source f] feeds all pools of [g] using [source] by executing
+      [f] for each pool. *)
+
+  val cpu_rng : (g option -> unit -> unit, [`Not_supported]) Result.t
+  (** [cpu_rng g] uses the CPU RNG (rdrand or rdseed) to feed all pools
+      of [g]. It uses {!feed_pools} internally. If neither rdrand nor rdseed
+      are available, [`Not_supported] is returned. *)
+
+  val rdrand_calls : unit -> int
+  (** [rdrand_calls ()] returns the number of rdrand calls. *)
+
+  val rdrand_failures : unit -> int
+  (** [rdrand_failures ()] returns the number of rdrand failures. *)
+
+  val rdseed_calls : unit -> int
+  (** [rdseed_calls ()] returns the number of rdseed calls. *)
+
+  val rdseed_failures : unit -> int
+  (** [rdseed_failures ()] returns the number of rdseed failures. *)
+
+  (**/**)
+  val id : source -> int
+  (** [id source] is the identifier used for [source]. *)
+
+  val header : int -> string -> string
+  (** [header id data] constructs a unique header with [id], length of [data],
+      and [data]. *)
+  (**/**)
+end
+
+(** A single PRNG algorithm. *)
+module type Generator = sig
+
+  type g
+  (** State type for this generator. *)
+
+  val block : int
+  (** Internally, this generator's {{!generate}generate} always produces
+      [k * block] bytes. *)
+
+  val create : ?time:(unit -> int64) -> unit -> g
+  (** Create a new, unseeded {{!g}g}. *)
+
+  val generate_into : g:g -> bytes -> off:int -> int -> unit
+  [@@alert unsafe "Does not do bounds checks. Use Mirage_crypto_rng.generate_into instead."]
+  (** [generate_into ~g buf ~off n] produces [n] uniformly distributed random
+      bytes into [buf] at offset [off], updating the state of [g].
+
+      Assumes that [buf] is at least [off + n] bytes long. Also assumes that
+      [off] and [n] are positive integers. Caution: do not use in your
+      application, use [Mirage_crypto_rng.generate_into] instead.
+  *)
+
+  val reseed : g:g -> string -> unit
+  (** [reseed ~g bytes] directly updates [g]. Its new state depends both on
+      [bytes] and the previous state.
+
+      A generator is seded after a single application of [reseed]. *)
+
+  val accumulate : g:g -> Entropy.source -> [`Acc of string -> unit]
+  (** [accumulate ~g] is a closure suitable for incrementally feeding
+      small amounts of environmentally sourced entropy into [g].
+
+      Its operation should be fast enough for repeated calling from e.g.
+      event loops. Systems with several distinct, stable entropy sources
+      should use stable [source] to distinguish their sources. *)
+
+  val seeded : g:g -> bool
+  (** [seeded ~g] is [true] iff operations won't throw
+      {{!Unseeded_generator}Unseeded_generator}. *)
+
+  val pools : int
+  (** [pools] is the amount of pools if any. *)
+end
+
+type 'a generator = (module Generator with type g = 'a)
+
+(** Ready-to-use RNG algorithms. *)
+
+(** {b Fortuna}, a CSPRNG {{: https://www.schneier.com/fortuna.html} proposed}
+    by Schneier. *)
+module Fortuna : Generator
+
+(** {b HMAC_DRBG}: A NIST-specified RNG based on HMAC construction over the
+    provided hash. *)
+module Hmac_drbg (H : Digestif.S) : Generator
+
+val create : ?g:'a -> ?seed:string -> ?strict:bool ->
+  ?time:(unit -> int64) -> 'a generator -> g
+(** [create ~g ~seed ~strict ~time module] uses a module conforming to the
+    {{!Generator}Generator} signature to instantiate the generic generator
+    {{!g}g}.
+
+    [g] is the state to use, otherwise a fresh one is created.
+
+    [seed] can be provided to immediately reseed the generator with.
+
+    [strict] puts the generator into a more standards-conformant, but slighty
+    slower mode. Useful if the outputs need to match published test-vectors.
+
+    [time] is used to limit the amount of reseedings. Fortuna uses at most once
+    every second. *)
+
+val default_generator : unit -> g
+(** [default_generator ()] is the default generator. Functions in this module
+    use this generator when not explicitly supplied one.
+
+    @raise No_default_generator if {!set_default_generator} has not been called. *)
+
+val set_default_generator : g -> unit
+(** [set_default_generator g] sets the default generator to [g]. This function
+    must be called once. *)
+
+(**/**)
+(* This function is only used by eio to set the default generator to None when
+   the entropy harvesting tasks are finished. *)
+val unset_default_generator : unit -> unit
+(** [unset_default_generator ()] sets the default generator to [None]. *)
+(**/**)
+
+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.
+
+    @raise Invalid_argument if buffer is too small (it must be: [Bytes.length
+      buf - off >= n]) or [off] or [n] are negative.
+*)
+
+val generate : ?g:g -> int -> string
+(** Invoke {!generate_into} on [g] or {{!generator}default generator} and a
+    freshly allocated string. *)
+
+val block : g option -> int
+(** {{!Generator.block}Block} size of [g] or
+    {{!generator}default generator}. *)
+
+(**/**)
+
+(* The following functions expose the seeding interface. They are meant to
+ * connect the RNG with entropy-providing libraries and subject to change.
+ * Client applications should not use them directly. *)
+
+val reseed     : ?g:g -> string -> unit
+val accumulate : g option -> Entropy.source -> [`Acc of string -> unit]
+val seeded     : g option -> bool
+val pools      : g option -> int
+val strict : g option -> bool
+(**/**)
+
+
+(** {1:rng_examples Examples}
+
+    Generating a random 13-byte string:
+{[let cs = Rng.generate 13]}
+
+    Generating a list of string, passing down an optional {{!g}generator}:
+{[let rec f1 ?g ~n i =
+  if i < 1 then [] else Rng.generate ?g n :: f1 ?g ~n (i - 1)]}
+
+    Generating a [Z.t] smaller than [10]:
+{[let f2 ?g () = Mirage_crypto_pk.Z_extra.gen ?g Z.(~$10)]}
+
+    Creating a local Fortuna instance and using it as a key-derivation function:
+{[let f3 secret =
+  let g = Rng.(create ~seed:secret (module Generators.Fortuna)) in
+  Rng.generate ~g 32]}
+*)

unikernel/duniverse/mirage-crypto/rng/rng.ml

@@ -0,0 +1,99 @@
+type source = int * string
+
+exception Unseeded_generator
+
+exception No_default_generator
+
+let setup_rng =
+  "\nPlease setup your default random number generator. On Unix, the best \
+   path is to call [Mirage_crypto_rng_unix.use_default ()].\
+   \nBut you can use Fortuna (or any other RNG) and setup the seeding \
+   (done by default in MirageOS): \
+   \n\
+   \nTo initialize the RNG with a default generator, and set up entropy \
+   collection and periodic reseeding as a background task, do the \
+   following:\
+   \n  If you are using MirageOS, use the random device in config.ml: \
+   `let main = Mirage.main \"Unikernel.Main\" (random @-> job)`, \
+   and `let () = register \"my_unikernel\" [main $ default_random]`. \
+   \n  If you are using miou, execute \
+   `Mirage_crypto_rng_miou_unix.initialize (module Mirage_crypto_rng.Fortuna)` \
+   at startup."
+
+let () = Printexc.register_printer (function
+    | Unseeded_generator ->
+      Some ("The RNG has not been seeded." ^ setup_rng)
+    | No_default_generator ->
+      Some ("The default generator is not yet initialized. " ^ setup_rng)
+    | _ -> None)
+
+module type Generator = sig
+  type g
+  val block : int
+  val create : ?time:(unit -> int64) -> unit -> g
+  val generate_into : g:g -> bytes -> off:int -> int -> unit
+  [@@alert unsafe "Does not do bounds checks. Use Mirage_crypto_rng.generate_into instead."]
+  val reseed : g:g -> string -> unit
+  val accumulate : g:g -> source -> [`Acc of string -> unit]
+  val seeded : g:g -> bool
+  val pools : int
+end
+
+type 'a generator = (module Generator with type g = 'a)
+type g = Generator : ('a * bool * 'a generator) -> g
+
+let create (type a) ?g ?seed ?(strict=false) ?time (m : a generator) =
+  let module M = (val m) in
+  let g = Option.value g ~default:(M.create ?time ()) in
+  Option.iter (M.reseed ~g) seed;
+  Generator (g, strict, m)
+
+let _default_generator = Atomic.make None
+
+let set_default_generator g = Atomic.set _default_generator (Some g)
+
+let unset_default_generator () = Atomic.set _default_generator None
+
+let default_generator () =
+  match Atomic.get _default_generator with
+  | None -> raise No_default_generator
+  | Some g -> g
+
+let get = function Some g -> g | None -> default_generator ()
+
+let generate_into ?(g = default_generator ()) b ?(off = 0) n =
+  let Generator (g, _, m) = g in
+  let module M = (val m) in
+  if off < 0 || n < 0 then
+    invalid_arg ("negative offset " ^ string_of_int off ^ " or length " ^
+                 string_of_int n);
+  if Bytes.length b - off < n then
+    invalid_arg "buffer too short";
+  begin[@alert "-unsafe"]
+    M.generate_into ~g b ~off n
+  end
+
+let generate ?g n =
+  let data = Bytes.create n in
+  generate_into ?g data ~off:0 n;
+  Bytes.unsafe_to_string data
+
+let reseed ?(g = default_generator ()) cs =
+  let Generator (g, _, m) = g in let module M = (val m) in M.reseed ~g cs
+
+let accumulate g source =
+  let Generator (g, _, m) = get g in
+  let module M = (val m) in
+  M.accumulate ~g source
+
+let seeded g =
+  let Generator (g, _, m) = get g in let module M = (val m) in M.seeded ~g
+
+let block g =
+  let Generator (_, _, m) = get g in let module M = (val m) in M.block
+
+let pools g =
+  let Generator (_, _, m) = get g in let module M = (val m) in M.pools
+
+let strict g =
+  let Generator (_, s, _) = get g in s

unikernel/duniverse/mirage-crypto/rng/unix/discover.ml

@@ -0,0 +1,10 @@
+let () =
+  let open Configurator.V1 in
+  main ~name:"rng_flags" (fun _t ->
+    let c_lib_flags =
+      match Sys.os_type with
+      | "Win32" | "Cygwin" -> ["-lbcrypt"]
+      | _ -> []
+    in
+    Flags.write_sexp "rng_c_flags.sexp" c_lib_flags
+  )

unikernel/duniverse/mirage-crypto/rng/unix/dune

@@ -0,0 +1,30 @@
+(executable
+ (name discover)
+ (modules discover)
+ (libraries dune-configurator))
+
+(rule
+ (targets rng_c_flags.sexp)
+ (action
+  (run ./discover.exe)))
+
+(rule
+ (targets cflags_warn.sexp)
+ (action
+  (run ../../config/cfg.exe)))
+
+(library
+ (name mirage_crypto_rng_unix)
+ (public_name mirage-crypto-rng.unix)
+ (modules mirage_crypto_rng_unix urandom getentropy)
+ (libraries mirage-crypto-rng unix logs threads.posix)
+ (foreign_stubs
+  (language c)
+  (include_dirs ../../src/native)
+  (names mc_getrandom_stubs))
+ (c_library_flags
+  (:include rng_c_flags.sexp)))
+
+(env
+ (dev
+  (c_flags (:include cflags_warn.sexp))))

unikernel/duniverse/mirage-crypto/rng/unix/getentropy.ml

@@ -0,0 +1,25 @@
+
+external getrandom_buf : bytes -> int -> int -> unit = "mc_getrandom" [@@noalloc]
+
+type g = unit
+
+(* The maximum value for length is GETENTROPY_MAX for `getentropy`: https://pubs.opengroup.org/onlinepubs/9799919799/functions/getentropy.html
+    The minimum acceptable value for GETENTROPY_MAX is 256 https://pubs.opengroup.org/onlinepubs/9799919799/basedefs/limits.h.html
+
+    The actual implementation may be one of `getrandom`, `getentropy`, or `BCryptGenRandom`, and will internally limit the maximum bytes read in one go and loop as needed if more bytes are requested and we get a short read.
+  *)
+let block = 256
+
+let create ?time:_ () = ()
+
+let generate_into ~g:_ buf ~off len =
+  getrandom_buf buf off len
+
+let reseed ~g:_ _data = ()
+
+let accumulate ~g:_ _source =
+  `Acc (fun _data -> ())
+
+let seeded ~g:_ = true
+
+let pools = 0

unikernel/duniverse/mirage-crypto/rng/unix/mc_getrandom_stubs.c

@@ -0,0 +1,87 @@
+#ifndef _MSC_VER
+# include <unistd.h>
+#endif
+
+#include "mirage_crypto.h"
+
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/unixsupport.h>
+#include <caml/bigarray.h>
+
+#if defined(__ANDROID_API__) && __ANDROID_API__ < 28
+// on Android 27 and earlier, we use Google's <sys/random.h> recommended arc4random_buf
+# include <stdlib.h>
+
+void raw_getrandom (uint8_t *data, size_t len) {
+  arc4random_buf(data, len);
+}
+#elif defined(__linux) || defined(__GNU__)
+# include <errno.h>
+// on Linux and GNU/Hurd, we use getrandom and loop
+
+# if __GLIBC__ && __GLIBC__ <= 2 && __GLIBC_MINOR__ < 25
+# include <sys/syscall.h>
+# define getrandom(buf, len, flags) syscall(SYS_getrandom, (buf), (len), (flags))
+# else
+# include <sys/random.h>
+# define getrandom(buf, len, flags) getrandom((buf), (len), (flags))
+# endif
+
+void raw_getrandom (uint8_t *data, size_t len) {
+  size_t off = 0;
+  ssize_t r = 0;
+  while (off < len) {
+    r = getrandom(data + off, len - off, 0);
+    if (r == -1) {
+      if (errno == EINTR) continue;
+      else uerror("getrandom", Nothing);
+    }
+    off += (size_t)r;
+  }
+}
+#elif (defined(__FreeBSD__) || defined(__FreeBSD_kernel__) || defined(__DragonFly__)  || defined(__OpenBSD__) || defined(__APPLE__)) || defined(__NetBSD__)
+// on BSD and macOS, loop (in pieces of 256) getentropy
+#if defined(__APPLE__)
+// on macOS, getentropy is defined in sys/random.h (on BSD in unistd.h)
+#include <sys/random.h>
+#endif
+#include <sys/param.h>
+
+void raw_getrandom (uint8_t *data, size_t len) {
+  size_t rlen = 0;
+  for (size_t i = 0; i <= len; i += 256) {
+    rlen = MIN(256, len - i);
+    if (getentropy(data + i, rlen) == -1) uerror("getentropy", Nothing);
+  }
+}
+#elif (defined(_WIN32))
+/* There is a choice between using RtlGenRandom and BCryptGenRandom
+ * here, and Microsoft does not make the choice obvious. It appears
+ * that RtlGenRandom is best used when older Windows compatibility
+ * is of concern, but requires some gymnastics around binding it
+ * with the right calling convention.
+ *
+ * Therefore (https://github.com/mirage/mirage-crypto/pull/39) we
+ * have decided to go with the more modern Windows API with bcrypt,
+ * and make Windows 10 our minimum supported version of mirage-crypto.
+ */
+#include <windows.h>
+#include <ntstatus.h>
+#include <bcrypt.h>
+
+void raw_getrandom(uint8_t *data, size_t len) {
+   NTSTATUS Status;
+   Status = BCryptGenRandom(NULL, data, len, BCRYPT_USE_SYSTEM_PREFERRED_RNG);
+   if (Status != STATUS_SUCCESS)
+     uerror("BCryptGenRandom", Nothing);
+}
+
+#else
+#error "Retrieving random data not supported on this platform"
+#endif
+
+CAMLprim value mc_getrandom (value buf, value off, value len) {
+  raw_getrandom(_bp_uint8_off(buf, off), Long_val(len));
+  return Val_unit;
+}

unikernel/duniverse/mirage-crypto/rng/unix/mirage_crypto_rng_unix.ml

@@ -0,0 +1,57 @@
+open Mirage_crypto_rng
+
+module Urandom = Urandom
+
+module Getentropy = Getentropy
+
+let use_dev_urandom () =
+  let g = create (module Urandom) in
+  set_default_generator g
+
+let use_getentropy () =
+  let g = create (module Getentropy) in
+  set_default_generator g
+
+let use_default () = use_getentropy ()
+
+let src = Logs.Src.create "mirage-crypto-rng.unix" ~doc:"Mirage crypto RNG Unix"
+module Log = (val Logs.src_log src : Logs.LOG)
+
+external getrandom_buf : bytes -> int -> int -> unit = "mc_getrandom" [@@noalloc]
+
+let getrandom_into buf ~off ~len =
+  getrandom_buf buf off len
+
+let getrandom size =
+  let buf = Bytes.create size in
+  getrandom_into buf ~off:0 ~len:size;
+  Bytes.unsafe_to_string buf
+
+let getrandom_init i =
+  let data = getrandom 128 in
+  Entropy.header i data
+
+let running = Atomic.make false
+
+let initialize (type a) ?g (rng : a generator) =
+  if Atomic.get running then
+    Log.debug
+      (fun m -> m "Mirage_crypto_rng_unix.initialize has already been called, \
+                   ignoring this call.")
+  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 -> ());
+    Atomic.set running true ;
+    let seed =
+      let init =
+        Entropy.[ bootstrap ; whirlwind_bootstrap ; bootstrap ; getrandom_init ]
+      in
+      List.mapi (fun i f -> f i) init |> String.concat ""
+    in
+    let _ = Entropy.register_source "getrandom" in
+    set_default_generator (create ?g ~seed rng)
+  end

unikernel/duniverse/mirage-crypto/rng/unix/mirage_crypto_rng_unix.mli

@@ -0,0 +1,36 @@
+(** {b RNG} seeding on {b Unix}.
+
+    This module initializes a Fortuna RNG with [getrandom()], and CPU RNG.
+    On BSD systems (FreeBSD, OpenBSD, macOS) [getentropy ()] is used instead
+    of [getrandom ()]. On Windows 10 or higher, [BCryptGenRandom()] is used
+    with the default RNG. Windows 8 or lower are not supported by this library.
+*)
+
+(** [initialize ~g rng] will bring the RNG into a working state. *)
+val initialize : ?g:'a -> 'a Mirage_crypto_rng.generator -> unit
+[@@deprecated "Use 'Mirage_crypto_rng_unix.use_default ()' instead."]
+
+(** [getrandom size] returns a buffer of [size] filled with random bytes. *)
+val getrandom : int -> string
+
+(** A generator that opens /dev/urandom and reads from that file descriptor
+    data whenever random data is needed. The file descriptor is closed in
+    [at_exit]. *)
+module Urandom : Mirage_crypto_rng.Generator
+
+(** A generator using [getrandom(3)] on Linux, [getentropy(3)] on BSD and macOS,
+    and [BCryptGenRandom()] on Windows. *)
+module Getentropy : Mirage_crypto_rng.Generator
+
+(** [use_default ()] initializes the RNG [Mirage_crypto_rng.default_generator]
+    with a sensible default, at the moment using [Getentropy]. *)
+val use_default : unit -> unit
+
+(** [use_dev_random ()] initializes the RNG
+    [Mirage_crypto_rng.default_generator] with the [Urandom] generator. This
+    raises an exception if "/dev/urandom" cannot be opened. *)
+val use_dev_urandom : unit -> unit
+
+(** [use_getentropy ()] initializes the RNG [Mirage_crypto_rng.default_generator]
+    with the [Getentropy] generator. *)
+val use_getentropy : unit -> unit

unikernel/duniverse/mirage-crypto/rng/unix/urandom.ml

@@ -0,0 +1,29 @@
+
+type g = In_channel.t * Mutex.t
+
+(* The OCaml runtime always reads at least IO_BUFFER_SIZE from an input channel, which is currently 64 KiB *)
+let block = 65536
+
+let create ?time:_ () =
+  let ic = In_channel.open_bin "/dev/urandom"
+  and mutex = Mutex.create ()
+  in
+  at_exit (fun () -> In_channel.close ic);
+  (ic, mutex)
+
+let generate_into ~g:(ic, m) buf ~off len =
+  let finally () = Mutex.unlock m in
+  Mutex.lock m;
+  Fun.protect ~finally (fun () ->
+      match In_channel.really_input ic buf off len with
+      | None -> failwith "couldn't read enough bytes from /dev/urandom"
+      | Some () -> ())
+
+let reseed ~g:_ _data = ()
+
+let accumulate ~g:_ _source =
+  `Acc (fun _data -> ())
+
+let seeded ~g:_ = true
+
+let pools = 0