Handle CPU_RNG failures in OCaml: (#255)

* Handle CPU_RNG failures in OCaml:

- Previously, a return value of "0" was treated specially, but rdrand/rdseed
  may return 0!
- If there's a failure in rdrand/rdseed during cpu_rng_bootstrap, raise an
  exception
- If there's a failure during the periodic reseeding (timer initiated feeding
  of all pools), ignore it (for now!?)

* use memcpy instead of manual copying

* entropy: provide rdrand and rdseed calls and failures

* cpu_rng_bootstrap: use rdrand if rdseed fails.

if rdseed fails, take 512 times rdrand.

if rdrand fails 512 times (* 10 from the RETRIES in C), fail

* rdseed: 100 retries, rdrand: 10 retries

* avoid unused parameter warnings

* use Val_false directly

rng/async/mirage_crypto_rng_async.ml

@@ -34,7 +34,7 @@ let periodically_collect_getrandom_entropy time_source span =
       let idx = ref 0 in
       let f () =
         incr idx;
-        String.sub random ~pos:(per_pool * (pred !idx)) ~len:per_pool
+        Ok (String.sub random ~pos:(per_pool * (pred !idx)) ~len:per_pool)
       in
       Entropy.feed_pools None source f)
 

rng/dune

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

rng/eio/mirage_crypto_rng_eio.ml

@@ -32,7 +32,7 @@ let periodically_feed_entropy env delta source =
     let idx = ref 0 in
     let f () =
       incr idx;
-      String.sub random (per_pool * (pred !idx)) per_pool
+      Ok (String.sub random (per_pool * (pred !idx)) per_pool)
     in
     Entropy.feed_pools None source f
   in

rng/entropy.ml

@@ -27,11 +27,19 @@
  * 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 : unit -> int  = "mc_cpu_rdseed" [@@noalloc]
-  external rdrand : unit -> int  = "mc_cpu_rdrand" [@@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 =
@@ -72,9 +80,17 @@ let sources () = S.elements (Atomic.get _sources)
 
 let pp_source ppf (idx, name) = Format.fprintf ppf "[%d] %s" idx name
 
-let cpu_rng = function
-  | `Rdseed -> Cpu_native.rdseed
-  | `Rdrand -> Cpu_native.rdrand
+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
@@ -115,24 +131,50 @@ let whirlwind_bootstrap id =
   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 insn ->
+  | Some `Rdseed ->
     let cpu_rng_bootstrap id =
-      let r = cpu_rng insn () in
-      if r = 0 then failwith "Mirage_crypto_rng.Entropy: 0 is a bad CPU RNG value";
       let buf = Bytes.create 10 in
-      Bytes.set_int64_le buf 2 (Int64.of_int r);
+      let r = cpu_rng `Rdseed buf 2 in
       write_header id buf;
-      Bytes.unsafe_to_string 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 _ -> whirlwind_bootstrap id
+    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
@@ -150,7 +192,11 @@ 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
-    handle (f ())
+    match f () with
+    | Ok data -> handle data
+    | Error `No_random_available ->
+      (* should we log a message? *)
+      ()
   done
 
 let cpu_rng =
@@ -165,9 +211,16 @@ let cpu_rng =
       in
       let f () =
         let buf = Bytes.create 8 in
-        Bytes.set_int64_le buf 0 (Int64.of_int (randomf ()));
-        Bytes.unsafe_to_string buf
+        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

rng/lwt/mirage_crypto_rng_lwt.ml

@@ -19,7 +19,7 @@ let getrandom_task delta source =
     let idx = ref 0 in
     let f () =
       incr idx;
-      String.sub random (per_pool * (pred !idx)) per_pool
+      Ok (String.sub random (per_pool * (pred !idx)) per_pool)
     in
     Entropy.feed_pools None source f
   in

rng/miou/mirage_crypto_rng_miou_unix.ml

@@ -18,7 +18,10 @@ let getrandom delta source =
     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; String.sub random (per_pool * (pred !idx)) per_pool 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
 

rng/mirage_crypto_rng.mli

@@ -107,11 +107,13 @@ module Entropy : sig
 
   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 or rdrand). On 32bit platforms, only 4 bytes are filled.
-      The [id] is used as prefix.
+      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 no CPU RNG is available, or if it doesn't return a
-      random value. *)
+      @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
@@ -129,14 +131,26 @@ module Entropy : sig
 
   (** {1 Periodic pulled sources} *)
 
-  val feed_pools : g option -> source -> (unit -> string) -> unit
+  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, [fun () -> ()] is returned. *)
+      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

src/native/entropy_cpu_stubs.c

@@ -15,11 +15,13 @@
 #define random_t unsigned long long
 #define _rdseed_step _rdseed64_step
 #define _rdrand_step _rdrand64_step
+#define fill_bytes(buf, off, data) memcpy(_bp_uint8_off(buf, off), data, 8)
 
 #elif defined (__i386__)
 #define random_t unsigned int
 #define _rdseed_step _rdseed32_step
 #define _rdrand_step _rdrand32_step
+#define fill_bytes(buf, off, data) memcpy(_bp_uint8_off(buf, off), data, 4)
 
 #endif
 #endif /* __i386__ || __x86_64__ */
@@ -203,16 +205,14 @@ enum cpu_rng_t {
 
 static int __cpu_rng = RNG_NONE;
 
-#define RETRIES 10
-
 static void detect (void) {
 #ifdef __mc_ENTROPY__
   random_t r = 0;
 
   if (mc_detected_cpu_features.rdrand)
     /* AMD Ryzen 3000 bug where RDRAND always returns -1
        https://arstechnica.com/gadgets/2019/10/how-a-months-old-amd-microcode-bug-destroyed-my-weekend/ */
-    for (int i = 0; i < RETRIES; i++)
+    for (int i = 0; i < 10; i++)
       if (_rdrand_step(&r) == 1 && r != (random_t) (-1)) {
         __cpu_rng = RNG_RDRAND;
         break;
@@ -221,37 +221,43 @@ static void detect (void) {
   if (mc_detected_cpu_features.rdseed)
     /* RDSEED could return -1, thus we test it here
        https://www.reddit.com/r/Amd/comments/cmza34/agesa_1003_abb_fixes_rdrandrdseed/ */
-    for (int i = 0; i < RETRIES; i++)
+    for (int i = 0; i < 100; i++)
       if (_rdseed_step(&r) == 1 && r != (random_t) (-1)) {
         __cpu_rng |= RNG_RDSEED;
         break;
       }
 #endif
 }
 
-CAMLprim value mc_cpu_rdseed (value __unused(unit)) {
+CAMLprim value mc_cpu_rdseed (value buf, value off) {
 #ifdef __mc_ENTROPY__
   random_t r = 0;
   int ok = 0;
-  int i = RETRIES;
+  int i = 100;
   do { ok = _rdseed_step (&r); _mm_pause (); } while ( !(ok | !--i) );
-  return Val_long(r);
+  fill_bytes(buf, off, &r);
+  return Val_bool (ok);
 #else
   /* ARM: CPU-assisted randomness here. */
-  return Val_long (0);
+  (void)buf;
+  (void)off;
+  return Val_false;
 #endif
 }
 
-CAMLprim value mc_cpu_rdrand (value __unused(unit)) {
+CAMLprim value mc_cpu_rdrand (value buf, value off) {
 #ifdef __mc_ENTROPY__
   random_t r = 0;
   int ok = 0;
-  int i = RETRIES;
+  int i = 10;
   do { ok = _rdrand_step (&r); } while ( !(ok | !--i) );
-  return Val_long(r);
+  fill_bytes(buf, off, &r);
+  return Val_bool (ok);
 #else
   /* ARM: CPU-assisted randomness here. */
-  return Val_long (0);
+  (void)buf;
+  (void)off;
+  return Val_false;
 #endif
 }