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

@@ -303,7 +303,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

@@ -775,7 +775,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

@@ -654,8 +654,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