diff --git a/ocaml/idl/ocaml_backend/gen_rbac.ml b/ocaml/idl/ocaml_backend/gen_rbac.ml index 64f8f4200ef..cda3d1f2f8d 100644 --- a/ocaml/idl/ocaml_backend/gen_rbac.ml +++ b/ocaml/idl/ocaml_backend/gen_rbac.ml @@ -57,7 +57,7 @@ let writer_csv static_permissions_roles = let hash2uuid str = let h = Digest.string str in - Option.map Uuidm.to_string (Uuidm.of_bytes h) + Option.map Uuidm.to_string (Uuidm.of_binary_string h) let replace_char str c1 c2 = let buf = Bytes.of_string str in diff --git a/ocaml/libs/ezxenstore/watch/ez_xenctrl_uuid.ml b/ocaml/libs/ezxenstore/watch/ez_xenctrl_uuid.ml index e255861d7d8..ad326ac2300 100644 --- a/ocaml/libs/ezxenstore/watch/ez_xenctrl_uuid.ml +++ b/ocaml/libs/ezxenstore/watch/ez_xenctrl_uuid.ml @@ -12,25 +12,14 @@ * GNU Lesser General Public License for more details. *) -let bytes_of_handle h = - let s = Bytes.make 16 '\000' in - for i = 0 to 15 do - Bytes.set s i (char_of_int h.(i)) - done ; - s - let uuid_of_handle h = - let h' = bytes_of_handle h |> Bytes.to_string in - match Uuidm.of_bytes h' with + let h' = String.init 16 (fun i -> char_of_int h.(i)) in + match Uuidm.of_binary_string h' with | Some x -> x | None -> failwith (Printf.sprintf "VM handle '%s' is an invalid uuid" h') let handle_of_uuid u = - let s = Uuidm.to_bytes u in - let h = Array.make 16 0 in - for i = 0 to 15 do - h.(i) <- int_of_char s.[i] - done ; - h + let s = Uuidm.to_binary_string u in + Array.init 16 (fun i -> int_of_char s.[i]) diff --git a/ocaml/libs/uuid/uuidx.ml b/ocaml/libs/uuid/uuidx.ml index 98eefe1ab73..8fc44a47edd 100644 --- a/ocaml/libs/uuid/uuidx.ml +++ b/ocaml/libs/uuid/uuidx.ml @@ -98,15 +98,15 @@ let pp = Uuidm.pp let equal = Uuidm.equal -let of_bytes u = Uuidm.of_bytes ~pos:0 u +let of_bytes u = Uuidm.of_binary_string ~pos:0 u -let to_bytes = Uuidm.to_bytes +let to_bytes = Uuidm.to_binary_string let of_int_array arr = arr |> Array.to_seq |> Seq.map char_of_int |> String.of_seq |> of_bytes let to_int_array u = - Uuidm.to_bytes u |> String.to_seq |> Seq.map int_of_char |> Array.of_seq + to_bytes u |> String.to_seq |> Seq.map int_of_char |> Array.of_seq let of_string = Uuidm.of_string ~pos:0 diff --git a/ocaml/libs/vhd/vhd_format/f.ml b/ocaml/libs/vhd/vhd_format/f.ml index 66b3e2f788e..ac29cf8e8a4 100644 --- a/ocaml/libs/vhd/vhd_format/f.ml +++ b/ocaml/libs/vhd/vhd_format/f.ml @@ -100,12 +100,11 @@ let _mib_shift = 20 let _gib_shift = 30 -let blank_uuid = - match Uuidm.of_bytes (String.make 16 '\000') with - | Some x -> - x - | None -> - assert false (* never happens *) +let blank_uuid = Uuidm.nil + +let new_uuid () = + let random = Random.State.make_self_init () in + Uuidm.v4_gen random () module Feature = struct type t = Temporary @@ -394,7 +393,7 @@ module Footer = struct ?(creator_application = default_creator_application) ?(creator_version = default_creator_version) ?(creator_host_os = Host_OS.Other 0l) ~current_size - ?(original_size = current_size) ~disk_type ?(uid = Uuidm.v `V4) + ?(original_size = current_size) ~disk_type ?(uid = new_uuid ()) ?(saved_state = false) () = let geometry = Geometry.of_sectors Int64.(current_size lsr sector_shift) in let checksum = 0l in @@ -493,7 +492,7 @@ module Footer = struct set_footer_sectors buf t.geometry.Geometry.sectors ; set_footer_disk_type buf (Disk_type.to_int32 t.disk_type) ; set_footer_checksum buf 0l ; - set_footer_uid (Uuidm.to_bytes t.uid) 0 buf ; + set_footer_uid (Uuidm.to_binary_string t.uid) 0 buf ; set_footer_saved_state buf (if t.saved_state then 1 else 0) ; let remaining = Cstruct.shift buf sizeof_footer in for i = 0 to 426 do @@ -544,7 +543,7 @@ module Footer = struct Disk_type.of_int32 (get_footer_disk_type buf) >>= fun disk_type -> let checksum = get_footer_checksum buf in let bytes = copy_footer_uid buf in - ( match Uuidm.of_bytes bytes with + ( match Uuidm.of_binary_string bytes with | None -> R.error (Failure @@ -979,7 +978,9 @@ module Header = struct set_header_block_size buf (Int32.of_int (1 lsl (t.block_size_sectors_shift + sector_shift))) ; set_header_checksum buf 0l ; - set_header_parent_unique_id (Uuidm.to_bytes t.parent_unique_id) 0 buf ; + set_header_parent_unique_id + (Uuidm.to_binary_string t.parent_unique_id) + 0 buf ; set_header_parent_time_stamp buf t.parent_time_stamp ; set_header_reserved buf 0l ; for i = 0 to 511 do @@ -1074,7 +1075,7 @@ module Header = struct let block_size_sectors_shift = block_size_shift - sector_shift in let checksum = get_header_checksum buf in let bytes = copy_header_parent_unique_id buf in - ( match Uuidm.of_bytes bytes with + ( match Uuidm.of_binary_string bytes with | None -> R.error (Failure @@ -2141,7 +2142,7 @@ functor (* Assume the data is there, or will be written later *) return t - let create_dynamic ~filename ~size ?(uuid = Uuidm.v `V4) + let create_dynamic ~filename ~size ?(uuid = new_uuid ()) ?(saved_state = false) ?(features = []) () = (* The physical disk layout will be: byte 0 - 511: backup footer @@ -2212,7 +2213,7 @@ functor String.concat "/" (base @ target) let create_difference ~filename ~parent ?(relative_path = true) - ?(uuid = Uuidm.v `V4) ?(saved_state = false) ?(features = []) () = + ?(uuid = new_uuid ()) ?(saved_state = false) ?(features = []) () = (* We use the same basic file layout as in create_dynamic *) let data_offset = 512L in let table_offset = 2048L in diff --git a/ocaml/libs/xapi-inventory/lib/inventory.ml b/ocaml/libs/xapi-inventory/lib/inventory.ml index 867d4a2483e..88f8ddf9910 100644 --- a/ocaml/libs/xapi-inventory/lib/inventory.ml +++ b/ocaml/libs/xapi-inventory/lib/inventory.ml @@ -52,10 +52,14 @@ let inventory = Hashtbl.create 10 let inventory_m = Mutex.create () +let new_uuid () = + let random = Random.State.make_self_init () in + Uuidm.v4_gen random () + (* Compute the minimum necessary inventory file contents *) let minimum_default_entries () = - let host_uuid = Uuidm.to_string (Uuidm.v `V4) in - let dom0_uuid = Uuidm.to_string (Uuidm.v `V4) in + let host_uuid = Uuidm.to_string (new_uuid ()) in + let dom0_uuid = Uuidm.to_string (new_uuid ()) in [ (_installation_uuid, host_uuid) ; (_control_domain_uuid, dom0_uuid) diff --git a/ocaml/tests/test_ref.ml b/ocaml/tests/test_ref.ml index 7213e615e3f..ebf1fe72f42 100644 --- a/ocaml/tests/test_ref.ml +++ b/ocaml/tests/test_ref.ml @@ -3,7 +3,8 @@ let uuidm = Crowbar.( - map [bytes_fixed 16] @@ fun b -> b |> Uuidm.of_bytes ~pos:0 |> Option.get + map [bytes_fixed 16] @@ fun b -> + b |> Uuidm.of_binary_string ~pos:0 |> Option.get ) let ref_of_uuidm uuidm = diff --git a/ocaml/xapi-guard/test/cache_test.ml b/ocaml/xapi-guard/test/cache_test.ml index 3e51cab2c35..00235d543b7 100644 --- a/ocaml/xapi-guard/test/cache_test.ml +++ b/ocaml/xapi-guard/test/cache_test.ml @@ -156,6 +156,10 @@ let log_read (uuid, timestamp, key) = in Lwt_result.return "yes" +let new_uuid () = + let random = Random.State.make_self_init () in + Uuidm.v4_gen random () + let to_cache with_read_writes = let __FUN = __FUNCTION__ in let elapsed = Mtime_clock.counter () in @@ -180,7 +184,7 @@ let to_cache with_read_writes = let* () = Lwt.pause () in loop_and_stop f name uuid max sent in - let vms = List.init 4 (fun _ -> Uuidm.(v `V4)) in + let vms = List.init 4 (fun _ -> new_uuid ()) in List.concat [ diff --git a/ocaml/xapi-guard/test/xapi_guard_test.ml b/ocaml/xapi-guard/test/xapi_guard_test.ml index 5486f6b61d2..280d9f4d627 100644 --- a/ocaml/xapi-guard/test/xapi_guard_test.ml +++ b/ocaml/xapi-guard/test/xapi_guard_test.ml @@ -60,7 +60,7 @@ let xapi_rpc call = | _ -> Fmt.failwith "XAPI RPC call %s not expected in test" call.Rpc.name -let vm_uuid = Uuidm.v `V4 +let vm_uuid = Uuidm.v4_gen (Random.State.make_self_init ()) () let vm_uuid_str = Uuidm.to_string vm_uuid diff --git a/ocaml/xapi-idl/lib/uuidm_rpc_type.ml b/ocaml/xapi-idl/lib/uuidm_rpc_type.ml index 24a93fa13b6..51eef3c2eab 100644 --- a/ocaml/xapi-idl/lib/uuidm_rpc_type.ml +++ b/ocaml/xapi-idl/lib/uuidm_rpc_type.ml @@ -1,3 +1,7 @@ +let new_uuid () = + let random = Random.State.make_self_init () in + Uuidm.v4_gen random () + module Uuidm = struct include Uuidm @@ -6,7 +10,7 @@ module Uuidm = struct Rpc.Types.Abstract { aname= "uuid" - ; test_data= [Uuidm.v4_gen (Random.get_state ()) ()] + ; test_data= [new_uuid ()] ; rpc_of= (fun t -> Rpc.String (Uuidm.to_string t)) ; of_rpc= (function