CP-34028: Replace Uuidm with Uuid wherever possible

Now the only modules where Uuidm is used is inside Uuid, and in
varstoredguard's RPC. This is to avoid using GADTs for little benefit

Signed-off-by: Pau Ruiz Safont <pau.safont@citrix.com>

forkexec.opam

@@ -15,7 +15,7 @@ depends: [
  "fd-send-recv"
  "ppx_deriving_rpc"
  "rpclib"
- "uuidm"
+ "uuid"
  "xapi-idl"
  "xapi-stdext-pervasives"
  "xapi-stdext-unix"

http-svr.opam

@@ -17,6 +17,7 @@ depends: [
  "rpclib"
  "sha"
  "stunnel"
+ "uuid"
  "xapi-stdext-date"
  "xapi-stdext-pervasives"
  "xapi-stdext-threads"

ocaml/forkexecd/cli/dune

@@ -1,7 +1,7 @@
 (executable
  (modes byte exe)
  (name fe_cli)
- (libraries forkexec uuidm))
+ (libraries forkexec))
 
 (install
  (package xapi-forkexecd)

ocaml/forkexecd/lib/dune

@@ -2,7 +2,7 @@
  (name forkexec)
  (public_name forkexec)
  (wrapped false)
- (libraries fd-send-recv rpclib.json threads uuidm xapi-stdext-pervasives
+ (libraries fd-send-recv rpclib.json threads uuid xapi-stdext-pervasives
  xapi-stdext-unix xapi-idl)
  (preprocess
  (pps ppx_deriving_rpc)))

ocaml/forkexecd/lib/forkhelpers.ml

@@ -137,9 +137,9 @@ let safe_close_and_exec ?env stdin stdout stderr
  let sock =
  Fecomms.open_unix_domain_sock_client (runtime_path ^ "/xapi/forker/main")
  in
- let stdinuuid = Uuidm.to_string (Uuidm.create `V4) in
- let stdoutuuid = Uuidm.to_string (Uuidm.create `V4) in
- let stderruuid = Uuidm.to_string (Uuidm.create `V4) in
+ let stdinuuid = Uuid.(to_string (make ())) in
+ let stdoutuuid = Uuid.(to_string (make ())) in
+ let stderruuid = Uuid.(to_string (make ())) in
 
  let fds_to_close = ref [] in
 

ocaml/forkexecd/src/dune

@@ -1,7 +1,7 @@
 (executable
  (modes byte exe)
  (name fe_main)
- (libraries astring forkexec systemd uuidm xapi-stdext-unix))
+ (libraries astring forkexec systemd uuid xapi-stdext-unix))
 
 (install
  (package xapi-forkexecd)

ocaml/forkexecd/src/fe_main.ml

@@ -4,7 +4,7 @@ let setup sock cmdargs id_to_fd_map syslog_stdout redirect_stderr_to_stdout env
  =
  let fd_sock_path =
  Printf.sprintf "%s/fd_%s" Forkhelpers.temp_dir_server
- (Uuidm.to_string (Uuidm.create `V4))
+ Uuid.(to_string (make ()))
  in
  let fd_sock = Fecomms.open_unix_domain_sock () in
  Xapi_stdext_unix.Unixext.unlink_safe fd_sock_path ;

ocaml/forkexecd/test/dune

@@ -1,7 +1,7 @@
 (executable
  (modes byte exe)
  (name fe_test)
- (libraries forkexec uuidm xapi-stdext-unix))
+ (libraries forkexec xapi-stdext-unix))
 
 (rule
  (alias runtest)

ocaml/forkexecd/test/fe_test.ml

@@ -75,7 +75,7 @@ let one fds x =
  Printf.fprintf stderr "extra = %d\n" x.extra;*)
  let fd = Unix.stdin in
  let make_names n =
- List.map (fun _ -> Uuidm.to_string (Uuidm.create `V4)) (mkints n)
+ List.map (fun _ -> Uuid.(to_string (make ()))) (mkints n)
  in
  let names = make_names x.named_fds in
  let cmdline_names = irrelevant_strings @ names @ names in

ocaml/libs/http-svr/dune

@@ -11,6 +11,7 @@
  sha
  stunnel
  threads.posix
+ uuid
  xapi-idl
  xapi-idl.updates
  xapi-stdext-date

ocaml/libs/http-svr/xmlrpc_client.ml

@@ -68,7 +68,7 @@ let write_to_log x = StunnelDebug.debug "%s" (Astring.String.trim x)
  closed or left in some other inconsistent state. *)
 let check_reusable_inner (x : Unixfd.t) =
  let msg_name = "system.isAlive" in
- let msg_uuid = Uuidm.to_string (Uuidm.create `V4) in
+ let msg_uuid = Uuid.(to_string (make ())) in
  (* This is for backward compatability *)
  let msg_func = Printf.sprintf "%s:%s" msg_name msg_uuid in
  let msg_param = [XMLRPC.To.string msg_uuid] in

ocaml/libs/stunnel/dune

@@ -6,7 +6,7 @@
  astring
  forkexec
  safe-resources
- uuidm
+ uuid
  xapi-idl
  xapi-inventory
  xapi-stdext-pervasives

ocaml/libs/stunnel/stunnel.ml

@@ -297,7 +297,7 @@ let attempt_one_connect ?(use_fork_exec_helper = true)
  ?(write_to_log = fun _ -> ()) ?(extended_diagnosis = false) data_channel
  verify_cert host port =
  Unixfd.with_pipe () ~loc:__LOC__ @@ fun config_out config_in ->
- let config_out_uuid = Uuidm.to_string (Uuidm.create `V4) in
+ let config_out_uuid = Uuid.(to_string (make ())) in
  let config_out_fd =
  string_of_int (Unixext.int_of_file_descr Unixfd.(!config_out))
  in

ocaml/libs/uuid/uuid.ml

@@ -62,7 +62,6 @@ let make_uuid_urnd () = of_bytes (read_bytes dev_urandom 16) |> Option.get
 (* Use the CSPRNG-backed urandom *)
 let make = make_uuid_urnd
 
-
 type cookie = string
 
 let make_cookie () =

ocaml/nbd/lib_test/dune

@@ -5,6 +5,6 @@
  alcotest
  alcotest-lwt
  lwt
- uuidm
+ uuid
  vbd_store)
 )

ocaml/nbd/lib_test/suite.ml

@@ -1,6 +1,6 @@
 open Lwt.Infix
 
-let dir = Uuidm.v `V4 |> Uuidm.to_string
+let dir = Uuid.(to_string (make ()))
 
 let dir = Filename.get_temp_dir_name () ^ "/" ^ dir
 

ocaml/nbd/src/cleanup.ml

@@ -164,7 +164,7 @@ module Block = struct
  let blocks_to_close_mutex = Lwt_mutex.create ()
 
  let with_tracking b f =
- let block_uuid = Uuidm.v `V4 |> Uuidm.to_string in
+ let block_uuid = Uuid.(to_string (make ())) in
  Lwt_mutex.with_lock blocks_to_close_mutex (fun () ->
  Hashtbl.add blocks_to_close block_uuid b ;
  Lwt.return_unit

ocaml/nbd/src/dune

@@ -10,7 +10,7 @@
  mirage-block-unix
  nbd-unix
  uri
- uuidm
+ uuid
  vbd_store
  xapi-inventory
  xen-api-client-lwt

ocaml/squeezed/src/dune

@@ -18,7 +18,7 @@
  rpclib
  xapi-idl
  xapi-idl.memory
- uuidm
+ uuid
  re
  re.str
  )

ocaml/squeezed/src/memory_server.ml

@@ -98,7 +98,7 @@ let login dbg service_name =
  )
 
 let reserve_memory dbg session_id kib =
- let reservation_id = Uuidm.to_string (Uuidm.create `V4) in
+ let reservation_id = Uuid.(to_string (make ())) in
  if kib < 0L then
  raise (MemoryError (Invalid_memory_value kib)) ;
  wrap dbg (fun () ->
@@ -112,7 +112,7 @@ let reserve_memory dbg session_id kib =
  )
 
 let reserve_memory_range dbg session_id min max =
- let reservation_id = Uuidm.to_string (Uuidm.create `V4) in
+ let reservation_id = Uuid.(to_string (make ())) in
  if min < 0L then
  raise (MemoryError (Invalid_memory_value min)) ;
  if max < 0L then

ocaml/tests/test_cluster_host.ml

@@ -16,7 +16,7 @@ open Xapi_cluster_host
 
 let create_cluster ~__context pool_auto_join =
  let cluster_ref = Ref.make () in
- let cluster_uuid = Uuidm.to_string (Uuidm.create `V4) in
+ let cluster_uuid = Uuid.(to_string (make ())) in
  Db.Cluster.create ~__context ~ref:cluster_ref ~uuid:cluster_uuid
  ~cluster_token:"token"
  ~cluster_stack:Constants.default_smapiv3_cluster_stack

ocaml/wsproxy/cli/dune

@@ -10,7 +10,7 @@
  lwt
  lwt.unix
  re.str
- uuidm
+ uuid
  wslib
  )
 )

ocaml/wsproxy/cli/wsproxy.ml

@@ -86,7 +86,7 @@ let proxy (fd : Lwt_unix.file_descr) addr protocol =
  )
  >>= fun (frame, unframe) ->
  with_open_connection_fd addr ~callback:(fun localfd ->
- let session_id = Uuidm.v `V4 |> Uuidm.to_string in
+ let session_id = Uuid.(to_string (make ())) in
  Logs_lwt.debug (fun m -> m "Starting proxy session %s" session_id)
  >>= fun () ->
  let thread1 =

ocaml/xapi-idl/varstore/privileged/dune

@@ -5,6 +5,7 @@
  (libraries
  rpclib.core
  threads
+ uuidm
  xcp
  )
  (wrapped false)

ocaml/xapi-idl/varstore/privileged/varstore_privileged_interface.ml

@@ -42,7 +42,7 @@ module Uuidm = struct
  Rpc.Types.Abstract
  {
  aname= "uuid"
- ; test_data= [Uuidm.v `V4]
+ ; test_data= [Uuidm.v4_gen (Random.get_state ()) ()]
  ; rpc_of= (fun t -> Rpc.String (Uuidm.to_string t))
  ; of_rpc=
  (function

ocaml/xapi-types/dune

@@ -18,7 +18,6 @@
  rpclib.core
  rpclib.xml
  threads
- uuidm
  xapi-consts
  xapi-stdext-date
  xapi-stdext-unix

ocaml/xapi-types/ref.ml

@@ -32,14 +32,14 @@ let dummy_sep = "|"
 let ref_null = ref_prefix ^ "NULL"
 
 let make () =
- let uuid = Uuidm.v `V4 |> Uuidm.to_string in
+ let uuid = Uuid.(to_string (make ())) in
  Real uuid
 
 let null = Null
 
 (* a dummy reference is a reference of an object which is not in database *)
 let make_dummy name =
- let uuid = Uuidm.v `V4 |> Uuidm.to_string in
+ let uuid = Uuid.(to_string (make ())) in
  Dummy (uuid, name)
 
 let is_real = function Real _ -> true | _ -> false

ocaml/xapi/dune

@@ -105,7 +105,6 @@
  unixpwd
  uri
  uuid
- uuidm
  x509
  xapi_aux
  xapi-backtrace

ocaml/xapi/repository_helpers.ml

@@ -785,7 +785,7 @@ end
 let create_repository_record ~__context ~name_label ~name_description
  ~binary_url ~source_url ~update ~gpgkey_path =
  let ref = Ref.make () in
- let uuid = Uuidm.to_string (Uuidm.create `V4) in
+ let uuid = Uuid.(to_string (make ())) in
  Db.Repository.create ~__context ~ref ~uuid ~name_label ~name_description
  ~binary_url ~source_url ~update ~hash:"" ~up_to_date:false ~gpgkey_path ;
  ref

ocaml/xapi/vhd_tool_wrapper.ml

@@ -82,7 +82,7 @@ let run_vhd_tool progress_cb args s s' path =
 let receive progress_cb format protocol (s : Unix.file_descr)
  (length : int64 option) (path : string) (prefix : string) (prezeroed : bool)
  =
- let s' = Uuidm.to_string (Uuidm.create `V4) in
+ let s' = Uuid.(to_string (make ())) in
  let args =
  [
  "serve"
@@ -183,7 +183,7 @@ let vhd_of_device path =
 
 let send progress_cb ?relative_to (protocol : string) (dest_format : string)
  (s : Unix.file_descr) (path : string) (prefix : string) =
- let s' = Uuidm.to_string (Uuidm.create `V4) in
+ let s' = Uuid.(to_string (make ())) in
  let source_format, source =
  match vhd_of_device path with
  | Some vhd ->

ocaml/xapi/xapi_cluster.ml

@@ -42,8 +42,8 @@ let create ~__context ~pIF ~cluster_stack ~pool_auto_join ~token_timeout
  validate_params ~token_timeout ~token_timeout_coefficient ;
  let cluster_ref = Ref.make () in
  let cluster_host_ref = Ref.make () in
- let cluster_uuid = Uuidm.to_string (Uuidm.create `V4) in
- let cluster_host_uuid = Uuidm.to_string (Uuidm.create `V4) in
+ let cluster_uuid = Uuid.(to_string (make ())) in
+ let cluster_host_uuid = Uuid.(to_string (make ())) in
  (* For now we assume we have only one pool
  TODO: get master ref explicitly passed in as parameter*)
  let host = Helpers.get_master ~__context in

ocaml/xapi/xapi_cluster_host.ml

@@ -60,7 +60,7 @@ let create_internal ~__context ~cluster ~host ~pIF : API.ref_Cluster_host =
  assert_pif_attached_to ~host ~pIF ~__context ;
  assert_cluster_host_can_be_created ~__context ~host ;
  let ref = Ref.make () in
- let uuid = Uuidm.to_string (Uuidm.create `V4) in
+ let uuid = Uuid.(to_string (make ())) in
  Db.Cluster_host.create ~__context ~ref ~uuid ~cluster ~host ~pIF
  ~enabled:false ~current_operations:[] ~allowed_operations:[]
  ~other_config:[] ~joined:false ;

ocaml/xapi/xapi_pgpu.ml

@@ -70,7 +70,7 @@ let populate_compatibility_metadata ~__context ~pgpu ~pgpu_pci =
 let create ~__context ~pCI ~gPU_group ~host ~other_config ~supported_VGPU_types
  ~size ~dom0_access ~is_system_display_device =
  let pgpu = Ref.make () in
- let uuid = Uuidm.to_string (Uuidm.create `V4) in
+ let uuid = Uuid.(to_string (make ())) in
  let supported_VGPU_max_capacities =
  calculate_max_capacities ~__context ~pCI ~size ~supported_VGPU_types
  in

ocaml/xapi/xapi_pif.ml

@@ -360,8 +360,7 @@ let find_or_create_network (bridge : string) (device : string) ~__context =
  | [net] ->
  net
  | _ ->
- let net_ref = Ref.make ()
- and net_uuid = Uuid.to_string (Uuid.make ()) in
+ let net_ref = Ref.make () and net_uuid = Uuid.to_string (Uuid.make ()) in
  let () =
  Db.Network.create ~__context ~ref:net_ref ~uuid:net_uuid
  ~current_operations:[] ~allowed_operations:[]
@@ -409,8 +408,7 @@ let is_my_management_pif ~__context ~self =
  Db.Network.get_bridge ~__context ~self:net = management_if
 
 let make_pif_metrics ~__context =
- let metrics = Ref.make ()
- and metrics_uuid = Uuid.to_string (Uuid.make ()) in
+ let metrics = Ref.make () and metrics_uuid = Uuid.to_string (Uuid.make ()) in
  let () =
  Db.PIF_metrics.create ~__context ~ref:metrics ~uuid:metrics_uuid
  ~carrier:false ~device_name:"" ~vendor_name:"" ~device_id:"" ~vendor_id:""

ocaml/xapi/xapi_pvs_cache_storage.ml

@@ -31,7 +31,7 @@ let assert_not_already_present ~__context site host =
 let create ~__context ~host ~sR ~site ~size =
  assert_not_already_present ~__context site host ;
  let cache_storage = Ref.make () in
- let uuid = Uuidm.to_string (Uuidm.create `V4) in
+ let uuid = Uuid.(to_string (make ())) in
  let vDI = Pvs_cache_vdi.create_vdi ~__context ~sR ~size in
  Db.PVS_cache_storage.create ~__context ~ref:cache_storage ~uuid ~host ~sR
  ~site ~vDI ~size ;

ocaml/xapi/xapi_pvs_proxy.ml

@@ -34,7 +34,7 @@ let create ~__context ~site ~vIF =
  if device <> "0" then
  raise Api_errors.(Server_error (invalid_device, [device])) ;
  let pvs_proxy = Ref.make () in
- let uuid = Uuidm.to_string (Uuidm.create `V4) in
+ let uuid = Uuid.(to_string (make ())) in
  Db.PVS_proxy.create ~__context ~ref:pvs_proxy ~uuid ~site ~vIF
  ~currently_attached:false ~status:`stopped ;
  if Db.VIF.get_currently_attached ~__context ~self:vIF then

ocaml/xapi/xapi_pvs_server.ml

@@ -36,7 +36,7 @@ let introduce ~__context ~addresses ~first_port ~last_port ~site =
  ~last_port:(Int64.to_int last_port) ~last_name:"last_port" ;
  Helpers.assert_is_valid_ref ~__context ~name:"site" ~ref:site ;
  let pvs_server = Ref.make () in
- let uuid = Uuidm.to_string (Uuidm.create `V4) in
+ let uuid = Uuid.(to_string (make ())) in
  Db.PVS_server.create ~__context ~ref:pvs_server ~uuid
  ~addresses:(Listext.setify addresses) ~first_port ~last_port ~site ;
  pvs_server

ocaml/xapi/xapi_vgpu_type.ml

@@ -135,7 +135,7 @@ let create ~__context ~vendor_name ~model_name ~framebuffer_size ~max_heads
  ~identifier ~experimental ~compatible_model_names_in_vm
  ~compatible_model_names_on_pgpu =
  let ref = Ref.make () in
- let uuid = Uuidm.to_string (Uuidm.create `V4) in
+ let uuid = Uuid.(to_string (make ())) in
  (* Currently Nvidia has only one type of vGPU in the VM and on pGPU
  * We just check the compatilbe list, if it is not empty, then it just
  * compatible with self.

ocaml/xapi/xapi_vif_helpers.ml

@@ -383,7 +383,7 @@ let copy ~__context ~vm ~preserve_mac_address vif =
  let site = proxy.API.pVS_proxy_site in
  let vIF = result in
  let pvs_proxy = Ref.make () in
- let uuid = Uuidm.to_string (Uuidm.create `V4) in
+ let uuid = Uuid.(to_string (make ())) in
  Db.PVS_proxy.create ~__context ~ref:pvs_proxy ~uuid ~site ~vIF
  ~currently_attached:false ~status:`stopped
  with e ->

ocaml/xapi/xapi_vm.ml

@@ -615,8 +615,7 @@ let create ~__context ~name_label ~name_description ~power_state ~user_version
  - power_state = `Suspended and suspend_VDI = Ref.null || last_booted_record = "" || last_boot_CPU_flags = []
  - power_state not in [`Halted, `Suspended]
  *)
- let metrics = Ref.make ()
- and metrics_uuid = Uuid.to_string (Uuid.make ()) in
+ let metrics = Ref.make () and metrics_uuid = Uuid.to_string (Uuid.make ()) in
  let vCPUs_utilisation = [(0L, 0.)] in
  let suspended = power_state = `Suspended in
  let current_domain_type = if suspended then domain_type else `unspecified in