Skip to content

Commit 25bb1b5

Browse files
edwintorokedwintorok
authored
CP-49135: speed up UUID generation (xapi-project#6018)
2 optimizations here: * open /dev/urandom just once, speeds up session uuid/ref creation by ~3.8x * use a PRNG for non-secret UUIDs. We cannot use these for sessions (those UUIDs/opaquerefs are effectively the authentication tokens), or Pool secrets, but we can use it for everything else. The latter is not yet enabled by default, needs more testing/auditing on whether we have any other secret opaquerefs/UUIDs in the codebase, but the 1st one is enabled by default (we still use `/dev/urandom` for generating the UUIDs, we just don't keep closing and reopening it).
2 parents 0384a40 + 6635a00 commit 25bb1b5

33 files changed

+353
-102
lines changed

‎ocaml/forkexecd/test/fe_test.ml

+1-1
Original file line numberDiff line numberDiff line change
@@ -292,7 +292,7 @@ let slave = function
292292
(*
293293
Printf.fprintf stderr "%s %d\n" total_fds (List.length present - 1)
294294
*)
295-
if total_fds <> List.length filtered then
295+
if total_fds + 1 (* Uuid.dev_urandom *) <> List.length filtered then
296296
fail "Expected %d fds; /proc/self/fd has %d: %s" total_fds
297297
(List.length filtered) ls
298298

‎ocaml/idl/ocaml_backend/gen_api.ml

+1-9
Original file line numberDiff line numberDiff line change
@@ -400,15 +400,7 @@ let gen_client_types highapi =
400400
; " Rpc.failure (rpc_of_failure ([\"Fault\"; code]))"
401401
]
402402
; ["include Rpc"; "type string_list = string list [@@deriving rpc]"]
403-
; [
404-
"module Ref = struct"
405-
; " include Ref"
406-
; " let rpc_of_t (_:'a -> Rpc.t) (x: 'a Ref.t) = rpc_of_string \
407-
(Ref.string_of x)"
408-
; " let t_of_rpc (_:Rpc.t -> 'a) x : 'a t = of_string (string_of_rpc \
409-
x);"
410-
; "end"
411-
]
403+
; ["module Ref = Ref"]
412404
; [
413405
"module Date = struct"
414406
; " open Xapi_stdext_date"

‎ocaml/idl/ocaml_backend/gen_db_actions.ml

+10-4
Original file line numberDiff line numberDiff line change
@@ -134,8 +134,12 @@ let string_to_dm tys : O.Module.t =
134134
| DT.Map (key, value) ->
135135
let kf = OU.alias_of_ty key and vf = OU.alias_of_ty value in
136136
"fun m -> map " ^ kf ^ " " ^ vf ^ " m"
137-
| DT.Ref _ ->
138-
"fun x -> (Ref.of_string x : " ^ OU.ocaml_of_ty ty ^ ")"
137+
| DT.Ref t ->
138+
"fun x -> (Ref.of_"
139+
^ (if t = "session" then "secret_" else "")
140+
^ "string x : "
141+
^ OU.ocaml_of_ty ty
142+
^ ")"
139143
| DT.Set ty ->
140144
"fun s -> set " ^ OU.alias_of_ty ty ^ " s"
141145
| DT.String ->
@@ -360,7 +364,8 @@ let db_action api : O.Module.t =
360364
expr
361365
; Printf.sprintf
362366
"List.map (fun (ref,(__regular_fields,__set_refs)) -> \
363-
Ref.of_string ref, %s __regular_fields __set_refs) records"
367+
Ref.of_%sstring ref, %s __regular_fields __set_refs) records"
368+
(if obj.DT.name = "session" then "secret_" else "")
364369
conversion_fn
365370
]
366371
)
@@ -374,9 +379,10 @@ let db_action api : O.Module.t =
374379
obj.DT.name
375380
; Printf.sprintf
376381
"(fun ~__context ~self -> (fun () -> API.rpc_of_%s_t \
377-
(%s.get_record ~__context ~self:(Ref.of_string self))))"
382+
(%s.get_record ~__context ~self:(Ref.of_%sstring self))))"
378383
(OU.ocaml_of_record_name obj.DT.name)
379384
(OU.ocaml_of_obj_name obj.DT.name)
385+
(if obj.DT.name = "session" then "secret_" else "")
380386
]
381387
()
382388
in

‎ocaml/libs/uuid/dune

+1
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,7 @@
44
(modules uuidx)
55
(libraries
66
unix (re_export uuidm)
7+
threads.posix
78
)
89
(wrapped false)
910
)

‎ocaml/libs/uuid/uuid_test.ml

+1-1
Original file line numberDiff line numberDiff line change
@@ -25,7 +25,7 @@ let uuid_arrays =
2525
let non_uuid_arrays =
2626
[[|0|]; [|0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 14|]]
2727

28-
type resource
28+
type resource = [`Generic]
2929

3030
let uuid_testable : (module Alcotest.TESTABLE with type t = resource Uuidx.t) =
3131
Alcotest.testable Uuidx.pp Uuidx.equal

‎ocaml/libs/uuid/uuidx.ml

+108-24
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,85 @@
1212
* GNU Lesser General Public License for more details.
1313
*)
1414

15-
type 'a t = Uuidm.t
15+
type without_secret =
16+
[ `auth
17+
| `blob
18+
| `Bond
19+
| `Certificate
20+
| `Cluster
21+
| `Cluster_host
22+
| `console
23+
| `crashdump
24+
| `data_source
25+
| `Diagnostics
26+
| `DR_task
27+
| `event
28+
| `Feature
29+
| `generation
30+
| `Generic
31+
| `GPU_group
32+
| `host
33+
| `host_cpu
34+
| `host_crashdump
35+
| `host_metrics
36+
| `host_patch
37+
| `LVHD
38+
| `message
39+
| `network
40+
| `network_sriov
41+
| `Observer
42+
| `PBD
43+
| `PCI
44+
| `PGPU
45+
| `PIF
46+
| `PIF_metrics
47+
| `pool
48+
| `pool_patch
49+
| `pool_update
50+
| `probe_result
51+
| `PUSB
52+
| `PVS_cache_storage
53+
| `PVS_proxy
54+
| `PVS_server
55+
| `PVS_site
56+
| `Repository
57+
| `role
58+
| `SDN_controller
59+
| `secret
60+
| `SM
61+
| `SR
62+
| `sr_stat
63+
| `subject
64+
| `task
65+
| `tunnel
66+
| `USB_group
67+
| `user
68+
| `VBD
69+
| `VBD_metrics
70+
| `VDI
71+
| `vdi_nbd_server_info
72+
| `VGPU
73+
| `VGPU_type
74+
| `VIF
75+
| `VIF_metrics
76+
| `VLAN
77+
| `VM
78+
| `VM_appliance
79+
| `VM_group
80+
| `VM_guest_metrics
81+
| `VM_metrics
82+
| `VMPP
83+
| `VMSS
84+
| `VTPM
85+
| `VUSB ]
86+
87+
type secret = [`session]
88+
89+
type not_secret = [without_secret | `session of [`use_make_uuid_rnd_instead]]
90+
91+
type all = [without_secret | secret]
92+
93+
type 'a t = Uuidm.t constraint 'a = [< all]
1694

1795
let null = Uuidm.nil
1896

@@ -38,34 +116,40 @@ let is_uuid str = match of_string str with None -> false | Some _ -> true
38116

39117
let dev_urandom = "/dev/urandom"
40118

119+
let dev_urandom_fd = Unix.openfile dev_urandom [Unix.O_RDONLY] 0o640
120+
(* we can't close this in at_exit, because Crowbar runs at_exit, and
121+
it'll fail because this FD will then be closed
122+
*)
123+
41124
let read_bytes dev n =
42-
let fd = Unix.openfile dev [Unix.O_RDONLY] 0o640 in
43-
let finally body_f clean_f =
44-
try
45-
let ret = body_f () in
46-
clean_f () ; ret
47-
with e -> clean_f () ; raise e
48-
in
49-
finally
50-
(fun () ->
51-
let buf = Bytes.create n in
52-
let read = Unix.read fd buf 0 n in
53-
if read <> n then
54-
raise End_of_file
55-
else
56-
Bytes.to_string buf
57-
)
58-
(fun () -> Unix.close fd)
59-
60-
let make_uuid_urnd () = of_bytes (read_bytes dev_urandom 16) |> Option.get
61-
62-
(* Use the CSPRNG-backed urandom *)
63-
let make = make_uuid_urnd
125+
let buf = Bytes.create n in
126+
let read = Unix.read dev buf 0 n in
127+
if read <> n then
128+
raise End_of_file
129+
else
130+
Bytes.to_string buf
131+
132+
let make_uuid_urnd () = of_bytes (read_bytes dev_urandom_fd 16) |> Option.get
133+
134+
(** Use non-CSPRNG by default, for CSPRNG see {!val:make_uuid_urnd} *)
135+
let make_uuid_fast =
136+
let uuid_state = Random.State.make_self_init () in
137+
(* On OCaml 5 we could use Random.State.split instead,
138+
and on OCaml 4 the mutex may not be strictly needed
139+
*)
140+
let m = Mutex.create () in
141+
let finally () = Mutex.unlock m in
142+
let gen = Uuidm.v4_gen uuid_state in
143+
fun () -> Mutex.lock m ; Fun.protect ~finally gen
144+
145+
let make_default = ref make_uuid_urnd
146+
147+
let make () = !make_default ()
64148

65149
type cookie = string
66150

67151
let make_cookie () =
68-
read_bytes dev_urandom 64
152+
read_bytes dev_urandom_fd 64
69153
|> String.to_seq
70154
|> Seq.map (fun c -> Printf.sprintf "%1x" (int_of_char c))
71155
|> List.of_seq

0 commit comments

Comments
 (0)