Use an atomic instead of a reference to be domain-safe

mirage-crypto-rng.opam

@@ -13,11 +13,12 @@ build: [ ["dune" "subst"] {dev}
          ["dune" "runtest" "-p" name "-j" jobs] {with-test} ]
 
 depends: [
-  "ocaml" {>= "4.08.0"}
+  "ocaml" {>= "4.12.0"}
   "dune" {>= "2.7"}
   "dune-configurator" {>= "2.0.0"}
   "duration"
   "logs"
+  "backoff"
   "mirage-crypto" {=version}
   "digestif" {>= "1.1.4"}
   "ounit2" {with-test}

rng/dune

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

rng/entropy.ml

@@ -50,19 +50,24 @@ module S = Set.Make(struct
       String.compare an bn
   end)
 
-let _sources = ref S.empty
+let _sources = Atomic.make S.empty
 
 type source = Rng.source
 
 let register_source name =
-  let n = S.cardinal !_sources in
-  let source = (n, name) in
-  _sources := S.add source !_sources;
-  source
+  let rec go backoff =
+    let seen = Atomic.get _sources in
+    let n = S.cardinal seen in
+    let source = (n, name) in
+    let after = S.add source (Atomic.get _sources) in
+    if Atomic.compare_and_set _sources seen after = false
+    then go (Backoff.once backoff)
+    else source in
+  go Backoff.default
 
 let id (idx, _) = idx
 
-let sources () = S.elements !_sources
+let sources () = S.elements (Atomic.get _sources)
 
 let pp_source ppf (idx, name) = Format.fprintf ppf "[%d] %s" idx name
 

rng/rng.ml

@@ -54,14 +54,14 @@ let create (type a) ?g ?seed ?(strict=false) ?time (m : a generator) =
   Option.iter (M.reseed ~g) seed;
   Generator (g, strict, m)
 
-let _default_generator = ref None
+let _default_generator = Atomic.make None
 
-let set_default_generator g = _default_generator := Some g
+let set_default_generator g = Atomic.set _default_generator (Some g)
 
-let unset_default_generator () = _default_generator := None
+let unset_default_generator () = Atomic.set _default_generator None
 
 let default_generator () =
-  match !_default_generator with
+  match Atomic.get _default_generator with
   | None -> raise No_default_generator
   | Some g -> g
 

rng/unix/mirage_crypto_rng_unix.ml

@@ -14,10 +14,10 @@ let getrandom_init i =
   let data = getrandom 128 in
   Entropy.header i data
 
-let running = ref false
+let running = Atomic.make false
 
 let initialize (type a) ?g (rng : a generator) =
-  if !running then
+  if Atomic.get running then
     Log.debug
       (fun m -> m "Mirage_crypto_rng_unix.initialize has already been called, \
                    ignoring this call.")
@@ -28,7 +28,7 @@ let initialize (type a) ?g (rng : a generator) =
                              been set, check that this call is intentional");
      with
        No_default_generator -> ());
-    running := true ;
+    Atomic.set running true ;
     let seed =
       let init =
         Entropy.[ bootstrap ; whirlwind_bootstrap ; bootstrap ; getrandom_init ]