Move transform_storage_exn to Storage_utils

This is so that `Storage_migrate` can use this function, otherwise there would be a dependency cycle. This function also sounds like a utility function. Also add an mli file for `Storage_utils`. Signed-off-by: Vincent Liu <[email protected]>
xapi-project · Nov 4, 2024 · f673d81 · f673d81
1 parent 93eea2b
commit f673d81
Show file tree

Hide file tree

Showing 8 changed files with 120 additions and 72 deletions.
diff --git a/ocaml/xapi/storage_access.ml b/ocaml/xapi/storage_access.ml
@@ -21,6 +21,7 @@ let finally = Xapi_stdext_pervasives.Pervasiveext.finally
 
 module XenAPI = Client.Client
 open Storage_interface
+open Storage_utils
 
 module D = Debug.Make (struct let name = "storage_access" end)
 
@@ -30,50 +31,6 @@ let s_of_vdi = Vdi.string_of
 
 let s_of_sr = Sr.string_of
 
-let transform_storage_exn f =
-  let get_sr_ref sr_uuid =
-    Server_helpers.exec_with_new_task "transform_storage_exn" (fun __context ->
-        Db.SR.get_by_uuid ~__context ~uuid:sr_uuid
-    )
-  in
-  try f () with
-  | Storage_error (Backend_error (code, params)) as e ->
-      Backtrace.reraise e (Api_errors.Server_error (code, params))
-  | Storage_error (Backend_error_with_backtrace (code, backtrace :: params)) as
-    e ->
-      let backtrace = Backtrace.Interop.of_json "SM" backtrace in
-      Backtrace.add e backtrace ;
-      Backtrace.reraise e (Api_errors.Server_error (code, params))
-  | Storage_error (Sr_unhealthy (sr, health)) as e ->
-      let advice =
-        match health with
-        | Unavailable ->
-            "try reboot"
-        | Unreachable ->
-            "try again later"
-        | _health ->
-            ""
-      in
-      let sr = get_sr_ref sr in
-      Backtrace.reraise e
-        (Api_errors.Server_error
-           ( Api_errors.sr_unhealthy
-           , [Ref.string_of sr; Storage_interface.show_sr_health health; advice]
-           )
-        )
-  | Api_errors.Server_error _ as e ->
-      raise e
-  | Storage_error (No_storage_plugin_for_sr sr) as e ->
-      let sr = get_sr_ref sr in
-      Backtrace.reraise e
-        (Api_errors.Server_error (Api_errors.sr_not_attached, [Ref.string_of sr])
-        )
-  | e ->
-      Backtrace.reraise e
-        (Api_errors.Server_error
-           (Api_errors.internal_error, [Printexc.to_string e])
-        )
-
 (* Start a set of servers for all SMAPIv1 plugins *)
 let start_smapiv1_servers () =
   let drivers = Sm.supported_drivers () in

diff --git a/ocaml/xapi/storage_access.mli b/ocaml/xapi/storage_access.mli
@@ -61,9 +61,6 @@ val reset : __context:Context.t -> vm:API.ref_VM -> unit
 (** [reset __context vm] declares that [vm] has reset and if it's a driver
     domain, we expect it to lose all state. *)
 
-val transform_storage_exn : (unit -> 'a) -> 'a
-(** [transform_storage_exn f] runs [f], rethrowing any storage error as a nice XenAPI error *)
-
 val attach_and_activate :
      __context:Context.t
   -> vbd:API.ref_VBD

diff --git a/ocaml/xapi/storage_utils.ml b/ocaml/xapi/storage_utils.ml
@@ -12,6 +12,8 @@
  * GNU Lesser General Public License for more details.
  *)
 
+open Storage_interface
+
 let string_of_vdi_type vdi_type =
   Rpc.string_of_rpc (API.rpc_of_vdi_type vdi_type)
 
@@ -127,3 +129,47 @@ let rpc ~srcstr ~dststr {url; pool_secret; verify_cert} =
         intra_pool_rpc_of_ip ~srcstr ~dststr ~ip
   in
   redirectable_rpc ~original ~redirect_to_ip
+
+let transform_storage_exn f =
+  let get_sr_ref sr_uuid =
+    Server_helpers.exec_with_new_task "transform_storage_exn" (fun __context ->
+        Db.SR.get_by_uuid ~__context ~uuid:sr_uuid
+    )
+  in
+  try f () with
+  | Storage_error (Backend_error (code, params)) as e ->
+      Backtrace.reraise e (Api_errors.Server_error (code, params))
+  | Storage_error (Backend_error_with_backtrace (code, backtrace :: params)) as
+    e ->
+      let backtrace = Backtrace.Interop.of_json "SM" backtrace in
+      Backtrace.add e backtrace ;
+      Backtrace.reraise e (Api_errors.Server_error (code, params))
+  | Storage_error (Sr_unhealthy (sr, health)) as e ->
+      let advice =
+        match health with
+        | Unavailable ->
+            "try reboot"
+        | Unreachable ->
+            "try again later"
+        | _health ->
+            ""
+      in
+      let sr = get_sr_ref sr in
+      Backtrace.reraise e
+        (Api_errors.Server_error
+           ( Api_errors.sr_unhealthy
+           , [Ref.string_of sr; Storage_interface.show_sr_health health; advice]
+           )
+        )
+  | Api_errors.Server_error _ as e ->
+      raise e
+  | Storage_error (No_storage_plugin_for_sr sr) as e ->
+      let sr = get_sr_ref sr in
+      Backtrace.reraise e
+        (Api_errors.Server_error (Api_errors.sr_not_attached, [Ref.string_of sr])
+        )
+  | e ->
+      Backtrace.reraise e
+        (Api_errors.Server_error
+           (Api_errors.internal_error, [Printexc.to_string e])
+        )
diff --git a/ocaml/xapi/storage_utils.mli b/ocaml/xapi/storage_utils.mli
@@ -0,0 +1,54 @@
+val string_of_vdi_type :
+     [< `cbt_metadata
+     | `crashdump
+     | `ephemeral
+     | `ha_statefile
+     | `metadata
+     | `pvs_cache
+     | `redo_log
+     | `rrd
+     | `suspend
+     | `system
+     | `user ]
+  -> string
+
+val vdi_type_of_string :
+     string
+  -> [> `cbt_metadata
+     | `crashdump
+     | `ephemeral
+     | `ha_statefile
+     | `metadata
+     | `pvs_cache
+     | `redo_log
+     | `rrd
+     | `suspend
+     | `system
+     | `user ]
+
+val redirectable_rpc :
+     redirect_to_ip:(ip:string -> Rpc.call -> Rpc.response)
+  -> original:(Rpc.call -> Rpc.response)
+  -> Rpc.call
+  -> Rpc.response
+
+type connection_args = {
+    url: Http.Url.t
+  ; pool_secret: SecretString.t option
+  ; verify_cert: Stunnel.verification_config option
+}
+
+val localhost_connection_args : unit -> connection_args
+
+val intra_pool_connection_args_of_ip : string -> connection_args
+
+val connection_args_of_uri : verify_dest:bool -> string -> connection_args
+
+val intra_pool_rpc_of_ip :
+  srcstr:string -> dststr:string -> ip:string -> Rpc.call -> Rpc.response
+
+val rpc :
+  srcstr:string -> dststr:string -> connection_args -> Rpc.call -> Rpc.response
+
+val transform_storage_exn : (unit -> 'a) -> 'a
+(** [transform_storage_exn f] runs [f], rethrowing any storage error as a nice XenAPI error *)
diff --git a/ocaml/xapi/xapi_pbd.ml b/ocaml/xapi/xapi_pbd.ml
@@ -188,7 +188,7 @@ let plug ~__context ~self =
         check_sharing_constraint ~__context ~sr ;
         let dbg = Ref.string_of (Context.get_task_id __context) in
         let device_config = Db.PBD.get_device_config ~__context ~self in
-        Storage_access.transform_storage_exn (fun () ->
+        Storage_utils.transform_storage_exn (fun () ->
             C.SR.attach dbg
               (Storage_interface.Sr.of_string
                  (Db.SR.get_uuid ~__context ~self:sr)
@@ -264,7 +264,7 @@ let unplug ~__context ~self =
         ) ;
         let dbg = Ref.string_of (Context.get_task_id __context) in
         let uuid = Db.SR.get_uuid ~__context ~self:sr in
-        Storage_access.transform_storage_exn (fun () ->
+        Storage_utils.transform_storage_exn (fun () ->
             C.SR.detach dbg (Storage_interface.Sr.of_string uuid)
         ) ;
         Storage_access.unbind ~__context ~pbd:self ;

diff --git a/ocaml/xapi/xapi_sr.ml b/ocaml/xapi/xapi_sr.ml
@@ -234,7 +234,7 @@ let call_probe ~__context ~host:_ ~device_config ~_type ~sm_config ~f =
     let rpc = rpc
   end)) in
   let dbg = Context.string_of_task __context in
-  Storage_access.transform_storage_exn (fun () ->
+  Storage_utils.transform_storage_exn (fun () ->
       Client.SR.probe dbg queue device_config sm_config |> f
   )
 
@@ -587,7 +587,7 @@ let update ~__context ~sr =
   let module C = Storage_interface.StorageAPI (Idl.Exn.GenClient (struct
     let rpc = rpc
   end)) in
-  transform_storage_exn (fun () ->
+  Storage_utils.transform_storage_exn (fun () ->
       let sr' =
         Db.SR.get_uuid ~__context ~self:sr |> Storage_interface.Sr.of_string
       in
@@ -784,7 +784,7 @@ let scan ~__context ~sr =
   end)) in
   let sr' = Ref.string_of sr in
   SRScanThrottle.execute (fun () ->
-      transform_storage_exn (fun () ->
+      Storage_utils.transform_storage_exn (fun () ->
           let sr_uuid = Db.SR.get_uuid ~__context ~self:sr in
           let vs, sr_info =
             C.SR.scan2 (Ref.string_of task)
@@ -827,27 +827,25 @@ let set_shared ~__context ~sr ~value =
     Db.SR.set_shared ~__context ~self:sr ~value
 
 let set_name_label ~__context ~sr ~value =
-  let open Storage_access in
   let task = Context.get_task_id __context in
   let sr' = Db.SR.get_uuid ~__context ~self:sr in
   let module C = Storage_interface.StorageAPI (Idl.Exn.GenClient (struct
     let rpc = Storage_access.rpc
   end)) in
-  transform_storage_exn (fun () ->
+  Storage_utils.transform_storage_exn (fun () ->
       C.SR.set_name_label (Ref.string_of task)
         (Storage_interface.Sr.of_string sr')
         value
   ) ;
   update ~__context ~sr
 
 let set_name_description ~__context ~sr ~value =
-  let open Storage_access in
   let task = Context.get_task_id __context in
   let sr' = Db.SR.get_uuid ~__context ~self:sr in
   let module C = Storage_interface.StorageAPI (Idl.Exn.GenClient (struct
     let rpc = Storage_access.rpc
   end)) in
-  transform_storage_exn (fun () ->
+  Storage_utils.transform_storage_exn (fun () ->
       C.SR.set_name_description (Ref.string_of task)
         (Storage_interface.Sr.of_string sr')
         value

diff --git a/ocaml/xapi/xapi_vdi.ml b/ocaml/xapi/xapi_vdi.ml
@@ -659,7 +659,7 @@ let create ~__context ~name_label ~name_description ~sR ~virtual_size ~_type
     let rpc = rpc
   end)) in
   let sm_vdi =
-    transform_storage_exn (fun () ->
+    Storage_utils.transform_storage_exn (fun () ->
         C.VDI.create (Ref.string_of task)
           (Db.SR.get_uuid ~__context ~self:sR |> Storage_interface.Sr.of_string)
           vdi_info
@@ -739,7 +739,6 @@ let introduce ~__context ~uuid ~name_label ~name_description ~sR ~_type
     ~sharable ~read_only:_ ~other_config ~location ~xenstore_data ~sm_config
     ~managed:_ ~virtual_size:_ ~physical_utilisation:_ ~metadata_of_pool:_
     ~is_a_snapshot:_ ~snapshot_time:_ ~snapshot_of:_ =
-  let open Storage_access in
   debug "introduce uuid=%s name_label=%s sm_config=[ %s ]" uuid name_label
     (String.concat "; " (List.map (fun (k, v) -> k ^ " = " ^ v) sm_config)) ;
   Sm.assert_pbd_is_plugged ~__context ~sr:sR ;
@@ -765,7 +764,7 @@ let introduce ~__context ~uuid ~name_label ~name_description ~sR ~_type
   end)) in
   Sm.assert_pbd_is_plugged ~__context ~sr:sR ;
   let vdi_info =
-    transform_storage_exn (fun () ->
+    Storage_utils.transform_storage_exn (fun () ->
         C.VDI.introduce (Ref.string_of task) sr' uuid sm_config location
     )
   in
@@ -853,7 +852,7 @@ let snapshot ~__context ~vdi ~driver_params =
     let rpc = Storage_access.rpc
   end)) in
   let newvdi =
-    Storage_access.transform_storage_exn (fun () ->
+    Storage_utils.transform_storage_exn (fun () ->
         try snapshot_and_clone C.VDI.snapshot ~__context ~vdi ~driver_params
         with Storage_interface.Storage_error (Unimplemented _) ->
           debug
@@ -1013,7 +1012,7 @@ let destroy_and_data_destroy_common ~__context ~self
       | `data_destroy _ ->
           C.VDI.data_destroy
     in
-    transform_storage_exn (fun () ->
+    Storage_utils.transform_storage_exn (fun () ->
         call_f (Ref.string_of task)
           (Db.SR.get_uuid ~__context ~self:sr |> Storage_interface.Sr.of_string)
           (Storage_interface.Vdi.of_string location)
@@ -1060,7 +1059,7 @@ let data_destroy = _data_destroy ~timeout:4
 let resize ~__context ~vdi ~size =
   Sm.assert_pbd_is_plugged ~__context ~sr:(Db.VDI.get_SR ~__context ~self:vdi) ;
   Xapi_vdi_helpers.assert_managed ~__context ~vdi ;
-  Storage_access.transform_storage_exn (fun () ->
+  Storage_utils.transform_storage_exn (fun () ->
       let module C = Storage_interface.StorageAPI (Idl.Exn.GenClient (struct
         let rpc = Storage_access.rpc
       end)) in
@@ -1086,7 +1085,7 @@ let generate_config ~__context ~host:_ ~vdi =
   )
 
 let clone ~__context ~vdi ~driver_params =
-  Storage_access.transform_storage_exn (fun () ->
+  Storage_utils.transform_storage_exn (fun () ->
       try
         let module C = Storage_interface.StorageAPI (Idl.Exn.GenClient (struct
           let rpc = Storage_access.rpc
@@ -1264,7 +1263,6 @@ let set_metadata_of_pool ~__context ~self ~value =
 let set_on_boot ~__context ~self ~value =
   let sr = Db.VDI.get_SR ~__context ~self in
   Sm.assert_pbd_is_plugged ~__context ~sr ;
-  let open Storage_access in
   let task = Context.get_task_id __context in
   let sr' =
     Db.SR.get_uuid ~__context ~self:sr |> Storage_interface.Sr.of_string
@@ -1275,7 +1273,7 @@ let set_on_boot ~__context ~self ~value =
   let module C = Storage_interface.StorageAPI (Idl.Exn.GenClient (struct
     let rpc = Storage_access.rpc
   end)) in
-  transform_storage_exn (fun () ->
+  Storage_utils.transform_storage_exn (fun () ->
       C.VDI.set_persistent (Ref.string_of task) sr' vdi' (value = `persist)
   ) ;
   Db.VDI.set_on_boot ~__context ~self ~value
@@ -1284,7 +1282,6 @@ let set_allow_caching ~__context ~self ~value =
   Db.VDI.set_allow_caching ~__context ~self ~value
 
 let set_name_label ~__context ~self ~value =
-  let open Storage_access in
   let task = Context.get_task_id __context in
   let sr = Db.VDI.get_SR ~__context ~self in
   let sr' =
@@ -1296,13 +1293,12 @@ let set_name_label ~__context ~self ~value =
   let module C = Storage_interface.StorageAPI (Idl.Exn.GenClient (struct
     let rpc = Storage_access.rpc
   end)) in
-  transform_storage_exn (fun () ->
+  Storage_utils.transform_storage_exn (fun () ->
       C.VDI.set_name_label (Ref.string_of task) sr' vdi' value
   ) ;
   update ~__context ~vdi:self
 
 let set_name_description ~__context ~self ~value =
-  let open Storage_access in
   let task = Context.get_task_id __context in
   let sr = Db.VDI.get_SR ~__context ~self in
   let sr' =
@@ -1314,7 +1310,7 @@ let set_name_description ~__context ~self ~value =
   let module C = Storage_interface.StorageAPI (Idl.Exn.GenClient (struct
     let rpc = Storage_access.rpc
   end)) in
-  transform_storage_exn (fun () ->
+  Storage_utils.transform_storage_exn (fun () ->
       C.VDI.set_name_description (Ref.string_of task) sr' vdi' value
   ) ;
   update ~__context ~vdi:self
@@ -1380,7 +1376,7 @@ let change_cbt_status ~__context ~self ~new_cbt_enabled ~caller_name =
     let call_f =
       if new_cbt_enabled then C.VDI.enable_cbt else C.VDI.disable_cbt
     in
-    Storage_access.transform_storage_exn (fun () ->
+    Storage_utils.transform_storage_exn (fun () ->
         call_f (Ref.string_of task) sr' vdi'
     ) ;
     Db.VDI.set_cbt_enabled ~__context ~self ~value:new_cbt_enabled
@@ -1422,7 +1418,7 @@ let list_changed_blocks ~__context ~vdi_from ~vdi_to =
   let module C = Storage_interface.StorageAPI (Idl.Exn.GenClient (struct
     let rpc = Storage_access.rpc
   end)) in
-  Storage_access.transform_storage_exn (fun () ->
+  Storage_utils.transform_storage_exn (fun () ->
       C.VDI.list_changed_blocks (Ref.string_of task) sr' vdi_from vdi_to
   )
 

diff --git a/quality-gate.sh b/quality-gate.sh
@@ -25,7 +25,7 @@ verify-cert () {
 }
 
 mli-files () {
-  N=499
+  N=498
   # do not count ml files from the tests in ocaml/{tests/perftest/quicktest}
   MLIS=$(git ls-files -- '**/*.mli' | grep -vE "ocaml/tests|ocaml/perftest|ocaml/quicktest|ocaml/message-switch/core_test" | xargs -I {} sh -c "echo {} | cut -f 1 -d '.'" \;)
   MLS=$(git  ls-files -- '**/*.ml'  | grep -vE "ocaml/tests|ocaml/perftest|ocaml/quicktest|ocaml/message-switch/core_test" | xargs -I {} sh -c "echo {} | cut -f 1 -d '.'" \;)