CA-400199: open /dev/urandom on first use

2 recent optimizations have changed the Uuidx module to open
  /dev/urandom once on startup, instead of every time a value was
  requested.

However 'networkd_db' runs in the installer environment, inside a chroot
where /dev/urandom is not available.

Open /dev/urandom on first use instead.

Simplify the code and use a single implementation for both fast and
secure urandom generation:
* use a mutex to protect accesses to global urandom state
* use an input channel, rather than a Unix file descriptor, this allows
  us to read many bytes in one go, and then generate multiple random
  numbers without having to make syscalls that often

(syscalls are slow in this case because they require releasing the
runtime mutex, which gives another thread the opportunity to run for
50ms).

Fixes: a0176da ("CP-49135: open /dev/urandom just once")
Fixes: a2d9fbe ("IH-577 Implement v7 UUID generation")
Fixes: 6635a00 ("CP-49136: Introduce PRNG for generating non-secret UUIDs")

This is slightly slower than before, but still fast enough:
```
│  uuidx creation/Uuidx.make            │             0.0004 mjw/run│            16.0001 mnw/run│            105.8801 ns/run│
│  uuidx creation/Uuidx.make_uuid_urnd  │             0.0004 mjw/run│            16.0001 mnw/run│            105.1474 ns/run│
```

Previously this used to take ~88ns, so in fact the difference is barely
noticable.

Also remove the feature flag: the previous change was feature flagged
too, but broke master anyway (I wouldn't have though anything *doesn't*
have /dev/urandom available, and didn't feature flag that part, because
in general it is not possible to feature flag startup code without races)

Signed-off-by: Edwin Török <[email protected]>

ocaml/forkexecd/test/fe_test.ml

@@ -292,7 +292,7 @@ let slave = function
       (*
 		  Printf.fprintf stderr "%s %d\n" total_fds (List.length present - 1)
 		*)
-      if total_fds + 1 (* Uuid.dev_urandom *) <> List.length filtered then
+      if total_fds <> List.length filtered then
         fail "Expected %d fds; /proc/self/fd has %d: %s" total_fds
           (List.length filtered) ls
 

ocaml/libs/uuid/uuidx.ml

@@ -116,48 +116,39 @@ let is_uuid str = match of_string str with None -> false | Some _ -> true
 
 let dev_urandom = "/dev/urandom"
 
-let dev_urandom_fd = Unix.openfile dev_urandom [Unix.O_RDONLY] 0o640
-(* we can't close this in at_exit, because Crowbar runs at_exit, and
-   it'll fail because this FD will then be closed
-*)
-
-let read_bytes dev n =
-  let buf = Bytes.create n in
-  let read = Unix.read dev buf 0 n in
-  if read <> n then
-    raise End_of_file
-  else
-    Bytes.to_string buf
-
-let make_uuid_urnd () = of_bytes (read_bytes dev_urandom_fd 16) |> Option.get
-
-(* State for random number generation. Random.State.t isn't thread safe, so
-   only use this via with_non_csprng_state, which takes care of this.
-*)
-let rstate = Random.State.make_self_init ()
-
-let rstate_m = Mutex.create ()
-
-let with_non_csprng_state =
-  (* On OCaml 5 we could use Random.State.split instead,
-     and on OCaml 4 the mutex may not be strictly needed
-  *)
-  let finally () = Mutex.unlock rstate_m in
-  fun f ->
-    Mutex.lock rstate_m ;
-    Fun.protect ~finally (f rstate)
-
-(** Use non-CSPRNG by default, for CSPRNG see {!val:make_uuid_urnd} *)
-let make_uuid_fast () = with_non_csprng_state Uuidm.v4_gen
-
-let make_default = ref make_uuid_urnd
-
-let make () = !make_default ()
+let generate =
+  let mutex = Mutex.create () in
+  let dev_urandom_ic = ref None in
+  let finally () = Mutex.unlock mutex in
+  let with_mutex fn = Mutex.lock mutex ; Fun.protect ~finally fn in
+  let close_ic () =
+    with_mutex @@ fun () ->
+    !dev_urandom_ic |> Option.iter close_in_noerr ;
+    dev_urandom_ic := None
+  in
+  fun n ->
+    with_mutex @@ fun () ->
+    let ic =
+      match !dev_urandom_ic with
+      | None ->
+          let ic = open_in_bin dev_urandom in
+          at_exit close_ic ;
+          dev_urandom_ic := Some ic ;
+          ic
+      | Some ic ->
+          ic
+    in
+    really_input_string ic n
+
+let make_uuid_urnd () = of_bytes (generate 16) |> Option.get
+
+let make_uuid_fast = make_uuid_urnd
+
+let make = make_uuid_urnd
 
 let make_v7_uuid_from_parts time_ns rand_b = Uuidm.v7_ns ~time_ns ~rand_b
 
-let rand64 () =
-  with_non_csprng_state (fun rstate () -> Random.State.bits64 rstate)
+let rand64 () = String.get_int64_ne (generate 8) 0
 
 let now_ns =
   let start = Mtime_clock.counter () in
@@ -174,7 +165,7 @@ let make_v7_uuid () = make_v7_uuid_from_parts (now_ns ()) (rand64 ())
 type cookie = string
 
 let make_cookie () =
-  read_bytes dev_urandom_fd 64
+  generate 64
   |> String.to_seq
   |> Seq.map (fun c -> Printf.sprintf "%1x" (int_of_char c))
   |> List.of_seq

ocaml/libs/uuid/uuidx.mli

@@ -194,8 +194,3 @@ module Hash : sig
   (* UUID Version 5 derived from argument string and namespace UUID *)
   val string : string -> [< not_secret] t
 end
-
-(**/**)
-
-(* just for feature flag, to be removed *)
-val make_default : (unit -> [< not_secret] t) ref

ocaml/tests/bench/bench_uuid.ml

@@ -1,7 +1,5 @@
 open Bechamel
 
-let () = Uuidx.make_default := Uuidx.make_uuid_fast
-
 let benchmarks =
   Test.make_grouped ~name:"uuidx creation"
     [

ocaml/xapi/xapi_globs.ml

@@ -1612,12 +1612,6 @@ let other_options =
     , (fun () -> string_of_bool !disable_webserver)
     , "Disable the host webserver"
     )
-  ; ( "use-prng-uuid-gen"
-      (* eventually this'll be the default, except for Sessions *)
-    , Arg.Unit (fun () -> Uuidx.make_default := Uuidx.make_uuid_fast)
-    , (fun () -> !Uuidx.make_default == Uuidx.make_uuid_fast |> string_of_bool)
-    , "Use PRNG based UUID generator instead of CSPRNG"
-    )
   ]
 
 (* The options can be set with the variable xapiflags in /etc/sysconfig/xapi.

quality-gate.sh

@@ -40,7 +40,7 @@ mli-files () {
 }
 
 structural-equality () {
-  N=10
+  N=9
   EQ=$(git grep -r --count ' == ' -- '**/*.ml' ':!ocaml/sdk-gen/**/*.ml' | cut -d ':' -f 2 | paste -sd+ - | bc)
   if [ "$EQ" -eq "$N" ]; then
     echo "OK counted $EQ usages of ' == '"