CP-34028: adapt code for new uuid interface

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

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"

ocaml/idl/ocaml_backend/gen_rbac.ml

@@ -57,26 +57,15 @@ 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
   (*defensive copy*)
   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"
 

ocaml/mpathalert/mpathalert.ml

@@ -95,52 +95,74 @@ let rec retry_with_session f rpc x =
 let keep_mpath =
   List.filter (fun (key, _) -> Xstringext.String.startswith "mpath-" key)
 
+let create_alert ~host_uuid_string ~host_name ~pbd_uuid_string key value
+    timestamp scsi_id =
+  let current, max =
+    Scanf.sscanf value "[%d, %d]" (fun current max -> (current, max))
+  in
+  let host_maybe = Uuid.of_string host_uuid_string in
+  let pbd_maybe = Uuid.of_string pbd_uuid_string in
+  let host_error : ('a -> 'b -> 'c -> 'd, unit, string, unit) format4 =
+    "Retrieved malformed UUID for host (%s) while creating PBD alert from \
+     %s=%s; ignoring entry"
+  in
+  let pbd_error : ('a -> 'b -> 'c -> 'd, unit, string, unit) format4 =
+    "Retrieved malformed UUID for pbd (%s) while creating PBD alert from \
+     %s=%s; ignoring entry"
+  in
+  match (host_maybe, pbd_maybe) with
+  | None, None ->
+      debug host_error host_uuid_string key value ;
+      debug pbd_error host_uuid_string key value ;
+      None
+  | None, _ ->
+      debug host_error host_uuid_string key value ;
+      None
+  | _, None ->
+      debug pbd_error host_uuid_string key value ;
+      None
+  | Some host, Some pbd ->
+      let alert = {host; host_name; pbd; timestamp; scsi_id; current; max} in
+      debug "Alert '%s' created from %s=%s" (to_string alert) key value ;
+      Some alert
+
 (* create a list of alerts from a PBD event *)
 let create_pbd_alerts rpc session_id snapshot (_pbd_ref, pbd_rec, timestamp) =
   let aux (key, value) =
     let scsi_id = Xstringext.String.sub_to_end key 6 in
-    let current, max =
-      Scanf.sscanf value "[%d, %d]" (fun current max -> (current, max))
-    in
-    let host =
-      Uuid.of_string
-        (Client.Host.get_uuid ~rpc ~session_id ~self:pbd_rec.API.pBD_host)
+    let host_uuid_string =
+      Client.Host.get_uuid ~rpc ~session_id ~self:pbd_rec.API.pBD_host
     in
     let host_name =
       Client.Host.get_name_label ~rpc ~session_id ~self:pbd_rec.API.pBD_host
     in
-    let pbd = 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
+    let pbd_uuid_string = pbd_rec.API.pBD_uuid in
+    create_alert ~host_uuid_string ~host_name ~pbd_uuid_string key value
+      timestamp scsi_id
   in
   let diff =
     Listext.List.set_difference
       (keep_mpath pbd_rec.API.pBD_other_config)
       snapshot
   in
-  List.map aux diff
+  List.filter_map aux diff
 
 (* create a list of alerts from a host event *)
 let create_host_alerts _rpc _session snapshot (_, host_rec, timestamp) =
   let aux (key, value) =
     let scsi_id = "n/a" in
-    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_uuid_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
-    debug "Alert '%s' created from %s=%s" (to_string alert) key value ;
-    alert
+    let pbd_uuid_string = Uuid.(to_string null) in
+    create_alert ~host_uuid_string ~host_name ~pbd_uuid_string key value
+      timestamp scsi_id
   in
   let diff =
     Listext.List.set_difference
       (keep_mpath host_rec.API.host_other_config)
       snapshot
   in
-  List.map aux diff
+  List.filter_map aux diff
 
 let listener rpc session_id queue =
   let snapshot = Hashtbl.create 48 in

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:[]

ocaml/tests/common/test_common.ml

@@ -17,7 +17,7 @@ open API
 (* A directory to use for temporary files. *)
 let working_area = Filename.(concat (get_temp_dir_name ()) "xapi-test")
 
-let make_uuid () = Uuid.string_of_uuid (Uuid.make_uuid ())
+let make_uuid () = Uuid.(to_string (make_uuid ()))
 
 let assert_raises_api_error (code : string) ?(args : string list option)
     (f : unit -> 'a) : unit =

ocaml/xapi/import.ml

@@ -529,7 +529,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 (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

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 (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 (make_uuid ()))
             in
             let snapshot_time = Date.of_float (Unix.gettimeofday ()) in
             Db.VDI.set_name_label ~__context ~self ~value:vdi_info.name_label ;

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 (make_uuid ())) in
+    let base_dp = Uuid.(to_string (make_uuid ())) in
+    let leaf_dp = Uuid.(to_string (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 (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

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 =

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

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

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

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

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. *)