diff --git a/ocaml/idl/ocaml_backend/gen_db_actions.ml b/ocaml/idl/ocaml_backend/gen_db_actions.ml index fd7cf6ce46f..b1eda4cfe01 100644 --- a/ocaml/idl/ocaml_backend/gen_db_actions.ml +++ b/ocaml/idl/ocaml_backend/gen_db_actions.ml @@ -86,7 +86,7 @@ let dm_to_string tys : O.Module.t = "(Ref.string_of : " ^ OU.ocaml_of_ty ty ^ " -> string)" (* | DT.Ref "session" -> "(Uuid.string_of_cookie : "^OU.ocaml_of_ty ty^" -> string)" - | DT.Ref s -> "(Uuid.string_of_uuid : "^OU.ocaml_of_ty ty^" -> string)" + | DT.Ref s -> "(Uuid.to_string : "^OU.ocaml_of_ty ty^" -> string)" *) | DT.Set ty -> "fun s -> set " ^ OU.alias_of_ty ty ^ " s" diff --git a/ocaml/idl/ocaml_backend/gen_rbac.ml b/ocaml/idl/ocaml_backend/gen_rbac.ml index 1f67b9e14df..e582d015cea 100644 --- a/ocaml/idl/ocaml_backend/gen_rbac.ml +++ b/ocaml/idl/ocaml_backend/gen_rbac.ml @@ -57,18 +57,7 @@ let writer_csv static_roles_permissions static_permissions_roles = let hash2uuid str = let h = Digest.string str in - let hex = Digest.to_hex h in - let int_array hex = - let l = ref [] in - Scanf.sscanf hex - "%02x%02x%02x%02x%02x%02x%02x%02x%02x%02x%02x%02x%02x%02x%02x%02x" - (fun a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 -> - l := - [a0; a1; a2; a3; a4; a5; a6; a7; a8; a9; a10; a11; a12; a13; a14; a15] - ) ; - Array.of_list !l - in - Uuid.string_of_uuid (Uuid.uuid_of_int_array (int_array hex)) + Option.map Uuid.to_string (Uuid.of_bytes h) let replace_char str c1 c2 = let buf = Bytes.of_string str in @@ -76,7 +65,7 @@ let replace_char str c1 c2 = String.iteri (fun i _ -> if str.[i] = c1 then Bytes.set buf i c2 else ()) str ; Bytes.unsafe_to_string buf -let role_uuid name = hash2uuid name +let role_uuid name = Option.get (hash2uuid name) let permission_description = "A basic permission" diff --git a/ocaml/mpathalert/mpathalert.ml b/ocaml/mpathalert/mpathalert.ml index 195a80e5426..4499d2ad138 100644 --- a/ocaml/mpathalert/mpathalert.ml +++ b/ocaml/mpathalert/mpathalert.ml @@ -103,12 +103,13 @@ let create_pbd_alerts rpc session snapshot (pbd_ref, pbd_rec, timestamp) = Scanf.sscanf value "[%d, %d]" (fun current max -> (current, max)) in let host = - Uuid.of_string (Client.Host.get_uuid rpc session pbd_rec.API.pBD_host) + Option.get + (Uuid.of_string (Client.Host.get_uuid rpc session pbd_rec.API.pBD_host)) in let host_name = Client.Host.get_name_label rpc session pbd_rec.API.pBD_host in - let pbd = Uuid.of_string pbd_rec.API.pBD_uuid in + let pbd = Option.get (Uuid.of_string pbd_rec.API.pBD_uuid) in let alert = {host; host_name; pbd; timestamp; scsi_id; current; max} in debug "Alert '%s' created from %s=%s" (to_string alert) key value ; alert @@ -127,7 +128,7 @@ let create_host_alerts rpc session snapshot (host_ref, host_rec, timestamp) = let current, max = Scanf.sscanf value "[%d, %d]" (fun current max -> (current, max)) in - let host = Uuid.of_string host_rec.API.host_uuid in + let host = Option.get (Uuid.of_string host_rec.API.host_uuid) in let host_name = host_rec.API.host_name_label in let pbd = Uuid.null in let alert = {host; host_name; pbd; timestamp; scsi_id; current; max} in diff --git a/ocaml/quicktest/quicktest_vdi.ml b/ocaml/quicktest/quicktest_vdi.ml index ac31c599bdd..5051a70ef3a 100644 --- a/ocaml/quicktest/quicktest_vdi.ml +++ b/ocaml/quicktest/quicktest_vdi.ml @@ -150,7 +150,7 @@ let vdi_bad_introduce rpc session_id sr_info () = ) ; let (_ : API.ref_VDI) = Client.Client.VDI.introduce ~rpc ~session_id - ~uuid:(Uuid.string_of_uuid (Uuid.make_uuid ())) + ~uuid:(Uuid.to_string (Uuid.make_uuid ())) ~name_label:"bad location" ~name_description:"" ~sR:vdir.API.vDI_SR ~_type:vdir.API.vDI_type ~sharable:false ~read_only:false ~other_config:[] ~location:vdir.API.vDI_location ~xenstore_data:[] diff --git a/ocaml/tests/common/test_common.ml b/ocaml/tests/common/test_common.ml index 49698e7d4d7..730ef3a75e0 100644 --- a/ocaml/tests/common/test_common.ml +++ b/ocaml/tests/common/test_common.ml @@ -20,7 +20,7 @@ let working_area = "/tmp/xapi-test" (** Utility functions *) let id (x : 'a) : 'a = x -let make_uuid () = Uuid.string_of_uuid (Uuid.make_uuid ()) +let make_uuid () = Uuid.to_string (Uuid.make_uuid ()) let assert_raises_api_error (code : string) ?(args : string list option) (f : unit -> 'a) : unit = diff --git a/ocaml/xapi/import.ml b/ocaml/xapi/import.ml index 6e63cafdc54..ea45ba7273e 100644 --- a/ocaml/xapi/import.ml +++ b/ocaml/xapi/import.ml @@ -532,7 +532,7 @@ module VM : HandlerTools = struct if config.full_restore then other_config else - (Xapi_globs.mac_seed, Uuid.string_of_uuid (Uuid.make_uuid ())) + (Xapi_globs.mac_seed, Uuid.to_string (Uuid.make_uuid ())) :: List.filter (fun (x, _) -> x <> Xapi_globs.mac_seed) other_config in let vm_record = {vm_record with API.vM_other_config= other_config} in diff --git a/ocaml/xapi/storage_access.ml b/ocaml/xapi/storage_access.ml index 353f09ca74f..668cc9bf255 100644 --- a/ocaml/xapi/storage_access.ml +++ b/ocaml/xapi/storage_access.ml @@ -635,7 +635,7 @@ module SMAPIv1 = struct let other_config = Db.VDI.get_other_config ~__context ~self in if not (List.mem_assoc "content_id" other_config) then Db.VDI.add_to_other_config ~__context ~self ~key:"content_id" - ~value:(Uuid.string_of_uuid (Uuid.make_uuid ())) + ~value:(Uuid.to_string (Uuid.make_uuid ())) ) ; (* If the backend doesn't advertise the capability then do nothing *) if List.mem_assoc Smint.Vdi_deactivate (Sm.features_of_driver _type) @@ -737,7 +737,7 @@ module SMAPIv1 = struct try List.assoc "content_id" (Db.VDI.get_other_config ~__context ~self:clonee) - with _ -> Uuid.string_of_uuid (Uuid.make_uuid ()) + with _ -> Uuid.to_string (Uuid.make_uuid ()) in let snapshot_time = Date.of_float (Unix.gettimeofday ()) in Db.VDI.set_name_label ~__context ~self ~value:vdi_info.name_label ; diff --git a/ocaml/xapi/storage_migrate.ml b/ocaml/xapi/storage_migrate.ml index 364acb307bd..56e63f6bdd6 100644 --- a/ocaml/xapi/storage_migrate.ml +++ b/ocaml/xapi/storage_migrate.ml @@ -493,9 +493,9 @@ let copy' ~task ~dbg ~sr ~vdi ~url ~dest ~dest_vdi = None in try - let remote_dp = Uuid.string_of_uuid (Uuid.make_uuid ()) in - let base_dp = Uuid.string_of_uuid (Uuid.make_uuid ()) in - let leaf_dp = Uuid.string_of_uuid (Uuid.make_uuid ()) in + let remote_dp = Uuid.to_string (Uuid.make_uuid ()) in + let base_dp = Uuid.to_string (Uuid.make_uuid ()) in + let leaf_dp = Uuid.to_string (Uuid.make_uuid ()) in let dest_vdi_url = Http.Url.set_uri remote_url (Printf.sprintf "%s/nbd/%s/%s/%s" @@ -968,7 +968,7 @@ let receive_start ~dbg ~sr ~vdi_info ~id ~similar = let vdis = Local.SR.scan dbg sr in (* We drop cbt_metadata VDIs that do not have any actual data *) let vdis = List.filter (fun vdi -> vdi.ty <> "cbt_metadata") vdis in - let leaf_dp = Local.DP.create dbg (Uuid.string_of_uuid (Uuid.make_uuid ())) in + let leaf_dp = Local.DP.create dbg (Uuid.to_string (Uuid.make_uuid ())) in try let vdi_info = {vdi_info with sm_config= [("base_mirror", id)]} in let leaf = Local.VDI.create dbg sr vdi_info in diff --git a/ocaml/xapi/taskHelper.ml b/ocaml/xapi/taskHelper.ml index a475b229497..a6078c413a2 100644 --- a/ocaml/xapi/taskHelper.ml +++ b/ocaml/xapi/taskHelper.ml @@ -25,7 +25,7 @@ let now () = Date.of_float (Unix.time ()) let make ~__context ~http_other_config ?(description = "") ?session_id ?subtask_of label : t * t Uuid.t = let uuid = Uuid.make_uuid () in - let uuid_str = Uuid.string_of_uuid uuid in + let uuid_str = Uuid.to_string uuid in let ref = Ref.make () in (* we store in database only parent/child relationship between real tasks *) let subtaskid_of = diff --git a/ocaml/xapi/xapi_ha.ml b/ocaml/xapi/xapi_ha.ml index 62f6b0ea596..169cc81f9b2 100644 --- a/ocaml/xapi/xapi_ha.ml +++ b/ocaml/xapi/xapi_ha.ml @@ -108,11 +108,18 @@ let address_of_host_uuid uuid = the host IP address *) let uuid_of_host_address address = let table = List.map (fun (k, v) -> (v, k)) (get_uuid_to_ip_mapping ()) in - if not (List.mem_assoc address table) then ( - error "Failed to find the UUID address of host with address %s" address ; - raise Not_found - ) else - List.assoc address table + match List.assoc_opt address table with + | None -> + error "Failed to find the UUID address of host with address %s" address ; + raise Not_found + | Some uuid_str -> ( + match Uuid.of_string uuid_str with + | None -> + error "Failed parse UUID of host with address %s" address ; + raise (Invalid_argument "Invalid UUID") + | Some uuid -> + uuid + ) (** Called in two circumstances: 1. When I started up I thought I was the master but my proposal was rejected by the @@ -174,11 +181,11 @@ let on_master_failure () = info "no other master exists yet; waiting 5 seconds and retrying" ; Thread.delay 5. | [uuid] -> - become_slave_of (Uuid.string_of_uuid uuid) + become_slave_of (Uuid.to_string uuid) | xs -> (* should never happen *) error "multiple masters reported: [ %s ]; failing" - (String.concat "; " (List.map Uuid.string_of_uuid xs)) ; + (String.concat "; " (List.map Uuid.to_string xs)) ; failwith "multiple masters" ) done @@ -452,7 +459,7 @@ module Monitor = struct let master_uuid = uuid_of_host_address address in let master_info = Hashtbl.find liveset.Xha_interface.LiveSetInformation.hosts - (Uuid.uuid_of_string master_uuid) + master_uuid in if true @@ -466,7 +473,8 @@ module Monitor = struct warn "We think node %s (%s) is the master but the liveset \ disagrees" - master_uuid address ; + (Uuid.to_string master_uuid) + address ; on_master_failure () ) in @@ -509,8 +517,7 @@ module Monitor = struct let liveset_refs = List.map (fun uuid -> - Db.Host.get_by_uuid ~__context - ~uuid:(Uuid.string_of_uuid uuid) + Db.Host.get_by_uuid ~__context ~uuid:(Uuid.to_string uuid) ) liveset_uuids in @@ -585,8 +592,8 @@ module Monitor = struct ( host , Hashtbl.find liveset.Xha_interface.LiveSetInformation.hosts - (Uuid.uuid_of_string - (Db.Host.get_uuid ~__context ~self:host) + (Uuid.of_string (Db.Host.get_uuid ~__context ~self:host) + |> Option.get ) ) ) @@ -650,8 +657,9 @@ module Monitor = struct local .Xha_interface.LiveSetInformation.RawStatus .host_raw_data - (Uuid.uuid_of_string + (Uuid.of_string (Db.Host.get_uuid ~__context ~self:host) + |> Option.get ) ) ) @@ -677,7 +685,7 @@ module Monitor = struct .Xha_interface.LiveSetInformation.HostRawData .heartbeat_active_list_on_heartbeat in - let peer_strings = List.map Uuid.string_of_uuid peers in + let peer_strings = List.map Uuid.to_string peers in debug "Network peers = [%s]" (String.concat ";" peer_strings) ; let existing_strings = @@ -733,7 +741,7 @@ module Monitor = struct if Mutex.execute m (fun () -> not !request_shutdown) then ( let liveset = query_liveset_on_all_hosts () in let uuids = - List.map Uuid.string_of_uuid (uuids_of_liveset liveset) + List.map Uuid.to_string (uuids_of_liveset liveset) in let enabled = List.map @@ -1293,7 +1301,7 @@ let write_config_file ~__context statevdi_paths generation = ~xapi_restart_attempts:timeouts.Timeouts.xapi_restart_attempts ~xapi_restart_timeout:timeouts.Timeouts.xapi_restart_timeout ~common_udp_port:Xapi_globs.xha_udp_port - ~common_generation_uuid:(Uuid.uuid_of_string generation) + ~common_generation_uuid:(Uuid.of_string generation |> Option.get) ~local_heart_beat_interface ~local_heart_beat_physical_interface ~local_state_file ~__context () in @@ -1370,9 +1378,7 @@ let join_liveset __context host = (* If this host is a slave then we must wait to confirm that the master manages to assert itself, otherwise our monitoring thread might attempt a hostile takeover *) let master_address = Pool_role.get_master_address () in - let master_uuid = - Uuid.uuid_of_string (uuid_of_host_address master_address) - in + let master_uuid = uuid_of_host_address master_address in let master_found = ref false in while not !master_found do (* It takes a non-trivial amount of time for the master to assert itself: we might @@ -1880,7 +1886,7 @@ let enable __context heartbeat_srs configuration = (* Start by assuming there is no ha_plan_for: this can be revised upwards later *) Db.Pool.set_ha_plan_exists_for ~__context ~self:pool ~value:0L ; let (_ : bool) = Xapi_ha_vm_failover.update_pool_status ~__context () in - let generation = Uuid.string_of_uuid (Uuid.make_uuid ()) in + let generation = Uuid.to_string (Uuid.make_uuid ()) in let hosts = Db.Host.get_all ~__context in (* This code always runs on the master *) let statefiles = attach_statefiles ~__context !statefile_vdis in diff --git a/ocaml/xapi/xapi_pool_update.ml b/ocaml/xapi/xapi_pool_update.ml index 101995a1f0b..eedcad9481f 100644 --- a/ocaml/xapi/xapi_pool_update.ml +++ b/ocaml/xapi/xapi_pool_update.ml @@ -505,13 +505,13 @@ let verify update_info update_path = (Option.value ~default:"" update_info.key) let patch_uuid_of_update_uuid uuid = - let arr = Uuid.int_array_of_uuid (Uuid.uuid_of_string uuid) in + let arr = Uuid.of_string uuid |> Option.get |> Uuid.to_int_array in let modify x = arr.(x) <- 0 in modify 4 ; modify 5 ; modify 6 ; modify 7 ; - Uuid.uuid_of_int_array arr |> Uuid.string_of_uuid + Uuid.of_int_array arr |> Option.get |> Uuid.to_string let create_update_record ~__context ~update ~update_info ~vdi = let patch_ref = Ref.make () in diff --git a/ocaml/xapi/xapi_sm.ml b/ocaml/xapi/xapi_sm.ml index bfa6d62d3f1..67ed5b59a58 100644 --- a/ocaml/xapi/xapi_sm.ml +++ b/ocaml/xapi/xapi_sm.ml @@ -33,7 +33,7 @@ module D = Debug.Make (struct let name = "xapi_sm" end) open D let create_from_query_result ~__context q = - let r = Ref.make () and u = Uuid.string_of_uuid (Uuid.make_uuid ()) in + let r = Ref.make () and u = Uuid.to_string (Uuid.make_uuid ()) in let open Storage_interface in if String.lowercase_ascii q.driver <> "storage_access" then ( let features = Smint.parse_string_int64_features q.features in diff --git a/ocaml/xapi/xapi_sr.ml b/ocaml/xapi/xapi_sr.ml index a31984dc93b..75110a525af 100644 --- a/ocaml/xapi/xapi_sr.ml +++ b/ocaml/xapi/xapi_sr.ml @@ -697,15 +697,15 @@ let update_vdis ~__context ~sr db_vdis vdi_infos = (fun loc vdi m -> let ref = Ref.make () in let uuid = - match vdi.uuid with + match Option.bind vdi.uuid Uuid.of_string with | Some x -> - Uuid.of_string x + x | None -> Uuid.make_uuid () in debug "Creating VDI: %s (ref=%s)" (string_of_vdi_info vdi) (Ref.string_of ref) ; - Db.VDI.create ~__context ~ref ~uuid:(Uuid.string_of_uuid uuid) + Db.VDI.create ~__context ~ref ~uuid:(Uuid.to_string uuid) ~name_label:vdi.name_label ~name_description:vdi.name_description ~current_operations:[] ~allowed_operations:[] ~is_a_snapshot:vdi.is_a_snapshot diff --git a/ocaml/xapi/xapi_vbd.ml b/ocaml/xapi/xapi_vbd.ml index 68d8f29501d..e4a8e0dbcc8 100644 --- a/ocaml/xapi/xapi_vbd.ml +++ b/ocaml/xapi/xapi_vbd.ml @@ -275,7 +275,7 @@ let create ~__context ~vM ~vDI ~device ~userdevice ~bootable ~mode ~_type let uuid = Uuid.make_uuid () in let ref = Ref.make () in debug "VBD.create (device = %s; uuid = %s; ref = %s)" userdevice - (Uuid.string_of_uuid uuid) (Ref.string_of ref) ; + (Uuid.to_string uuid) (Ref.string_of ref) ; (* Check that the device is definitely unique. If the requested device is numerical (eg 1) then we 'expand' it into other possible names (eg 'hdb' 'xvdb') to detect all possible clashes. *) diff --git a/ocaml/xapi/xha_interface.ml b/ocaml/xapi/xha_interface.ml index 843bf6100cc..0203abaa3ab 100644 --- a/ocaml/xapi/xha_interface.ml +++ b/ocaml/xapi/xha_interface.ml @@ -294,7 +294,16 @@ module LiveSetInformation = struct "Invalid boolean value '%s' within 'host' element" s ) in - let uuid = Uuid.of_string in + let uuid s = + match Uuid.of_string s with + | None -> + invalid_arg + (Printf.sprintf + "invalid uuid value '%s' within 'host' element" s + ) + | Some u -> + u + in Some { id= uuid (find "HostID") @@ -315,7 +324,7 @@ module LiveSetInformation = struct ; time_since_last_heartbeat: int ; time_since_xapi_restart_first_attempted: int ; heartbeat_active_list_on_heartbeat: [`host] Uuid.t list - ; heartbeat_active_list_on_statefile: [`host] Uuid.t list (* ... *) + ; heartbeat_active_list_on_statefile: [`host] Uuid.t list } let of_xml_element = function @@ -337,7 +346,16 @@ module LiveSetInformation = struct "Invalid integer value '%s' within 'host_raw_data' element" s ) in - let uuid = Uuid.of_string in + let uuid s = + match Uuid.of_string s with + | None -> + invalid_arg + (Printf.sprintf + "invalid uuid value '%s' within 'host' element" s + ) + | Some u -> + u + in let set f x = List.map f (String.split_f String.isspace x) in Some { @@ -476,8 +494,17 @@ module LiveSetInformation = struct | Some (Xml.Element (_, _, [Xml.Element ("HostID", _, [Xml.PCData local_host_id])]) - ) -> - Uuid.of_string local_host_id + ) -> ( + match Uuid.of_string local_host_id with + | None -> + invalid_arg + (Printf.sprintf + "invalid uuid value '%s' within 'localhost' element" + local_host_id + ) + | Some u -> + u + ) | _ -> invalid_arg "Invalid or missing 'localhost' element." ) @@ -528,8 +555,7 @@ module LiveSetInformation = struct let to_summary_string t = let status = Status.to_string t.status in let host h = - Printf.sprintf "%s [%s%s%s%s%s%s]" - (Uuid.string_of_uuid h.Host.id) + Printf.sprintf "%s [%s%s%s%s%s%s]" (Uuid.to_string h.Host.id) (if h.Host.id = t.local_host_id then "*" else " ") (if h.Host.liveness then "L" else " ") (if h.Host.master then "M" else " ") diff --git a/ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml b/ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml index af5c9c17aaf..a24da9a045e 100644 --- a/ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml +++ b/ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml @@ -689,7 +689,9 @@ module IntSet = Set.Make (Int) let domain_snapshot xc = let metadata_of_domain dom = - let uuid = Uuid.(to_string (uuid_of_int_array dom.Xenctrl.handle)) in + let (let*) = Option.bind in + let* uuid_raw = Uuid.of_int_array dom.Xenctrl.handle in + let uuid = Uuid.to_string uuid_raw in let domid = dom.Xenctrl.domid in let start = String.sub uuid 0 18 in (* Actively hide migrating VM uuids, these are temporary and xenops writes diff --git a/ocaml/xcp-rrdd/bin/rrdp-iostat/rrdp_iostat.ml b/ocaml/xcp-rrdd/bin/rrdp-iostat/rrdp_iostat.ml index b81843f1a3b..d4e0bba36a7 100644 --- a/ocaml/xcp-rrdd/bin/rrdp-iostat/rrdp_iostat.ml +++ b/ocaml/xcp-rrdd/bin/rrdp-iostat/rrdp_iostat.ml @@ -30,7 +30,9 @@ let get_running_domUs xc xs = let metadata_of_domain di = let open Xenctrl in let domid = di.domid in - let uuid = Uuid.(to_string (uuid_of_int_array di.handle)) in + let (let*) = Option.bind in + let* uuid_raw = Uuid.of_int_array di.handle in + let uuid = Uuid.to_string uuid_raw in (* Actively hide migrating VM uuids, these are temporary and xenops writes the original and the final uuid to xenstore *) @@ -51,10 +53,10 @@ let get_running_domUs xc xs = else None in - (domid, stable_uuid key) + Some (domid, stable_uuid key) in (* Do not list dom0 *) - Xenctrl.domain_getinfolist xc 1 |> List.map metadata_of_domain + Xenctrl.domain_getinfolist xc 1 |> List.filter_map metadata_of_domain (* A mapping of VDIs to the VMs they are plugged to, in which position, and the device-id *) let vdi_to_vm_map : (string * (string * string * int)) list ref = ref []