provide new generators: urandom and getentropy

.cirrus.yml

@@ -4,7 +4,6 @@ freebsd_instance:
 freebsd_task:
   env:
     matrix:
-      - OCAML_VERSION: 4.13.1
       - OCAML_VERSION: 4.14.2
 
   pkg_install_script: pkg install -y ocaml-opam gmp gmake pkgconf bash

.github/workflows/test.yml

@@ -9,17 +9,17 @@ jobs:
     strategy:
       fail-fast: false
       matrix:
-        ocaml-version: ["4.14.2", "4.13.1"]
+        ocaml-version: ["4.14.2"]
         operating-system: [macos-latest, ubuntu-latest]
 
     runs-on: ${{ matrix.operating-system }}
 
     steps:
       - name: Checkout code
-        uses: actions/checkout@v2
+        uses: actions/checkout@v4
 
       - name: Use OCaml ${{ matrix.ocaml-version }}
-        uses: ocaml/setup-ocaml@v2
+        uses: ocaml/setup-ocaml@v3
         with:
           opam-local-packages: |
             *.opam
@@ -42,17 +42,17 @@ jobs:
     strategy:
       fail-fast: false
       matrix:
-        ocaml-version: ["5.0.0"]
+        ocaml-version: ["5.2.1"]
         operating-system: [macos-latest, ubuntu-latest]
 
     runs-on: ${{ matrix.operating-system }}
 
     steps:
       - name: Checkout code
-        uses: actions/checkout@v2
+        uses: actions/checkout@v4
 
       - name: Use OCaml ${{ matrix.ocaml-version }}
-        uses: ocaml/setup-ocaml@v2
+        uses: ocaml/setup-ocaml@v3
         with:
           opam-local-packages: |
             mirage-crypto.opam

.github/workflows/windows.yml

@@ -9,17 +9,17 @@ jobs:
     strategy:
       fail-fast: false
       matrix:
-        ocaml-version: ["4.14.2", "4.13.1"]
+        ocaml-version: ["4.14.2"]
         operating-system: [windows-latest]
 
     runs-on: ${{ matrix.operating-system }}
 
     steps:
       - name: Checkout code
-        uses: actions/checkout@v2
+        uses: actions/checkout@v4
 
       - name: Use OCaml ${{ matrix.ocaml-compiler }}
-        uses: ocaml/setup-ocaml@v2
+        uses: ocaml/setup-ocaml@v3
         with:
           opam-repositories: |
             opam-repository-mingw: https://github.com/ocaml-opam/opam-repository-mingw.git#sunset

bench/speed.ml

@@ -480,12 +480,22 @@ let benchmarks = [
     throughput_into name (fun dst cs -> DES.ECB.unsafe_encrypt_into ~key cs ~src_off:0 dst ~dst_off:0 (String.length cs))) ;
 
   bm "fortuna" (fun name ->
-    let open Mirage_crypto_rng.Fortuna in
-    let g = create () in
-    reseed ~g "abcd" ;
+    Mirage_crypto_rng_unix.initialize (module Mirage_crypto_rng.Fortuna);
     throughput name (fun buf ->
         let buf = Bytes.unsafe_of_string buf in
-        generate_into ~g buf ~off:0 (Bytes.length buf))) ;
+        Mirage_crypto_rng.generate_into buf ~off:0 (Bytes.length buf))) ;
+
+  bm "getentropy" (fun name ->
+    Mirage_crypto_rng_unix.use_getentropy ();
+    throughput name (fun buf ->
+        let buf = Bytes.unsafe_of_string buf in
+        Mirage_crypto_rng.generate_into buf ~off:0 (Bytes.length buf))) ;
+
+  bm "urandom" (fun name ->
+    Mirage_crypto_rng_unix.use_dev_urandom ();
+    throughput name (fun buf ->
+        let buf = Bytes.unsafe_of_string buf in
+        Mirage_crypto_rng.generate_into buf ~off:0 (Bytes.length buf))) ;
 ]
 
 let help () =

mirage-crypto-rng.opam

@@ -13,7 +13,7 @@ build: [ ["dune" "subst"] {dev}
          ["dune" "runtest" "-p" name "-j" jobs] {with-test} ]
 
 depends: [
-  "ocaml" {>= "4.13.0"}
+  "ocaml" {>= "4.14.0"}
   "dune" {>= "2.7"}
   "dune-configurator" {>= "2.0.0"}
   "duration"

rng/mirage_crypto_rng.mli

@@ -16,6 +16,19 @@
 
 (** {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 getentropy).
+
+    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).
+
     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.
@@ -156,10 +169,13 @@ module type Generator = sig
   (** 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].
 
-      @raise Invalid_argument if buffer is too small (it must be: Bytes.length buf - off >= n)
+      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
@@ -233,7 +249,11 @@ 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. *)
+    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

rng/rng.ml

@@ -5,7 +5,12 @@ exception Unseeded_generator
 exception No_default_generator
 
 let setup_rng =
-  "\nTo initialize the RNG with a default generator, and set up entropy \
+  "\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: \
@@ -37,6 +42,7 @@ module type Generator = sig
   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
@@ -68,9 +74,14 @@ 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";
-  M.generate_into ~g b ~off n
+  begin[@alert "-unsafe"]
+    M.generate_into ~g b ~off n
+  end
 
 let generate ?g n =
   let data = Bytes.create n in

rng/unix/dune

@@ -16,10 +16,11 @@
 (library
  (name mirage_crypto_rng_unix)
  (public_name mirage-crypto-rng.unix)
- (modules mirage_crypto_rng_unix)
- (libraries mirage-crypto-rng unix logs)
+ (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)))

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

rng/unix/mc_getrandom_stubs.c

@@ -2,6 +2,8 @@
 # include <unistd.h>
 #endif
 
+#include "mirage_crypto.h"
+
 #include <caml/mlvalues.h>
 #include <caml/memory.h>
 #include <caml/unixsupport.h>
@@ -19,7 +21,7 @@
 # define getrandom(buf, len, flags) getrandom((buf), (len), (flags))
 # endif
 
-void raw_getrandom (uint8_t *data, uint32_t len) {
+void raw_getrandom (uint8_t *data, size_t len) {
   size_t off = 0;
   ssize_t r = 0;
   while (off < len) {
@@ -39,9 +41,9 @@ void raw_getrandom (uint8_t *data, uint32_t len) {
 #endif
 #include <sys/param.h>
 
-void raw_getrandom (uint8_t *data, uint32_t len) {
+void raw_getrandom (uint8_t *data, size_t len) {
   size_t rlen = 0;
-  for (uint32_t i = 0; i <= len; i += 256) {
+  for (size_t i = 0; i <= len; i += 256) {
     rlen = MIN(256, len - i);
     if (getentropy(data + i, rlen) == -1) uerror("getentropy", Nothing);
   }
@@ -61,7 +63,7 @@ void raw_getrandom (uint8_t *data, uint32_t len) {
 #include <ntstatus.h>
 #include <bcrypt.h>
 
-void raw_getrandom(uint8_t *data, uint32_t len) {
+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)
@@ -72,7 +74,7 @@ void raw_getrandom(uint8_t *data, uint32_t len) {
 #error "Retrieving random data not supported on this platform"
 #endif
 
-CAMLprim value mc_getrandom (value buf, value len) {
-  raw_getrandom(Bytes_val(buf), Int_val(len));
+CAMLprim value mc_getrandom (value buf, value off, value len) {
+  raw_getrandom(_bp_uint8_off(buf, off), Long_val(len));
   return Val_unit;
 }

rng/unix/mirage_crypto_rng_unix.ml

@@ -1,13 +1,30 @@
 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 -> unit = "mc_getrandom" [@@noalloc]
+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_buf buf size;
+  getrandom_into buf ~off:0 ~len:size;
   Bytes.unsafe_to_string buf
 
 let getrandom_init i =

rng/unix/mirage_crypto_rng_unix.mli

@@ -11,3 +11,25 @@ val initialize : ?g:'a -> 'a Mirage_crypto_rng.generator -> unit
 
 (** [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

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

tests/dune

@@ -41,7 +41,9 @@
  (name test_entropy)
  (modules test_entropy)
  (package mirage-crypto-rng)
- (libraries mirage-crypto-rng ohex))
+ (libraries mirage-crypto-rng ohex)
+ (enabled_if (<> %{architecture} "arm64")))
+ ; see https://github.com/mirage/mirage-crypto/issues/216
 
 (test
  (name test_ec)

tests/test_ec.ml

@@ -861,7 +861,7 @@ df f8 a0 4f d3 dd 1d f0  07 78 3a 2f 29 d6 61 61
   | Error _ -> Alcotest.fail "regression failed"
 
 let () =
-  Mirage_crypto_rng_unix.initialize (module Mirage_crypto_rng.Fortuna);
+  Mirage_crypto_rng_unix.use_default ();
   Alcotest.run "EC"
     [
       ("P256 Key exchange", key_exchange);

tests/test_pk_runner.ml

@@ -9,5 +9,5 @@ let suite =
   ]
 
 let () =
-  Mirage_crypto_rng_unix.initialize (module Mirage_crypto_rng.Fortuna);
+  Mirage_crypto_rng_unix.use_default ();
   run_test_tt_main suite