Skip to content

Commit

Permalink
Use an atomic instead of a reference to be domain-safe (mirage#221)
Browse files Browse the repository at this point in the history
* Random number generator initialisation is domain-safe
* Atomic is only available since OCaml 4.12
* set entropy sources via compare_and_set
* CI: use 4.12+ only

Co-authored-by: Hannes Mehnert <hannes@mehnert.org>
Co-authored-by: Reynir Björnsson <reynir@reynir.dk>
  • Loading branch information
3 people committed Mar 29, 2024
1 parent cd7fc5c commit 5f2d718
Show file tree
Hide file tree
Showing 7 changed files with 23 additions and 17 deletions.
2 changes: 1 addition & 1 deletion .cirrus.yml
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,7 @@ freebsd_task:
env:
matrix:
- OCAML_VERSION: 4.13.1
- OCAML_VERSION: 4.14.1
- OCAML_VERSION: 4.14.2

pkg_install_script: pkg install -y ocaml-opam gmp gmake pkgconf bash

Expand Down
2 changes: 1 addition & 1 deletion .github/workflows/test.yml
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,7 @@ jobs:
strategy:
fail-fast: false
matrix:
ocaml-version: ["4.14.1", "4.13.1", "4.12.1", "4.11.2", "4.10.2", "4.09.1"]
ocaml-version: ["4.14.2", "4.13.1", "4.12.1"]
operating-system: [macos-latest, ubuntu-latest]

runs-on: ${{ matrix.operating-system }}
Expand Down
2 changes: 1 addition & 1 deletion .github/workflows/windows.yml
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,7 @@ jobs:
strategy:
fail-fast: false
matrix:
ocaml-version: ["4.14.0", "4.13.1", "4.12.1", "4.11.2", "4.10.2", "4.09.1"]
ocaml-version: ["4.14.2", "4.13.1", "4.12.1"]
operating-system: [windows-latest]

runs-on: ${{ matrix.operating-system }}
Expand Down
2 changes: 1 addition & 1 deletion mirage-crypto-rng.opam
Original file line number Diff line number Diff line change
Expand Up @@ -13,7 +13,7 @@ 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"
Expand Down
18 changes: 12 additions & 6 deletions rng/entropy.ml
Original file line number Diff line number Diff line change
Expand Up @@ -50,19 +50,25 @@ 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 set () =
let sources = Atomic.get _sources in
let n = S.cardinal sources in
let source = (n, name) in
if Atomic.compare_and_set _sources sources (S.add source sources) then
source
else
set ()
in
set ()

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

Expand Down
8 changes: 4 additions & 4 deletions rng/rng.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
6 changes: 3 additions & 3 deletions rng/unix/mirage_crypto_rng_unix.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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.")
Expand All @@ -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 ]
Expand Down

0 comments on commit 5f2d718

Please sign in to comment.