diff --git a/forkexec.opam b/forkexec.opam index 1a0068d508b..38b2e27af48 100644 --- a/forkexec.opam +++ b/forkexec.opam @@ -15,7 +15,7 @@ depends: [ "fd-send-recv" "ppx_deriving_rpc" "rpclib" - "uuidm" + "uuid" "xapi-idl" "xapi-stdext-pervasives" "xapi-stdext-unix" diff --git a/http-svr.opam b/http-svr.opam index 1f521e2238e..b01832a324c 100644 --- a/http-svr.opam +++ b/http-svr.opam @@ -17,6 +17,7 @@ depends: [ "rpclib" "sha" "stunnel" + "uuid" "xapi-stdext-date" "xapi-stdext-pervasives" "xapi-stdext-threads" diff --git a/ocaml/forkexecd/cli/dune b/ocaml/forkexecd/cli/dune index f75e6bc16ce..07012adf5ae 100644 --- a/ocaml/forkexecd/cli/dune +++ b/ocaml/forkexecd/cli/dune @@ -1,7 +1,7 @@ (executable (modes byte exe) (name fe_cli) - (libraries forkexec uuidm)) + (libraries forkexec)) (install (package xapi-forkexecd) diff --git a/ocaml/forkexecd/lib/dune b/ocaml/forkexecd/lib/dune index e6db37ebf91..3e8976225f5 100644 --- a/ocaml/forkexecd/lib/dune +++ b/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))) diff --git a/ocaml/forkexecd/lib/forkhelpers.ml b/ocaml/forkexecd/lib/forkhelpers.ml index b22a0a68860..9085aa9c973 100644 --- a/ocaml/forkexecd/lib/forkhelpers.ml +++ b/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 diff --git a/ocaml/forkexecd/src/dune b/ocaml/forkexecd/src/dune index 864fc363d3f..c31da1327a7 100644 --- a/ocaml/forkexecd/src/dune +++ b/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) diff --git a/ocaml/forkexecd/src/fe_main.ml b/ocaml/forkexecd/src/fe_main.ml index f5d3bc3c7bb..14821c82c93 100644 --- a/ocaml/forkexecd/src/fe_main.ml +++ b/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 ; diff --git a/ocaml/forkexecd/test/dune b/ocaml/forkexecd/test/dune index f9bbc6f043e..aa91ab34b56 100644 --- a/ocaml/forkexecd/test/dune +++ b/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) diff --git a/ocaml/forkexecd/test/fe_test.ml b/ocaml/forkexecd/test/fe_test.ml index 2c3a653de38..b88db7759d1 100644 --- a/ocaml/forkexecd/test/fe_test.ml +++ b/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 diff --git a/ocaml/libs/http-svr/dune b/ocaml/libs/http-svr/dune index 35e7a96cf10..7c937e658dd 100644 --- a/ocaml/libs/http-svr/dune +++ b/ocaml/libs/http-svr/dune @@ -11,6 +11,7 @@ sha stunnel threads.posix + uuid xapi-idl xapi-idl.updates xapi-stdext-date diff --git a/ocaml/libs/http-svr/xmlrpc_client.ml b/ocaml/libs/http-svr/xmlrpc_client.ml index 6bfddf215e1..319dc3820fc 100644 --- a/ocaml/libs/http-svr/xmlrpc_client.ml +++ b/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 diff --git a/ocaml/libs/stunnel/dune b/ocaml/libs/stunnel/dune index e7805911211..f6ed6e3d593 100644 --- a/ocaml/libs/stunnel/dune +++ b/ocaml/libs/stunnel/dune @@ -6,7 +6,7 @@ astring forkexec safe-resources - uuidm + uuid xapi-idl xapi-inventory xapi-stdext-pervasives diff --git a/ocaml/libs/stunnel/stunnel.ml b/ocaml/libs/stunnel/stunnel.ml index 062ebe1ba2b..c82ca71fdbb 100644 --- a/ocaml/libs/stunnel/stunnel.ml +++ b/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 diff --git a/ocaml/libs/uuid/uuid.ml b/ocaml/libs/uuid/uuid.ml index 079ffd7bf55..de471da0e1b 100644 --- a/ocaml/libs/uuid/uuid.ml +++ b/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 () = diff --git a/ocaml/nbd/lib_test/dune b/ocaml/nbd/lib_test/dune index 03c42c94f51..7da1f7d8e1e 100644 --- a/ocaml/nbd/lib_test/dune +++ b/ocaml/nbd/lib_test/dune @@ -5,6 +5,6 @@ alcotest alcotest-lwt lwt - uuidm + uuid vbd_store) ) diff --git a/ocaml/nbd/lib_test/suite.ml b/ocaml/nbd/lib_test/suite.ml index a000fe1bbeb..fc73aa78d5c 100644 --- a/ocaml/nbd/lib_test/suite.ml +++ b/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 diff --git a/ocaml/nbd/src/cleanup.ml b/ocaml/nbd/src/cleanup.ml index 90be717aec4..d93bced71d3 100644 --- a/ocaml/nbd/src/cleanup.ml +++ b/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 diff --git a/ocaml/nbd/src/dune b/ocaml/nbd/src/dune index 19e0f078546..4d2a3e31edf 100644 --- a/ocaml/nbd/src/dune +++ b/ocaml/nbd/src/dune @@ -10,7 +10,7 @@ mirage-block-unix nbd-unix uri - uuidm + uuid vbd_store xapi-inventory xen-api-client-lwt diff --git a/ocaml/squeezed/src/dune b/ocaml/squeezed/src/dune index 6adab942207..70b8db75a10 100644 --- a/ocaml/squeezed/src/dune +++ b/ocaml/squeezed/src/dune @@ -18,7 +18,7 @@ rpclib xapi-idl xapi-idl.memory - uuidm + uuid re re.str ) diff --git a/ocaml/squeezed/src/memory_server.ml b/ocaml/squeezed/src/memory_server.ml index 95de7a0235c..3fe22a322dc 100644 --- a/ocaml/squeezed/src/memory_server.ml +++ b/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 diff --git a/ocaml/tests/test_cluster_host.ml b/ocaml/tests/test_cluster_host.ml index 52df5e4e542..b762b0c9c93 100644 --- a/ocaml/tests/test_cluster_host.ml +++ b/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 diff --git a/ocaml/wsproxy/cli/dune b/ocaml/wsproxy/cli/dune index befdb30505b..7b6dbe7aeff 100644 --- a/ocaml/wsproxy/cli/dune +++ b/ocaml/wsproxy/cli/dune @@ -10,7 +10,7 @@ lwt lwt.unix re.str - uuidm + uuid wslib ) ) diff --git a/ocaml/wsproxy/cli/wsproxy.ml b/ocaml/wsproxy/cli/wsproxy.ml index ebda0f5d8d8..712717e13cd 100644 --- a/ocaml/wsproxy/cli/wsproxy.ml +++ b/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 = diff --git a/ocaml/xapi-idl/varstore/privileged/dune b/ocaml/xapi-idl/varstore/privileged/dune index e7a07b48dc5..d375b86c594 100644 --- a/ocaml/xapi-idl/varstore/privileged/dune +++ b/ocaml/xapi-idl/varstore/privileged/dune @@ -5,6 +5,7 @@ (libraries rpclib.core threads + uuidm xcp ) (wrapped false) diff --git a/ocaml/xapi-idl/varstore/privileged/varstore_privileged_interface.ml b/ocaml/xapi-idl/varstore/privileged/varstore_privileged_interface.ml index 2babdc5e235..87c40cad43a 100644 --- a/ocaml/xapi-idl/varstore/privileged/varstore_privileged_interface.ml +++ b/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 diff --git a/ocaml/xapi-types/dune b/ocaml/xapi-types/dune index 020e70f0b98..cc0922e16f5 100644 --- a/ocaml/xapi-types/dune +++ b/ocaml/xapi-types/dune @@ -18,7 +18,6 @@ rpclib.core rpclib.xml threads - uuidm xapi-consts xapi-stdext-date xapi-stdext-unix diff --git a/ocaml/xapi-types/ref.ml b/ocaml/xapi-types/ref.ml index 9931e26ad23..194f29e2587 100644 --- a/ocaml/xapi-types/ref.ml +++ b/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 diff --git a/ocaml/xapi/dune b/ocaml/xapi/dune index 15a82011a3d..e33f5b08107 100644 --- a/ocaml/xapi/dune +++ b/ocaml/xapi/dune @@ -105,7 +105,6 @@ unixpwd uri uuid - uuidm x509 xapi_aux xapi-backtrace diff --git a/ocaml/xapi/repository_helpers.ml b/ocaml/xapi/repository_helpers.ml index 7b7ce92e32a..d46e7270692 100644 --- a/ocaml/xapi/repository_helpers.ml +++ b/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 diff --git a/ocaml/xapi/vhd_tool_wrapper.ml b/ocaml/xapi/vhd_tool_wrapper.ml index 79abab63235..47d8b7a2907 100644 --- a/ocaml/xapi/vhd_tool_wrapper.ml +++ b/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 -> diff --git a/ocaml/xapi/xapi_cluster.ml b/ocaml/xapi/xapi_cluster.ml index 52efd5e4be4..b87ef358602 100644 --- a/ocaml/xapi/xapi_cluster.ml +++ b/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 diff --git a/ocaml/xapi/xapi_cluster_host.ml b/ocaml/xapi/xapi_cluster_host.ml index 26108aa69e6..a014f21ff93 100644 --- a/ocaml/xapi/xapi_cluster_host.ml +++ b/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 ; diff --git a/ocaml/xapi/xapi_pgpu.ml b/ocaml/xapi/xapi_pgpu.ml index 541a9883826..2271f243cf1 100644 --- a/ocaml/xapi/xapi_pgpu.ml +++ b/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 diff --git a/ocaml/xapi/xapi_pif.ml b/ocaml/xapi/xapi_pif.ml index ddc5f05c851..c28c56fe8e4 100644 --- a/ocaml/xapi/xapi_pif.ml +++ b/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:"" diff --git a/ocaml/xapi/xapi_pvs_cache_storage.ml b/ocaml/xapi/xapi_pvs_cache_storage.ml index 605dea16a88..60581dfbb9c 100644 --- a/ocaml/xapi/xapi_pvs_cache_storage.ml +++ b/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 ; diff --git a/ocaml/xapi/xapi_pvs_proxy.ml b/ocaml/xapi/xapi_pvs_proxy.ml index 5f4f4cdaef9..c2476d23ca7 100644 --- a/ocaml/xapi/xapi_pvs_proxy.ml +++ b/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 diff --git a/ocaml/xapi/xapi_pvs_server.ml b/ocaml/xapi/xapi_pvs_server.ml index 23bdf995a97..4d898c64fba 100644 --- a/ocaml/xapi/xapi_pvs_server.ml +++ b/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 diff --git a/ocaml/xapi/xapi_vgpu_type.ml b/ocaml/xapi/xapi_vgpu_type.ml index bae4795c20a..b76fa8ed87e 100644 --- a/ocaml/xapi/xapi_vgpu_type.ml +++ b/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. diff --git a/ocaml/xapi/xapi_vif_helpers.ml b/ocaml/xapi/xapi_vif_helpers.ml index cc5105e8dfc..8cbccdddde9 100644 --- a/ocaml/xapi/xapi_vif_helpers.ml +++ b/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 -> diff --git a/ocaml/xapi/xapi_vm.ml b/ocaml/xapi/xapi_vm.ml index b98bf9c8043..e2742a95bcd 100644 --- a/ocaml/xapi/xapi_vm.ml +++ b/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 diff --git a/ocaml/xapi/xapi_vm_helpers.ml b/ocaml/xapi/xapi_vm_helpers.ml index 7fa0c99d94a..2a2c6953ccb 100644 --- a/ocaml/xapi/xapi_vm_helpers.ml +++ b/ocaml/xapi/xapi_vm_helpers.ml @@ -1303,8 +1303,7 @@ let copy_metrics ~__context ~vm = else None in - 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 Db.VM_metrics.create ~__context ~ref:metrics ~uuid:metrics_uuid ~memory_actual: (Option.fold ~none:0L diff --git a/ocaml/xen-api-client/lib/dune b/ocaml/xen-api-client/lib/dune index 6540e8f685c..dd26361adef 100644 --- a/ocaml/xen-api-client/lib/dune +++ b/ocaml/xen-api-client/lib/dune @@ -10,7 +10,7 @@ rpclib xapi-rrd uri - uuidm + uuid xmlm xapi-client xapi-types diff --git a/ocaml/xen-api-client/lib/xen_api_metrics.ml b/ocaml/xen-api-client/lib/xen_api_metrics.ml index 40fee7b249d..ddd372c86c2 100644 --- a/ocaml/xen-api-client/lib/xen_api_metrics.ml +++ b/ocaml/xen-api-client/lib/xen_api_metrics.ml @@ -35,7 +35,7 @@ let cf_of_string = function module Legend = struct type cls = [`VM | `Host | `Other of string] - type t = string * cf * cls * Uuidm.t + type t = string * cf * cls * [`Generic] Uuid.t let of_string x = match Astring.String.cuts ~sep:":" ~empty:false x with @@ -47,7 +47,7 @@ module Legend = struct let cls = match cls with "host" -> `Host | "vm" -> `VM | x -> `Other x in - match Uuidm.of_string uuid with + match Uuid.of_string uuid with | None -> `Error (`Msg (Printf.sprintf "Failed to parse uuid: %s" uuid)) | Some uuid -> diff --git a/ocaml/xen-api-client/lib/xen_api_metrics.mli b/ocaml/xen-api-client/lib/xen_api_metrics.mli index 65b189129ab..10fe16c7586 100644 --- a/ocaml/xen-api-client/lib/xen_api_metrics.mli +++ b/ocaml/xen-api-client/lib/xen_api_metrics.mli @@ -22,7 +22,7 @@ module Legend : sig type cls = [`VM | `Host | `Other of string] (** A legend identifies a specific data source. *) - type t = string * cf * cls * Uuidm.t + type t = string * cf * cls * [`Generic] Uuid.t val of_string : string -> [`Ok of t | `Error of [> `Msg of string]] diff --git a/ocaml/xenopsd/cli/dune b/ocaml/xenopsd/cli/dune index 82a71ce308f..aca7e23c088 100644 --- a/ocaml/xenopsd/cli/dune +++ b/ocaml/xenopsd/cli/dune @@ -13,7 +13,7 @@ rpclib.json rresult threads - uuidm + uuid xapi-idl xapi-idl.xen xapi-idl.xen.interface diff --git a/ocaml/xenopsd/cli/xn.ml b/ocaml/xenopsd/cli/xn.ml index daf09b6f79e..80eea54493a 100644 --- a/ocaml/xenopsd/cli/xn.ml +++ b/ocaml/xenopsd/cli/xn.ml @@ -608,7 +608,7 @@ let add' _copts x () = if mem _uuid then find _uuid |> string else - Uuidm.to_string (Uuidm.create `V4) + Uuid.(to_string (make ())) in let name = if mem _name then find _name |> string else uuid in let mib = diff --git a/ocaml/xenopsd/lib/suspend_image.ml b/ocaml/xenopsd/lib/suspend_image.ml index 5f0eb66a44c..72c705728a3 100644 --- a/ocaml/xenopsd/lib/suspend_image.ml +++ b/ocaml/xenopsd/lib/suspend_image.ml @@ -198,8 +198,8 @@ let with_conversion_script task name hvm fd f = let finally = Xapi_stdext_pervasives.Pervasiveext.finally in check_conversion_script () >>= fun () -> let pipe_r, pipe_w = Unix.pipe () in - let fd_uuid = Uuidm.(to_string (create `V4)) - and pipe_w_uuid = Uuidm.(to_string (create `V4)) in + let fd_uuid = Uuid.(to_string (make ())) + and pipe_w_uuid = Uuid.(to_string (make ())) in let conv_script = !Resources.legacy_conv_tool and args = [ diff --git a/ocaml/xenopsd/lib/xenops_server.ml b/ocaml/xenopsd/lib/xenops_server.ml index 51f4b827f6b..9553b381f50 100644 --- a/ocaml/xenopsd/lib/xenops_server.ml +++ b/ocaml/xenopsd/lib/xenops_server.ml @@ -34,7 +34,7 @@ type context = { let make_context () = {transferred_fd= None} -let instance_id = Uuidm.to_string (Uuidm.create `V4) +let instance_id = Uuid.(to_string (make ())) let query _ _ _ = { diff --git a/ocaml/xenopsd/list_domains/dune b/ocaml/xenopsd/list_domains/dune index 7058fe35fa2..75647960b81 100644 --- a/ocaml/xenopsd/list_domains/dune +++ b/ocaml/xenopsd/list_domains/dune @@ -2,5 +2,5 @@ (name list_domains) (public_name list_domains) (package xapi-xenopsd-xc) - (libraries xenctrl xapi-idl.memory ezxenstore.watch uuidm) + (libraries xenctrl xapi-idl.memory ezxenstore.watch uuid) ) diff --git a/ocaml/xenopsd/list_domains/list_domains.ml b/ocaml/xenopsd/list_domains/list_domains.ml index 8def8d8f82c..3c9ce4a8ef7 100644 --- a/ocaml/xenopsd/list_domains/list_domains.ml +++ b/ocaml/xenopsd/list_domains/list_domains.ml @@ -35,6 +35,21 @@ let hashtbl_of_domaininfo x : (string, string) Hashtbl.t = Int64.to_string (Memory.mib_of_pages_used (Int64.of_nativeint x)) in let pages_to_string_pages x = Int64.to_string (Int64.of_nativeint x) in + let uuid_of_di di = + let string_of_domain_handle handle = + Array.to_list handle |> List.map string_of_int |> String.concat "; " + in + match Uuid.of_int_array di.Xenctrl.handle with + | Some x -> + x + | None -> + failwith + (Printf.sprintf "VM handle for domain %i is an invalid uuid, %a" + di.Xenctrl.domid + (fun () -> string_of_domain_handle) + di.Xenctrl.handle + ) + in let int = string_of_int and int64 = Int64.to_string and int32 = Int32.to_string in @@ -65,8 +80,7 @@ let hashtbl_of_domaininfo x : (string, string) Hashtbl.t = Hashtbl.add table "vcpus online" (int x.nr_online_vcpus) ; Hashtbl.add table "max vcpu id" (int x.max_vcpu_id) ; Hashtbl.add table "ssidref" (int32 x.ssidref) ; - Hashtbl.add table "uuid" - (Uuidm.to_string (Ez_xenctrl_uuid.uuid_of_handle x.handle)) ; + Hashtbl.add table "uuid" (Uuid.to_string (uuid_of_di x)) ; (* Ask for shadow allocation separately *) let shadow_mib = try Some (Int64.of_int (Xenctrl.shadow_allocation_get xc_handle x.domid)) diff --git a/ocaml/xenopsd/suspend_image_viewer/dune b/ocaml/xenopsd/suspend_image_viewer/dune index e9ec909917d..88e10f51f85 100644 --- a/ocaml/xenopsd/suspend_image_viewer/dune +++ b/ocaml/xenopsd/suspend_image_viewer/dune @@ -3,7 +3,6 @@ (libraries cmdliner forkexec - uuidm xapi-idl xapi-stdext-unix xapi-xenopsd diff --git a/ocaml/xenopsd/suspend_image_viewer/suspend_image_viewer.ml b/ocaml/xenopsd/suspend_image_viewer/suspend_image_viewer.ml index a70a5fcc049..3d74f551140 100644 --- a/ocaml/xenopsd/suspend_image_viewer/suspend_image_viewer.ml +++ b/ocaml/xenopsd/suspend_image_viewer/suspend_image_viewer.ml @@ -24,7 +24,7 @@ let debug fmt = let error fmt = Printf.ksprintf (msg ~prefix:"error") fmt let verify_libxc_v2_record fd = - let fd_uuid = Uuidm.(to_string (create `V4)) in + let fd_uuid = Uuid.(to_string (make ())) in let path = !Resources.verify_libxc_v2 in let args = ["--in"; fd_uuid; "--syslog"] in ( try Unix.(access path [X_OK]) diff --git a/ocaml/xenopsd/tools/dune b/ocaml/xenopsd/tools/dune index 628c324ed0a..fa6d4519b50 100644 --- a/ocaml/xenopsd/tools/dune +++ b/ocaml/xenopsd/tools/dune @@ -2,5 +2,5 @@ (name set_domain_uuid) (public_name set-domain-uuid) (package xapi-xenopsd-xc) - (libraries xenctrl uuidm cmdliner) + (libraries xenctrl uuid cmdliner) ) diff --git a/ocaml/xenopsd/tools/set_domain_uuid.ml b/ocaml/xenopsd/tools/set_domain_uuid.ml index 5485589a597..13c37db6ef9 100644 --- a/ocaml/xenopsd/tools/set_domain_uuid.ml +++ b/ocaml/xenopsd/tools/set_domain_uuid.ml @@ -2,11 +2,8 @@ (* Intended use case is to set dom0's uuid *) -let is_uuid_valid uuid = - match Uuidm.of_string uuid with None -> false | Some _ -> true - let set domain uuid = - if not (is_uuid_valid uuid) then + if not (Uuid.is_uuid uuid) then `Error (false, "Invalid uuid") else let xc = Xenctrl.interface_open () in diff --git a/ocaml/xenopsd/xc/device.ml b/ocaml/xenopsd/xc/device.ml index a2e22c7ee2c..bc32b1599fc 100644 --- a/ocaml/xenopsd/xc/device.ml +++ b/ocaml/xenopsd/xc/device.ml @@ -2590,7 +2590,7 @@ module Dm_Common = struct } -> (* The VGPU UUID is not available. Create a fresh one; xapi will deal with it. *) - let uuid = Uuidm.to_string (Uuidm.create `V4) in + let uuid = Uuid.(to_string (make ())) in debug "NVidia vGPU config: using config file %s and uuid %s" config_file uuid ; make addr @@ -2768,7 +2768,7 @@ module Dm_Common = struct in let stop_vgpu () = Vgpu.stop ~xs domid in let stop_varstored () = - let vm_uuid = Xenops_helpers.uuid_of_domid ~xs domid |> Uuidm.to_string in + let vm_uuid = Xenops_helpers.uuid_of_domid ~xs domid |> Uuid.to_string in debug "About to stop varstored for domain %d (%s)" domid vm_uuid ; Varstored.stop ~xs domid ; let dbg = Printf.sprintf "stop domid %d" domid in @@ -3376,7 +3376,7 @@ module Backend = struct with_xs (fun xs -> let timeoffset_key = sprintf "/vm/%s/rtc/timeoffset" - (Uuidm.to_string (Xenops_helpers.uuid_of_domid ~xs domid)) + (Uuid.to_string (Xenops_helpers.uuid_of_domid ~xs domid)) in try let rtc = xs.Xs.read timeoffset_key in @@ -3662,7 +3662,7 @@ module Backend = struct ( "VM" , domid |> Xenops_helpers.uuid_of_domid ~xs - |> Uuidm.to_string + |> Uuid.to_string , msg ) ) @@ -3773,7 +3773,7 @@ module Backend = struct ) let tap_open ifname = - let uuid = Uuidm.to_string (Uuidm.create `V4) in + let uuid = Uuid.(to_string (make ())) in let fd = Tuntap.tap_open ifname in (uuid, fd) @@ -4136,7 +4136,7 @@ module Dm = struct debug "Preparing to start varstored for UEFI boot (domid=%d)" domid ; let path = !Xc_resources.varstored in let name = "varstored" in - let vm_uuid = Xenops_helpers.uuid_of_domid ~xs domid |> Uuidm.to_string in + let vm_uuid = Xenops_helpers.uuid_of_domid ~xs domid |> Uuid.to_string in let reset_on_boot = nvram.Nvram_uefi_variables.on_boot = Nvram_uefi_variables.Reset in @@ -4393,7 +4393,7 @@ module Dm = struct debug "Called Dm.restore_varstored (domid=%d)" domid ; let path = Xenops_sandbox.Varstore_guard.prepare ~domid - ~vm_uuid:(Uuidm.to_string (Xenops_helpers.uuid_of_domid ~xs domid)) + ~vm_uuid:(Uuid.to_string (Xenops_helpers.uuid_of_domid ~xs domid)) efivars_resume_path in debug "Writing EFI variables to %s (domid=%d)" path domid ; diff --git a/ocaml/xenopsd/xc/device_common.ml b/ocaml/xenopsd/xc/device_common.ml index 398eeed3bfb..261a9ec26c6 100644 --- a/ocaml/xenopsd/xc/device_common.ml +++ b/ocaml/xenopsd/xc/device_common.ml @@ -227,8 +227,7 @@ let string_of_device (x : device) = It can be made a little more efficient by changing the functions below to take the UUID as an argument (and change the callers as well...) *) let uuid_of_domid domid = - try - with_xs (fun xs -> Uuidm.to_string (Xenops_helpers.uuid_of_domid ~xs domid)) + try with_xs (fun xs -> Uuid.to_string (Xenops_helpers.uuid_of_domid ~xs domid)) with Xenops_helpers.Domain_not_found -> error "uuid_of_domid failed for domid %d" domid ; (* Returning a random string on error is not very neat, but we must avoid @@ -247,7 +246,7 @@ let private_path = "/xapi" let get_private_path domid = sprintf "%s/%s" private_path (uuid_of_domid domid) let get_private_path_by_uuid uuid = - sprintf "%s/%s" private_path (Uuidm.to_string uuid) + sprintf "%s/%s" private_path (Uuid.to_string uuid) let get_private_data_path_of_device (x : device) = sprintf "%s/private/%s/%d" diff --git a/ocaml/xenopsd/xc/device_common.mli b/ocaml/xenopsd/xc/device_common.mli index 4315f0c5bc3..0aacf080eb0 100644 --- a/ocaml/xenopsd/xc/device_common.mli +++ b/ocaml/xenopsd/xc/device_common.mli @@ -80,7 +80,7 @@ val backend_state_path_of_device : xs:Xenstore.Xs.xsh -> device -> string val get_private_path : Xenctrl.domid -> string -val get_private_path_by_uuid : Uuidm.t -> string +val get_private_path_by_uuid : 'a Uuid.t -> string val get_private_data_path_of_device : device -> string diff --git a/ocaml/xenopsd/xc/domain.ml b/ocaml/xenopsd/xc/domain.ml index 9f302e61d83..f52c1084d2a 100644 --- a/ocaml/xenopsd/xc/domain.ml +++ b/ocaml/xenopsd/xc/domain.ml @@ -186,8 +186,6 @@ exception Timeout_backend exception Could_not_read_file of string (* eg linux kernel/ initrd *) -module Uuid = Uuidm - let log_exn_continue msg f x = try f x with e -> @@ -216,8 +214,19 @@ let rec xenstore_iter t fn path = names let get_uuid ~xc domid = - Ez_xenctrl_uuid.uuid_of_handle - (Xenctrl.domain_getinfo xc domid).Xenctrl.handle + let string_of_domain_handle handle = + Array.to_list handle |> List.map string_of_int |> String.concat "; " + in + let raw_uuid = (Xenctrl.domain_getinfo xc domid).Xenctrl.handle in + match Uuid.of_int_array raw_uuid with + | Some x -> + x + | None -> + failwith + (Printf.sprintf "VM handle for domain %i is an invalid uuid: %a" domid + (fun () -> string_of_domain_handle) + raw_uuid + ) let wait_xen_free_mem ~xc ?(maximum_wait_time_seconds = 64) required_memory_kib : bool = @@ -473,9 +482,7 @@ let make ~xc ~xs vm_info vcpus domain_config uuid final_uuid no_sharept = (if vm_info.has_vendor_device then "1" else "0") ; (* CA-30811: let the linux guest agent easily determine if this is a fresh domain even if the domid hasn't changed (consider cross-host migrate) *) - xs.Xs.write - (dom_path ^ "/unique-domain-id") - (Uuid.to_string (Uuid.create `V4)) ; + xs.Xs.write (dom_path ^ "/unique-domain-id") Uuid.(to_string (make ())) ; info "VM = %s; domid = %d" (Uuid.to_string uuid) domid ; domid with e -> @@ -1181,13 +1188,13 @@ let with_emu_manager_restore (task : Xenops_task.task_handle) ~domain_type let mode = match domain_type with `hvm | `pvh -> "hvm_restore" | `pv -> "restore" in - let fd_uuid = Uuid.(to_string (create `V4)) in + let fd_uuid = Uuid.(to_string (make ())) in let vgpu_args, vgpu_cmdline = match vgpu_fd with | Some fd when fd = main_fd -> ([(fd_uuid, main_fd)], ["-dm"; "vgpu:" ^ fd_uuid]) | Some fd -> - let vgpu_fd_uuid = Uuid.(to_string (create `V4)) in + let vgpu_fd_uuid = Uuid.(to_string (make ())) in ([(vgpu_fd_uuid, fd)], ["-dm"; "vgpu:" ^ vgpu_fd_uuid]) | None -> ([], []) @@ -1580,7 +1587,7 @@ let suspend_emu_manager ~(task : Xenops_task.task_handle) ~xc:_ ~xs ~domain_type let open Suspend_image in let open Suspend_image.M in let open Emu_manager in - let fd_uuid = Uuid.(to_string (create `V4)) in + let fd_uuid = Uuid.(to_string (make ())) in let mode = match domain_type with `hvm | `pvh -> "hvm_save" | `pv -> "save" in @@ -1589,7 +1596,7 @@ let suspend_emu_manager ~(task : Xenops_task.task_handle) ~xc:_ ~xs ~domain_type | Some fd when fd = main_fd -> ([(fd_uuid, main_fd)], ["-dm"; "vgpu:" ^ fd_uuid]) | Some fd -> - let vgpu_fd_uuid = Uuid.(to_string (create `V4)) in + let vgpu_fd_uuid = Uuid.(to_string (make ())) in ([(vgpu_fd_uuid, fd)], ["-dm"; "vgpu:" ^ vgpu_fd_uuid]) | None -> ([], []) @@ -1731,7 +1738,7 @@ let write_varstored_record task ~xs domid main_fd = let open Suspend_image.M in let varstored_record = Device.Dm.suspend_varstored task ~xs domid - ~vm_uuid:(Uuidm.to_string (Xenops_helpers.uuid_of_domid ~xs domid)) + ~vm_uuid:(Uuid.to_string (Xenops_helpers.uuid_of_domid ~xs domid)) in let varstored_rec_len = String.length varstored_record in debug "Writing varstored record (domid=%d length=%d)" domid varstored_rec_len ; diff --git a/ocaml/xenopsd/xc/domain.mli b/ocaml/xenopsd/xc/domain.mli index 56a2e2a2467..d2fa1b4de1e 100644 --- a/ocaml/xenopsd/xc/domain.mli +++ b/ocaml/xenopsd/xc/domain.mli @@ -147,7 +147,7 @@ val make : -> create_info -> int -> arch_domainconfig - -> Uuidm.t + -> [`Vm] Uuid.t -> string option -> bool (* no_sharept *) -> domid @@ -285,7 +285,7 @@ val soft_reset : xc:Xenctrl.handle -> xs:Xenstore.Xs.xsh -> domid -> unit val vcpu_affinity_get : xc:Xenctrl.handle -> domid -> int -> bool array (** Get Cpu affinity of some vcpus of a domain *) -val get_uuid : xc:Xenctrl.handle -> Xenctrl.domid -> Uuidm.t +val get_uuid : xc:Xenctrl.handle -> Xenctrl.domid -> [`Vm] Uuid.t (** Get the uuid from a specific domain *) val set_memory_dynamic_range : diff --git a/ocaml/xenopsd/xc/dune b/ocaml/xenopsd/xc/dune index 276ad09478d..3fca1008239 100644 --- a/ocaml/xenopsd/xc/dune +++ b/ocaml/xenopsd/xc/dune @@ -24,7 +24,7 @@ sexplib0 qmp threads.posix - uuidm + uuid xapi-backtrace xapi-idl xapi-idl.memory @@ -62,7 +62,7 @@ (libraries ezxenstore.core - uuidm + uuid xapi-idl.varstore.privileged xapi-idl.xen.interface xapi-inventory diff --git a/ocaml/xenopsd/xc/emu_manager.ml b/ocaml/xenopsd/xc/emu_manager.ml index 9ee7605c0ad..6a291d07b5d 100644 --- a/ocaml/xenopsd/xc/emu_manager.ml +++ b/ocaml/xenopsd/xc/emu_manager.ml @@ -50,8 +50,8 @@ let connect path (args : string list) (fds : (string * Unix.file_descr) list) : t = debug "connect: args = [ %s ]" (String.concat " " args) ; (* Need to send commands and receive responses from the slave process *) - let slave_to_server_w_uuid = Uuidm.to_string (Uuidm.create `V4) in - let server_to_slave_r_uuid = Uuidm.to_string (Uuidm.create `V4) in + let slave_to_server_w_uuid = Uuid.(to_string (make ())) in + let server_to_slave_r_uuid = Uuid.(to_string (make ())) in let slave_to_server_r, slave_to_server_w = Unix.pipe () in let server_to_slave_r, server_to_slave_w = Unix.pipe () in let args = diff --git a/ocaml/xenopsd/xc/xenguestHelper.ml b/ocaml/xenopsd/xc/xenguestHelper.ml index b553c649b99..440be14c97f 100644 --- a/ocaml/xenopsd/xc/xenguestHelper.ml +++ b/ocaml/xenopsd/xc/xenguestHelper.ml @@ -53,8 +53,8 @@ let connect path (args : string list) (fds : (string * Unix.file_descr) list) : t = debug "connect: args = [ %s ]" (String.concat " " args) ; (* Need to send commands and receive responses from the slave process *) - let slave_to_server_w_uuid = Uuidm.to_string (Uuidm.create `V4) in - let server_to_slave_r_uuid = Uuidm.to_string (Uuidm.create `V4) in + let slave_to_server_w_uuid = Uuid.(to_string (make ())) in + let server_to_slave_r_uuid = Uuid.(to_string (make ())) in let slave_to_server_r, slave_to_server_w = Unix.pipe () in let server_to_slave_r, server_to_slave_w = Unix.pipe () in let args = diff --git a/ocaml/xenopsd/xc/xenops_helpers.ml b/ocaml/xenopsd/xc/xenops_helpers.ml index d4aa332146b..3548a64a348 100644 --- a/ocaml/xenopsd/xc/xenops_helpers.ml +++ b/ocaml/xenopsd/xc/xenops_helpers.ml @@ -30,7 +30,7 @@ let uuid_of_domid ~xs domid = try let vm = xs.Xs.getdomainpath domid ^ "/vm" in let vm_dir = xs.Xs.read vm in - match Uuidm.of_string (xs.Xs.read (vm_dir ^ "/uuid")) with + match Uuid.of_string (xs.Xs.read (vm_dir ^ "/uuid")) with | Some uuid -> uuid | None -> @@ -38,6 +38,23 @@ let uuid_of_domid ~xs domid = with _ -> raise Domain_not_found let domains_of_uuid ~xc uuid = + let string_of_domain_handle handle = + Array.to_list handle |> List.map string_of_int |> String.concat "; " + in + List.filter - (fun x -> Ez_xenctrl_uuid.uuid_of_handle x.Xenctrl.handle = uuid) + (fun x -> + match Uuid.of_int_array x.Xenctrl.handle with + | Some x -> + x = uuid + | None -> + failwith + (Printf.sprintf + "Invalid VM handle for domid %d returned by domain_getinfolist \ + at %s: %a" + x.Xenctrl.domid __FUNCTION__ + (fun () -> string_of_domain_handle) + x.Xenctrl.handle + ) + ) (Xenctrl.domain_getinfolist xc 0) diff --git a/ocaml/xenopsd/xc/xenops_server_xen.ml b/ocaml/xenopsd/xc/xenops_server_xen.ml index cc6fb5ca0ac..8e77f16b1da 100644 --- a/ocaml/xenopsd/xc/xenops_server_xen.ml +++ b/ocaml/xenopsd/xc/xenops_server_xen.ml @@ -226,7 +226,7 @@ let this_domid ~xs = try int_of_string (xs.Xs.read "domid") with _ -> 0 let uuid_of_string x = - match Uuidm.of_string x with + match Uuid.of_string x with | Some x -> x | None -> @@ -235,22 +235,18 @@ let uuid_of_string x = let uuid_of_vm vm = uuid_of_string vm.Vm.id -let uuid_of_di di = Ez_xenctrl_uuid.uuid_of_handle di.Xenctrl.handle - let di_of_uuid ~xc uuid = let open Xenctrl in - let uuid' = Uuidm.to_string uuid in - let all = domain_getinfolist xc 0 in - let possible = List.filter (fun x -> uuid_of_di x = uuid) all in - match possible with + match Xenops_helpers.domains_of_uuid ~xc uuid with | [] -> None | [x] -> Some x - | xs -> + | possible -> let domid_list = - String.concat ", " (List.map (fun x -> string_of_int x.domid) xs) + String.concat ", " (List.map (fun x -> string_of_int x.domid) possible) in + let uuid' = Uuid.to_string uuid in error "VM %s: there are %d domains (%s) with the same uuid: one or more have \ leaked" @@ -263,12 +259,14 @@ let di_of_uuid ~xc uuid = ) ) ) + | exception Failure r -> + raise (Xenopsd_error (Internal_error r)) let domid_of_uuid ~xs uuid = (* We don't fully control the domain lifecycle because libxenguest will actually destroy a domain on suspend. Therefore we only rely on state in xenstore *) - let dir = Printf.sprintf "/vm/%s/domains" (Uuidm.to_string uuid) in + let dir = Printf.sprintf "/vm/%s/domains" (Uuid.to_string uuid) in try match xs.Xs.directory dir |> List.map int_of_string |> List.sort compare @@ -284,7 +282,7 @@ let domid_of_uuid ~xs uuid = (Xenopsd_error (Internal_error (Printf.sprintf "More than one domain with uuid (%s): %s" - (Uuidm.to_string uuid) domid_list + (Uuid.to_string uuid) domid_list ) ) ) @@ -292,7 +290,7 @@ let domid_of_uuid ~xs uuid = error "Failed to read %s: has this domain already been cleaned up?" dir ; None -let get_uuid ~xc domid = uuid_of_di (Xenctrl.domain_getinfo xc domid) +let get_uuid ~xc domid = Domain.get_uuid ~xc domid let device_kind_of_backend_keys backend_keys = try Device_common.vbd_kind_of_string (List.assoc "backend-kind" backend_keys) @@ -346,8 +344,8 @@ let params_of_backend backend = (params, xenstore_data, extra_keys) let create_vbd_frontend ~xc ~xs task frontend_domid vdi = - let frontend_vm_id = get_uuid ~xc frontend_domid |> Uuidm.to_string in - let backend_vm_id = get_uuid ~xc vdi.domid |> Uuidm.to_string in + let frontend_vm_id = get_uuid ~xc frontend_domid |> Uuid.to_string in + let backend_vm_id = get_uuid ~xc vdi.domid |> Uuid.to_string in match domid_of_uuid ~xs (uuid_of_string backend_vm_id) with | None -> error @@ -527,7 +525,7 @@ let with_disk ~xc ~xs task disk write f = finally (fun () -> let frontend_domid = this_domid ~xs in - let frontend_vm = get_uuid ~xc frontend_domid |> Uuidm.to_string in + let frontend_vm = get_uuid ~xc frontend_domid |> Uuid.to_string in let vdi = attach_and_activate ~xc ~xs task frontend_vm dp sr vdi write in @@ -565,7 +563,7 @@ module Mem = struct "Got error_domains_refused_to_cooperate_code from ballooning daemon" ; Xenctrl.with_intf (fun xc -> let vms = - List.map (get_uuid ~xc) domids |> List.map Uuidm.to_string + List.map (get_uuid ~xc) domids |> List.map Uuid.to_string in raise (Xenopsd_error (Vms_failed_to_cooperate vms)) ) @@ -2448,7 +2446,7 @@ module VM = struct let uuid = uuid_of_vm vm in match domid_of_uuid ~xs uuid with | None -> - failwith (Printf.sprintf "VM %s disappeared" (Uuidm.to_string uuid)) + failwith (Printf.sprintf "VM %s disappeared" (Uuid.to_string uuid)) | Some domid -> Device.Dm.assert_can_suspend ~xs ~dm:(dm_of ~vm) domid ) @@ -2784,7 +2782,7 @@ module VM = struct let rtc = try xs.Xs.read - (Printf.sprintf "/vm/%s/rtc/timeoffset" (Uuidm.to_string uuid)) + (Printf.sprintf "/vm/%s/rtc/timeoffset" (Uuid.to_string uuid)) with Xs_protocol.Enoent _ -> "" in let ls_l ~depth root dir = @@ -4796,7 +4794,7 @@ module Actions = struct let xenbus_connected = Xenbus_utils.(int_of Connected) |> string_of_int let maybe_update_pv_drivers_detected ~xc ~xs domid path = - let vm = get_uuid ~xc domid |> Uuidm.to_string in + let vm = get_uuid ~xc domid |> Uuid.to_string in Option.iter (function | {VmExtra.persistent} -> ( @@ -4990,6 +4988,21 @@ module Actions = struct List.iter (add_device_watch xs) new_devices ; List.iter (remove_device_watch xs) old_devices in + let uuid_of_domain di = + let string_of_domain_handle handle = + Array.to_list handle |> List.map string_of_int |> String.concat "; " + in + match Uuid.of_int_array di.Xenctrl.handle with + | Some x -> + x + | None -> + failwith + (Printf.sprintf "VM handle for domain %i is an invalid uuid: %a" + di.Xenctrl.domid + (fun () -> string_of_domain_handle) + di.Xenctrl.handle + ) + in let fire_event_on_vm domid = let d = int_of_string domid in let open Xenstore_watch in @@ -4997,7 +5010,7 @@ module Actions = struct debug "Ignoring watch on shutdown domain %d" d else let di = IntMap.find d domains in - let id = Uuidm.to_string (uuid_of_di di) in + let id = Uuid.to_string (uuid_of_domain di) in Updates.add (Dynamic.Vm id) internal_updates in let fire_event_on_device domid kind devid = @@ -5007,7 +5020,7 @@ module Actions = struct debug "Ignoring watch on shutdown domain %d" d else let di = IntMap.find d domains in - let id = Uuidm.to_string (uuid_of_di di) in + let id = Uuid.to_string (uuid_of_domain di) in let update = match kind with | "vbd" | "vbd3" | "qdisk" | "9pfs" -> @@ -5041,7 +5054,7 @@ module Actions = struct | Some signal -> debug "Received unexpected qemu-pid-signal %s for domid %d" signal d ; let di = IntMap.find d domains in - let id = Uuidm.to_string (uuid_of_di di) in + let id = Uuid.to_string (uuid_of_domain di) in qemu_disappeared di xc xs ; Updates.add (Dynamic.Vm id) internal_updates in diff --git a/ocaml/xenopsd/xc/xenops_xc_main.ml b/ocaml/xenopsd/xc/xenops_xc_main.ml index cc26065e90c..c61f8d8ada2 100644 --- a/ocaml/xenopsd/xc/xenops_xc_main.ml +++ b/ocaml/xenopsd/xc/xenops_xc_main.ml @@ -18,7 +18,7 @@ let check_domain0_uuid () = let uuid = try Inventory.lookup Inventory._control_domain_uuid with _ -> - let uuid = Uuidm.(to_string (create `V4)) in + let uuid = Uuid.(to_string (make ())) in Inventory.update Inventory._control_domain_uuid uuid ; uuid in diff --git a/stunnel.opam b/stunnel.opam index db46d705cf8..b8bb58c9f4c 100644 --- a/stunnel.opam +++ b/stunnel.opam @@ -13,7 +13,7 @@ depends: [ "astring" "forkexec" "safe-resources" - "uuidm" + "uuid" "xapi-idl" "xapi-inventory" "xapi-stdext-pervasives" diff --git a/wsproxy.opam b/wsproxy.opam index 73f3edd2355..7724bf6b07a 100644 --- a/wsproxy.opam +++ b/wsproxy.opam @@ -18,7 +18,7 @@ depends: [ "logs" "lwt" {>= "3.0.0"} "re" - "uuidm" + "uuid" "ounit" {with-test} "qcheck" {with-test} ] diff --git a/xapi-forkexecd.opam b/xapi-forkexecd.opam index 13cd4e1af7f..efa430cec1d 100644 --- a/xapi-forkexecd.opam +++ b/xapi-forkexecd.opam @@ -16,7 +16,7 @@ depends: [ "astring" "forkexec" "systemd" {>= "1.2"} - "uuidm" + "uuid" "xapi-stdext-unix" ] conflicts: [ diff --git a/xapi-nbd.opam b/xapi-nbd.opam index 075df4dbf19..3c0918a5a96 100644 --- a/xapi-nbd.opam +++ b/xapi-nbd.opam @@ -19,7 +19,7 @@ depends: [ "mirage-block-unix" "nbd-unix" "uri" - "uuidm" + "uuid" "xapi-inventory" "xen-api-client-lwt" ] diff --git a/xapi-squeezed.opam b/xapi-squeezed.opam index a8f97dea621..760ca5d39c9 100644 --- a/xapi-squeezed.opam +++ b/xapi-squeezed.opam @@ -11,7 +11,7 @@ build: [ depends: [ "ocaml" "dune" - "uuidm" + "uuid" "xapi-stdext-pervasives" "xapi-stdext-threads" "xapi-stdext-unix" diff --git a/xapi-types.opam b/xapi-types.opam index c50f4ee5bcf..ac23046c019 100644 --- a/xapi-types.opam +++ b/xapi-types.opam @@ -21,7 +21,6 @@ depends: [ "sexpr" "base-threads" "uuid" - "uuidm" "xapi-consts" "xapi-datamodel" "xapi-stdext-date" diff --git a/xapi-xenopsd-cli.opam b/xapi-xenopsd-cli.opam index fbc9c2d0485..f5166466189 100644 --- a/xapi-xenopsd-cli.opam +++ b/xapi-xenopsd-cli.opam @@ -16,7 +16,7 @@ depends: [ "re" "rpclib" "rresult" - "uuidm" + "uuid" "xapi-idl" "xenstore_transport" {with-test} ] diff --git a/xapi-xenopsd-xc.opam b/xapi-xenopsd-xc.opam index 628503e0cfb..4cfbce452c8 100644 --- a/xapi-xenopsd-xc.opam +++ b/xapi-xenopsd-xc.opam @@ -33,7 +33,6 @@ depends: [ "rresult" "sexplib0" "uuid" - "uuidm" "xapi-backtrace" "xapi-idl" "xapi-rrd" diff --git a/xapi-xenopsd.opam b/xapi-xenopsd.opam index 11e5fbeb7d5..cb35ca8b619 100644 --- a/xapi-xenopsd.opam +++ b/xapi-xenopsd.opam @@ -29,7 +29,7 @@ depends: [ "sexplib" "sexplib0" "uri" - "uuidm" + "uuid" "uutf" "xapi-backtrace" "xapi-idl" diff --git a/xen-api-client.opam b/xen-api-client.opam index 27ab34f1520..c4c46f66c29 100644 --- a/xen-api-client.opam +++ b/xen-api-client.opam @@ -22,7 +22,7 @@ depends: [ "rpclib" "xapi-rrd" "uri" - "uuidm" + "uuid" "xapi-client" "xapi-types" "xmlm"