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