maintenance: avoid deprecated bindings in uuidm 0.9.9

Signed-off-by: Pau Ruiz Safont <[email protected]>

ocaml/idl/ocaml_backend/gen_rbac.ml

@@ -57,7 +57,7 @@ let writer_csv static_permissions_roles =
 
 let hash2uuid str =
   let h = Digest.string str in
-  Option.map Uuidm.to_string (Uuidm.of_bytes h)
+  Option.map Uuidm.to_string (Uuidm.of_binary_string h)
 
 let replace_char str c1 c2 =
   let buf = Bytes.of_string str in

ocaml/libs/ezxenstore/watch/ez_xenctrl_uuid.ml

@@ -21,7 +21,7 @@ let bytes_of_handle h =
 
 let uuid_of_handle h =
   let h' = bytes_of_handle h |> Bytes.to_string in
-  match Uuidm.of_bytes h' with
+  match Uuidm.of_binary_string h' with
   | Some x ->
       x
   | None ->

ocaml/libs/uuid/uuidx.ml

@@ -98,15 +98,15 @@ let pp = Uuidm.pp
 
 let equal = Uuidm.equal
 
-let of_bytes u = Uuidm.of_bytes ~pos:0 u
+let of_bytes u = Uuidm.of_binary_string ~pos:0 u
 
-let to_bytes = Uuidm.to_bytes
+let to_bytes = Uuidm.to_binary_string
 
 let of_int_array arr =
   arr |> Array.to_seq |> Seq.map char_of_int |> String.of_seq |> of_bytes
 
 let to_int_array u =
-  Uuidm.to_bytes u |> String.to_seq |> Seq.map int_of_char |> Array.of_seq
+  to_bytes u |> String.to_seq |> Seq.map int_of_char |> Array.of_seq
 
 let of_string = Uuidm.of_string ~pos:0
 

ocaml/libs/vhd/vhd_format/f.ml

@@ -100,12 +100,11 @@ let _mib_shift = 20
 
 let _gib_shift = 30
 
-let blank_uuid =
-  match Uuidm.of_bytes (String.make 16 '\000') with
-  | Some x ->
-      x
-  | None ->
-      assert false (* never happens *)
+let blank_uuid = Uuidm.nil
+
+let new_uuid () =
+  let random = Random.State.make_self_init () in
+  Uuidm.v4_gen random ()
 
 module Feature = struct
   type t = Temporary
@@ -394,7 +393,7 @@ module Footer = struct
       ?(creator_application = default_creator_application)
       ?(creator_version = default_creator_version)
       ?(creator_host_os = Host_OS.Other 0l) ~current_size
-      ?(original_size = current_size) ~disk_type ?(uid = Uuidm.v `V4)
+      ?(original_size = current_size) ~disk_type ?(uid = new_uuid ())
       ?(saved_state = false) () =
     let geometry = Geometry.of_sectors Int64.(current_size lsr sector_shift) in
     let checksum = 0l in
@@ -493,7 +492,7 @@ module Footer = struct
     set_footer_sectors buf t.geometry.Geometry.sectors ;
     set_footer_disk_type buf (Disk_type.to_int32 t.disk_type) ;
     set_footer_checksum buf 0l ;
-    set_footer_uid (Uuidm.to_bytes t.uid) 0 buf ;
+    set_footer_uid (Uuidm.to_binary_string t.uid) 0 buf ;
     set_footer_saved_state buf (if t.saved_state then 1 else 0) ;
     let remaining = Cstruct.shift buf sizeof_footer in
     for i = 0 to 426 do
@@ -544,7 +543,7 @@ module Footer = struct
     Disk_type.of_int32 (get_footer_disk_type buf) >>= fun disk_type ->
     let checksum = get_footer_checksum buf in
     let bytes = copy_footer_uid buf in
-    ( match Uuidm.of_bytes bytes with
+    ( match Uuidm.of_binary_string bytes with
     | None ->
         R.error
           (Failure
@@ -979,7 +978,9 @@ module Header = struct
     set_header_block_size buf
       (Int32.of_int (1 lsl (t.block_size_sectors_shift + sector_shift))) ;
     set_header_checksum buf 0l ;
-    set_header_parent_unique_id (Uuidm.to_bytes t.parent_unique_id) 0 buf ;
+    set_header_parent_unique_id
+      (Uuidm.to_binary_string t.parent_unique_id)
+      0 buf ;
     set_header_parent_time_stamp buf t.parent_time_stamp ;
     set_header_reserved buf 0l ;
     for i = 0 to 511 do
@@ -1074,7 +1075,7 @@ module Header = struct
     let block_size_sectors_shift = block_size_shift - sector_shift in
     let checksum = get_header_checksum buf in
     let bytes = copy_header_parent_unique_id buf in
-    ( match Uuidm.of_bytes bytes with
+    ( match Uuidm.of_binary_string bytes with
     | None ->
         R.error
           (Failure
@@ -2141,7 +2142,7 @@ functor
         (* Assume the data is there, or will be written later *)
         return t
 
-      let create_dynamic ~filename ~size ?(uuid = Uuidm.v `V4)
+      let create_dynamic ~filename ~size ?(uuid = new_uuid ())
           ?(saved_state = false) ?(features = []) () =
         (* The physical disk layout will be:
            byte 0   - 511:  backup footer
@@ -2212,7 +2213,7 @@ functor
         String.concat "/" (base @ target)
 
       let create_difference ~filename ~parent ?(relative_path = true)
-          ?(uuid = Uuidm.v `V4) ?(saved_state = false) ?(features = []) () =
+          ?(uuid = new_uuid ()) ?(saved_state = false) ?(features = []) () =
         (* We use the same basic file layout as in create_dynamic *)
         let data_offset = 512L in
         let table_offset = 2048L in

ocaml/libs/xapi-inventory/lib/inventory.ml

@@ -52,10 +52,14 @@ let inventory = Hashtbl.create 10
 
 let inventory_m = Mutex.create ()
 
+let new_uuid () =
+  let random = Random.State.make_self_init () in
+  Uuidm.v4_gen random ()
+
 (* Compute the minimum necessary inventory file contents *)
 let minimum_default_entries () =
-  let host_uuid = Uuidm.to_string (Uuidm.v `V4) in
-  let dom0_uuid = Uuidm.to_string (Uuidm.v `V4) in
+  let host_uuid = Uuidm.to_string (new_uuid ()) in
+  let dom0_uuid = Uuidm.to_string (new_uuid ()) in
   [
     (_installation_uuid, host_uuid)
   ; (_control_domain_uuid, dom0_uuid)

ocaml/tests/test_ref.ml

@@ -3,7 +3,8 @@
 
 let uuidm =
   Crowbar.(
-    map [bytes_fixed 16] @@ fun b -> b |> Uuidm.of_bytes ~pos:0 |> Option.get
+    map [bytes_fixed 16] @@ fun b ->
+    b |> Uuidm.of_binary_string ~pos:0 |> Option.get
   )
 
 let ref_of_uuidm uuidm =

ocaml/xapi-guard/test/cache_test.ml

@@ -156,6 +156,10 @@ let log_read (uuid, timestamp, key) =
   in
   Lwt_result.return "yes"
 
+let new_uuid () =
+  let random = Random.State.make_self_init () in
+  Uuidm.v4_gen random ()
+
 let to_cache with_read_writes =
   let __FUN = __FUNCTION__ in
   let elapsed = Mtime_clock.counter () in
@@ -180,7 +184,7 @@ let to_cache with_read_writes =
       let* () = Lwt.pause () in
       loop_and_stop f name uuid max sent
   in
-  let vms = List.init 4 (fun _ -> Uuidm.(v `V4)) in
+  let vms = List.init 4 (fun _ -> new_uuid ()) in
 
   List.concat
     [

ocaml/xapi-guard/test/xapi_guard_test.ml

@@ -60,7 +60,7 @@ let xapi_rpc call =
   | _ ->
       Fmt.failwith "XAPI RPC call %s not expected in test" call.Rpc.name
 
-let vm_uuid = Uuidm.v `V4
+let vm_uuid = Uuidm.v4_gen (Random.State.make_self_init ()) ()
 
 let vm_uuid_str = Uuidm.to_string vm_uuid
 

ocaml/xapi-idl/lib/uuidm_rpc_type.ml

@@ -1,3 +1,7 @@
+let new_uuid () =
+  let random = Random.State.make_self_init () in
+  Uuidm.v4_gen random ()
+
 module Uuidm = struct
   include Uuidm
 
@@ -6,7 +10,7 @@ module Uuidm = struct
     Rpc.Types.Abstract
       {
         aname= "uuid"
-      ; test_data= [Uuidm.v4_gen (Random.get_state ()) ()]
+      ; test_data= [new_uuid ()]
       ; rpc_of= (fun t -> Rpc.String (Uuidm.to_string t))
       ; of_rpc=
           (function