From f6bf346c529b5b7995067082e34ab522d7d62099 Mon Sep 17 00:00:00 2001
From: Hannes Mehnert <hannes@mehnert.org>
Date: Wed, 27 Nov 2024 20:24:20 +0100
Subject: [PATCH] Add /dev/urandom and getentropy RNG generators

Provide guidance to use these by default, document that Fortuna is not
thread-safe. As suggested in #249
---
 rng/mirage_crypto_rng.mli           | 13 +++++++++++++
 rng/rng.ml                          |  7 ++++++-
 rng/unix/dune                       |  4 ++--
 rng/unix/getentropy.ml              | 20 ++++++++++++++++++++
 rng/unix/mirage_crypto_rng_unix.ml  | 16 ++++++++++++++++
 rng/unix/mirage_crypto_rng_unix.mli | 10 ++++++++++
 rng/unix/urandom.ml                 | 27 +++++++++++++++++++++++++++
 tests/test_ec.ml                    |  2 +-
 tests/test_entropy.ml               |  2 +-
 tests/test_pk_runner.ml             |  2 +-
 tests/test_random_runner.ml         |  2 +-
 11 files changed, 98 insertions(+), 7 deletions(-)
 create mode 100644 rng/unix/getentropy.ml
 create mode 100644 rng/unix/urandom.ml

diff --git a/rng/mirage_crypto_rng.mli b/rng/mirage_crypto_rng.mli
index ffb69e34..ac5a26a2 100644
--- a/rng/mirage_crypto_rng.mli
+++ b/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. Please be aware that the feeding of Fortuna
+    and producing random numbers is not thread-safe (it is on Miou_unix).
+
     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.
diff --git a/rng/rng.ml b/rng/rng.ml
index 4dbef40e..475a8f69 100644
--- a/rng/rng.ml
+++ b/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: \
diff --git a/rng/unix/dune b/rng/unix/dune
index 28f6aca8..caaa33ed 100644
--- a/rng/unix/dune
+++ b/rng/unix/dune
@@ -16,8 +16,8 @@
 (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)
diff --git a/rng/unix/getentropy.ml b/rng/unix/getentropy.ml
new file mode 100644
index 00000000..841b6cc7
--- /dev/null
+++ b/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
diff --git a/rng/unix/mirage_crypto_rng_unix.ml b/rng/unix/mirage_crypto_rng_unix.ml
index 5fc77c1e..3180e129 100644
--- a/rng/unix/mirage_crypto_rng_unix.ml
+++ b/rng/unix/mirage_crypto_rng_unix.ml
@@ -1,5 +1,21 @@
 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)
 
diff --git a/rng/unix/mirage_crypto_rng_unix.mli b/rng/unix/mirage_crypto_rng_unix.mli
index 2d830040..a9317223 100644
--- a/rng/unix/mirage_crypto_rng_unix.mli
+++ b/rng/unix/mirage_crypto_rng_unix.mli
@@ -15,3 +15,13 @@ 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
+
+val use_dev_urandom : unit -> unit
+
+val use_getentropy : unit -> unit
diff --git a/rng/unix/urandom.ml b/rng/unix/urandom.ml
new file mode 100644
index 00000000..4e32b7cf
--- /dev/null
+++ b/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
diff --git a/tests/test_ec.ml b/tests/test_ec.ml
index c8aa771c..eb359906 100644
--- a/tests/test_ec.ml
+++ b/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);
diff --git a/tests/test_entropy.ml b/tests/test_entropy.ml
index 13cb91fe..77b69e15 100644
--- a/tests/test_entropy.ml
+++ b/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
diff --git a/tests/test_pk_runner.ml b/tests/test_pk_runner.ml
index ae47e676..11adb04b 100644
--- a/tests/test_pk_runner.ml
+++ b/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
diff --git a/tests/test_random_runner.ml b/tests/test_random_runner.ml
index 8a74eec4..21f9f701 100644
--- a/tests/test_random_runner.ml
+++ b/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