provide new generators: urandom and getentropy

bench/dune

@@ -2,7 +2,7 @@
  (names speed)
  (modules speed)
  (libraries mirage-crypto mirage-crypto-rng mirage-crypto-rng.unix
-   mirage-crypto-pk mirage-crypto-ec))
+   mirage-crypto-pk mirage-crypto-ec mirage-crypto-rng-miou-unix threads.posix))
 
 ; marking as "(optional)" leads to OCaml-CI failures
 ; marking with "(package mirage-crypto-rng-miou-unix)" only has an effect with a "public_name"

bench/speed.ml

@@ -486,6 +486,31 @@ let benchmarks = [
     throughput name (fun buf ->
         let buf = Bytes.unsafe_of_string buf in
         generate_into ~g buf ~off:0 (Bytes.length buf))) ;
+
+  bm "pfortuna" (fun name ->
+    let open Mirage_crypto_rng_miou_unix.Pfortuna in
+    Miou_unix.run ~domains:2 @@ fun () ->
+    let rng = Mirage_crypto_rng_miou_unix.(initialize (module Pfortuna)) in
+    let g = create () in
+    reseed ~g "abcd" ;
+    throughput name (fun buf ->
+        let buf = Bytes.unsafe_of_string buf in
+        generate_into ~g buf ~off:0 (Bytes.length buf));
+    Mirage_crypto_rng_miou_unix.kill rng) ;
+
+  bm "getrandom" (fun name ->
+    throughput name (fun buf ->
+        let buf = Bytes.unsafe_of_string buf in
+        Mirage_crypto_rng_unix.getrandom_into buf ~off:0 ~len:(Bytes.length buf))) ;
+
+  bm "urandom-channel" (fun name ->
+    In_channel.with_open_bin "/dev/urandom" @@ fun ic ->
+    let m = Mutex.create () in
+    let finally () = Mutex.unlock m in
+    throughput name (fun buf ->
+        let buf = Bytes.unsafe_of_string buf in
+        Mutex.lock m;
+        Fun.protect ~finally (fun () -> really_input ic buf 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.

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: \

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,20 @@
+
+external getrandom_buf : bytes -> int -> int -> unit = "mc_getrandom" [@@noalloc]
+
+type g = unit
+
+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>
@@ -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), Int_val(len));
   return Val_unit;
 }

rng/unix/mirage_crypto_rng_unix.ml

@@ -1,13 +1,32 @@
 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 () =
+  try use_dev_urandom () with
+  | _ -> 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,18 @@ 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
+
+(** [getrandom_into buf ~off ~len] fills [buf] with random data ([len] octets),
+    starting at [off]. *)
+val getrandom_into : bytes -> off:int -> len:int -> unit
+
+module Urandom : Mirage_crypto_rng.Generator
+
+module Getentropy : Mirage_crypto_rng.Generator
+
+val use_default : unit -> unit
+(** [use_default ()] initializes with [Urandom] or resorts to [Getentropy] otherwise. *)
+
+val use_dev_urandom : unit -> unit
+
+val use_getentropy : unit -> unit

rng/unix/urandom.ml

@@ -0,0 +1,27 @@
+
+type g = In_channel.t * Mutex.t
+
+let block = 2048
+
+let create ?time:_ () =
+  let ic = In_channel.open_bin "/dev/urandom"
+  and mutex = Mutex.create ()
+  in
+  (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/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_entropy.ml

@@ -35,7 +35,7 @@ let timer_check () =
     let data' = Mirage_crypto_rng.Entropy.interrupt_hook () in
     if String.equal !data data' then begin
       Ohex.pp Format.std_formatter data';
-      failwith ("same data from timer at " ^ string_of_int i);
+      print_endline ("same data from timer at " ^ string_of_int i);
     end;
     data := data'
   done

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

tests/test_random_runner.ml

@@ -105,5 +105,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