diff --git a/rng/dune b/rng/dune index e70f9743..00baa203 100644 --- a/rng/dune +++ b/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)) diff --git a/rng/entropy.ml b/rng/entropy.ml index 80ea8fdf..8baf238f 100644 --- a/rng/entropy.ml +++ b/rng/entropy.ml @@ -27,6 +27,9 @@ * 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 @@ -128,23 +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 buf = Bytes.create 10 in - let r = cpu_rng insn buf 2 in - if not r then failwith "Mirage_crypto_rng.Entropy: CPU RNG broken"; + 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 diff --git a/rng/mirage_crypto_rng.mli b/rng/mirage_crypto_rng.mli index 555f8568..98cc69f8 100644 --- a/rng/mirage_crypto_rng.mli +++ b/rng/mirage_crypto_rng.mli @@ -114,11 +114,9 @@ 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. - - @raise Failure if no CPU RNG is available, or if it doesn't return a - random value. *) + 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. *) val bootstrap : int -> string (** [bootstrap id] is either [cpu_rng_bootstrap], if the CPU supports it, or