Merge pull request #64 from hannesm/rng

RNG and entropy improvements

.github/workflows/test.yml

@@ -28,8 +28,7 @@ jobs:
           opam pin add -n mirage-crypto.dev .
           opam pin add -n mirage-crypto-rng.dev .
           opam pin add -n mirage-crypto-pk.dev .
-          opam pin add -n mirage-crypto-entropy.dev .
-          opam depext -y mirage-crypto mirage-crypto-rng mirage-crypto-pk mirage-crypto-entropy
+          opam depext -y mirage-crypto mirage-crypto-rng mirage-crypto-pk
           opam install -t --deps-only .
 
       - name: Build

.travis.yml

@@ -6,7 +6,7 @@ services:
 os: linux
 env:
   global:
-    - PINS="mirage-crypto.dev:. mirage-crypto-rng.dev:. mirage-crypto-pk.dev:. mirage-crypto-entropy.dev:."
+    - PINS="mirage-crypto.dev:. mirage-crypto-rng.dev:. mirage-crypto-pk.dev:."
     - PACKAGE="mirage-crypto-pk"
     - TESTS=true
     - DISTRO=alpine

bench/speed.ml

@@ -306,11 +306,6 @@ let benchmarks = [
     reseed ~g (Cstruct.of_string "abcd") ;
     throughput name (fun cs -> generate ~g (Cstruct.len cs))) ;
 
-  bm "unix rng" (fun name ->
-    let open Mirage_crypto_rng_unix.Getrandom in
-    let g = create () in
-    throughput name (fun cs -> generate ~g (Cstruct.len cs))) ;
-
   bm "md5"    (fun name -> throughput name MD5.digest) ;
   bm "sha1"   (fun name -> throughput name SHA1.digest) ;
   bm "sha256" (fun name -> throughput name SHA256.digest) ;
@@ -334,7 +329,8 @@ let runv fs =
 
 let () =
   let seed = Cstruct.of_string "abcd" in
-  Mirage_crypto_rng.(generator := create ~seed (module Fortuna));
+  let g = Mirage_crypto_rng.(create ~seed (module Fortuna)) in
+  Mirage_crypto_rng.set_default_generator g;
   match Array.to_list Sys.argv with
   | _::(_::_ as args) -> begin
       try

mirage-crypto-rng.opam

@@ -16,11 +16,22 @@ depends: [
   "ocaml" {>= "4.08.0"}
   "dune" {>= "1.7"}
   "dune-configurator"
-  "ounit" {with-test}
-  "cstruct" {>="3.2.0"}
+  "duration"
+  "cstruct" {>= "4.0.0"}
+  "logs"
   "mirage-crypto" {=version}
-  "randomconv" {with-test & >= "0.1.3"}
   "ounit" {with-test}
+  "randomconv" {with-test & >= "0.1.3"}
+# lwt sublibrary
+  "mtime"
+  "lwt" {>= "4.0.0"}
+# mirage sublibrary
+  "mirage-runtime" {>= "3.7.0"}
+  "mirage-time" {>= "2.0.0"}
+  "mirage-clock" {>= "3.0.0"}
+  "mirage-unix" {with-test & >= "3.0.0"}
+  "mirage-time-unix" {with-test & >= "2.0.0"}
+  "mirage-clock-unix" {with-test & >= "3.0.0"}
 ]
 description: """
 Mirage-crypto-rng provides a random number generator interface, and

pk/dsa.ml

@@ -99,7 +99,7 @@ let generate ?g size =
 module K_gen (H : Mirage_crypto.Hash.S) = struct
 
   let drbg : 'a Mirage_crypto_rng.generator =
-    let module M = Mirage_crypto_rng.Hmac_drbg.Make (H) in (module M)
+    let module M = Mirage_crypto_rng.Hmac_drbg (H) in (module M)
 
   let z_gen ~key:{ q; x; _ } z =
     let repr = Z_extra.to_cstruct_be ~size:(Z.numbits q // 8) in

rng/dune

@@ -2,4 +2,4 @@
   (name mirage_crypto_rng)
   (public_name mirage-crypto-rng)
   (libraries cstruct mirage-crypto)
-  (private_modules boot fortuna hmac_drbg))
+  (private_modules entropy fortuna hmac_drbg rng))

entropy/mirage_crypto_entropy.ml → rng/entropy.ml

@@ -30,113 +30,130 @@
 module Cpu_native = struct
 
   external cycles : unit -> int  = "caml_cycle_counter" [@@noalloc]
-  external unchecked_random : unit -> int  = "caml_cpu_unchecked_random" [@@noalloc]
-  external checked_random : unit -> int  = "caml_cpu_checked_random" [@@noalloc]
+  external rdseed : unit -> int  = "caml_cpu_rdseed" [@@noalloc]
+  external rdrand : unit -> int  = "caml_cpu_rdrand" [@@noalloc]
   external rng_type : unit -> int  = "caml_cpu_rng_type" [@@noalloc]
 
   let cpu_rng =
     match rng_type () with
-    | 0 -> None
-    | 1 -> Some `Rdrand
-    | 2 -> Some `Rdseed
+    | 0 -> []
+    | 1 -> [ `Rdrand ]
+    | 2 -> [ `Rdseed ]
+    | 3 -> [ `Rdrand ; `Rdseed ]
     | _ -> assert false
 end
 
-open Lwt.Infix
-
-type t = unit
-
 type source = [
   | `Timer
   | `Rdseed
   | `Rdrand
+  | `Getrandom
 ]
 
 let pp_source ppf s =
   let str = match s with
     | `Timer -> "timer"
     | `Rdseed -> "rdseed"
     | `Rdrand -> "rdrand"
+    | `Getrandom -> "getrandom"
   in
   Format.pp_print_string ppf str
 
-let sources () =
-  `Timer ::
+let source_id = function
+  | `Timer -> 0
+  | `Rdrand -> 1
+  | `Rdseed -> 2
+  | `Getrandom -> 3
+
+let _sources : source list ref = ref Cpu_native.cpu_rng
+
+let add_source s = _sources := s :: !_sources
+
+let sources () = !_sources
+
+let cpu_rng = function
+  | `Rdseed -> Cpu_native.rdseed
+  | `Rdrand -> Cpu_native.rdrand
+
+let random preferred =
   match Cpu_native.cpu_rng with
-  | Some x -> [x]
-  | None   -> []
+  | [] -> None
+  | xs when List.mem preferred xs -> Some preferred
+  | y::_ -> Some y
+
+let write_header source data =
+  Cstruct.set_uint8 data 0 source;
+  Cstruct.set_uint8 data 1 (Cstruct.len data - 2)
+
+let header source data =
+  let hdr = Cstruct.create 2 in
+  let buf = Cstruct.append hdr data in
+  write_header (source_id source) buf;
+  buf
 
 (* Note:
  * `bootstrap` is not a simple feedback loop. It attempts to exploit CPU-level
  * data races that lead to execution-time variability of identical instructions.
  * See Whirlwind RNG:
  *   http://www.ieee-security.org/TC/SP2014/papers/Not-So-RandomNumbersinVirtualizedLinuxandtheWhirlwindRNG.pdf
- *)
-let whirlwind_bootstrap f =
+*)
+let whirlwind_bootstrap id =
   let outer     = 100
   and inner_max = 1024
   and a         = ref 0
-  and cs        = Cstruct.create 2 in
+  in
+  let cs        = Cstruct.create (outer * 2 + 2) in
   for i = 0 to outer - 1 do
     let tsc = Cpu_native.cycles () in
-    let ()  = Cstruct.LE.set_uint16 cs 0 tsc ; f cs in
+    Cstruct.LE.set_uint16 cs ((i + 1) * 2) tsc;
     for j = 1 to tsc mod inner_max do
       a := tsc / j - !a * i + 1
     done
-  done ;
-  Lwt.return_unit
+  done;
+  write_header id cs;
+  cs
+
+let cpu_rng_bootstrap id =
+  match random `Rdseed with
+  | None -> failwith "expected a CPU rng"
+  | Some insn ->
+    let cs = Cstruct.create 10 in
+    Cstruct.LE.set_uint64 cs 2 (Int64.of_int ((cpu_rng insn) ()));
+    write_header id cs;
+    cs
+
+let bootstrap id =
+  try cpu_rng_bootstrap id with Failure _ -> whirlwind_bootstrap id
 
 let interrupt_hook () =
-  match Cpu_native.cpu_rng with
-  | None ->
-      let buf = Cstruct.create 4 in fun () ->
-        let a = Cpu_native.cycles () in
-        Cstruct.LE.set_uint32 buf 0 (Int32.of_int a) ;
-        buf
-  | Some _ ->
-      let buf = Cstruct.create 12 in fun () ->
-        let a = Cpu_native.cycles ()
-        and b = Cpu_native.unchecked_random () in
-        Cstruct.LE.set_uint32 buf 0 (Int32.of_int a) ;
-        Cstruct.LE.set_uint64 buf 4 (Int64.of_int b) ;
-        buf
-
-(* XXX TODO
- *
- * Xentropyd. Detect its presence here, make it feed into `t.handlers` as
- * `~source:1` and add a function providing initial entropy burst to
- * `t.inits`.
- *
- * Compile-time entropy. A function returning it could go into `t.inits`.
- *)
+  let buf = Cstruct.create 4 in fun () ->
+    let a = Cpu_native.cycles () in
+    Cstruct.LE.set_uint32 buf 0 (Int32.of_int a) ;
+    buf
 
-let checked_rdrand_rdseed f =
-  let cs = Cstruct.create 8 in
-  let random = Cpu_native.checked_random () in
-  Cstruct.LE.set_uint64 cs 0 (Int64.of_int random);
-  f cs;
-  Lwt.return_unit
+let timer_accumulator g =
+  let g = match g with None -> Some (Rng.default_generator ()) | Some g -> Some g in
+  let `Acc handle = Rng.accumulate g ~source:(source_id `Timer) in
+  let hook = interrupt_hook () in
+  add_source `Timer;
+  (fun () -> handle (hook ()))
 
-let bootstrap_functions () =
-  match Cpu_native.cpu_rng with
-  | None -> [ whirlwind_bootstrap ; whirlwind_bootstrap ; whirlwind_bootstrap ]
-  | Some _ -> [ checked_rdrand_rdseed ; checked_rdrand_rdseed ; whirlwind_bootstrap ; checked_rdrand_rdseed ; checked_rdrand_rdseed ]
-
-let running = ref false
-
-let initialize (type a) ?g (rng : a Mirage_crypto_rng.generator) =
-  if !running then
-    Lwt.fail_with "entropy harvesting already running"
-  else begin
-    running := true;
-    let rng = Mirage_crypto_rng.(create ?g rng) in
-    Mirage_crypto_rng.generator := rng;
-    let `Acc handler = Mirage_crypto_rng.accumulate (Some rng) in
-    Lwt_list.iteri_p
-      (fun i boot -> boot (handler ~source:i))
-      (bootstrap_functions ()) >|= fun () ->
-    let hook = interrupt_hook () in
-    Mirage_runtime.at_enter_iter (fun () ->
-        let e = hook () in
-        handler ~source:0 e)
-  end
+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:(source_id source) in
+  for _i = 0 to pred (Rng.pools g) do
+    let cs = f () in
+    handle cs
+  done
+
+let cpu_rng g =
+  match random `Rdrand with
+  | None -> ()
+  | Some insn ->
+    let randomf = cpu_rng insn in
+    let f () =
+      let cs = Cstruct.create 8 in
+      Cstruct.LE.set_uint64 cs 0 (Int64.of_int (randomf ()));
+      cs
+    in
+    feed_pools g insn f