CP-54020: Refactor sxm and storage_mux code (#6378)

There are various refactors in this PR, details in each commit message.
This is mainly for clean up purposes and also to prepare for the real
refactoring of sxm for SMAPIv1 and SMAPIv3.

No functional change.

More to come...

Author: incipit0

ocaml/tests/test_sm_features.ml

@@ -249,6 +249,7 @@ module CreateSMObject = Generic.MakeStateful (struct
       ; features
       ; configuration= []
       ; required_cluster_stack= []
+      ; smapi_version= SMAPIv2
       }
 
   let extract_output __context _ =

ocaml/tests/test_storage_migrate_state.ml

@@ -17,11 +17,11 @@ open Test_highlevel
 module StorageMigrateState = struct
   type state_t = unit
 
-  let create_default_state () = Storage_migrate.State.clear ()
+  let create_default_state () = Storage_migrate_helper.State.clear ()
 end
 
 let sample_send_state =
-  Storage_migrate.State.Send_state.
+  Storage_migrate_helper.State.Send_state.
     {
       url= "url"
     ; dest_sr= Storage_interface.Sr.of_string "dest_sr"
@@ -45,7 +45,7 @@ let sample_send_state =
 
 let sample_receive_state =
   let open Storage_interface in
-  Storage_migrate.State.Receive_state.
+  Storage_migrate_helper.State.Receive_state.
     {
       sr= Sr.of_string "my_sr"
     ; dummy_vdi= Vdi.of_string "dummy_vdi"
@@ -57,7 +57,7 @@ let sample_receive_state =
     }
 
 let sample_copy_state =
-  Storage_migrate.State.Copy_state.
+  Storage_migrate_helper.State.Copy_state.
     {
       base_dp= "base_dp"
     ; leaf_dp= "leaf_dp"
@@ -70,7 +70,7 @@ let sample_copy_state =
 
 module MapOf = Generic.MakeStateful (struct
   module Io = struct
-    open Storage_migrate.State
+    open Storage_migrate_helper.State
 
     type input_t =
       (string * osend operation) option
@@ -88,7 +88,7 @@ module MapOf = Generic.MakeStateful (struct
   end
 
   module State = StorageMigrateState
-  open Storage_migrate.State
+  open Storage_migrate_helper.State
 
   let load_input () (send, recv, copy) =
     Option.iter (fun (id, send) -> add id send) send ;
@@ -116,7 +116,7 @@ module MapOf = Generic.MakeStateful (struct
 end)
 
 let test_clear () =
-  let open Storage_migrate.State in
+  let open Storage_migrate_helper.State in
   clear () ;
   add "foo" (Send_op sample_send_state) ;
   add "bar" (Recv_op sample_receive_state) ;
@@ -130,5 +130,5 @@ let test_clear () =
 let test = [("clear", `Quick, test_clear)]
 
 let tests =
-  Storage_migrate.State.persist_root := Test_common.working_area ;
+  Storage_migrate_helper.State.persist_root := Test_common.working_area ;
   [("storage_migrate_state_map_of", MapOf.tests)]

ocaml/tests/test_vdi_cbt.ml

@@ -30,10 +30,11 @@ let register_smapiv2_server (module S : Storage_interface.Server_impl) sr_ref =
       ; features= []
       ; configuration= []
       ; required_cluster_stack= []
+      ; smapi_version= SMAPIv2
       }
   in
 
-  Storage_mux.register sr_ref rpc "" dummy_query_result
+  Storage_mux_reg.register sr_ref rpc "" dummy_query_result
 
 let make_smapiv2_storage_server ?vdi_enable_cbt ?vdi_disable_cbt
     ?vdi_list_changed_blocks ?vdi_data_destroy ?vdi_snapshot ?vdi_clone:_ () =

ocaml/xapi-idl/storage/storage_interface.ml

@@ -404,6 +404,9 @@ let err =
       )
   }
 
+type smapi_version = SMAPIv1 | SMAPIv2 | SMAPIv3
+[@@deriving rpcty, show {with_path= false}]
+
 type query_result = {
     driver: string
   ; name: string
@@ -415,6 +418,7 @@ type query_result = {
   ; features: string list
   ; configuration: (string * string) list
   ; required_cluster_stack: string list
+  ; smapi_version: smapi_version
 }
 [@@deriving rpcty]
 
@@ -1157,6 +1161,60 @@ module StorageAPI (R : RPC) = struct
   end
 end
 
+module type MIRROR = sig
+  type context = unit
+
+  val start :
+       context
+    -> dbg:debug_info
+    -> sr:sr
+    -> vdi:vdi
+    -> dp:dp
+    -> mirror_vm:vm
+    -> copy_vm:vm
+    -> url:string
+    -> dest:sr
+    -> verify_dest:bool
+    -> Task.id
+
+  val stop : context -> dbg:debug_info -> id:Mirror.id -> unit
+
+  val stat : context -> dbg:debug_info -> id:Mirror.id -> Mirror.t
+
+  val receive_start :
+       context
+    -> dbg:debug_info
+    -> sr:sr
+    -> vdi_info:vdi_info
+    -> id:Mirror.id
+    -> similar:Mirror.similars
+    -> Mirror.mirror_receive_result
+
+  val receive_start2 :
+       context
+    -> dbg:debug_info
+    -> sr:sr
+    -> vdi_info:vdi_info
+    -> id:Mirror.id
+    -> similar:Mirror.similars
+    -> vm:vm
+    -> Mirror.mirror_receive_result
+
+  val receive_finalize : context -> dbg:debug_info -> id:Mirror.id -> unit
+
+  val receive_finalize2 : context -> dbg:debug_info -> id:Mirror.id -> unit
+
+  val receive_cancel : context -> dbg:debug_info -> id:Mirror.id -> unit
+
+  val list : context -> dbg:debug_info -> (Mirror.id * Mirror.t) list
+
+  val import_activate :
+    context -> dbg:debug_info -> dp:dp -> sr:sr -> vdi:vdi -> vm:vm -> sock_path
+
+  val get_nbd_server :
+    context -> dbg:debug_info -> dp:dp -> sr:sr -> vdi:vdi -> vm:vm -> sock_path
+end
+
 module type Server_impl = sig
   type context = unit
 
@@ -1413,69 +1471,7 @@ module type Server_impl = sig
       -> verify_dest:bool
       -> Task.id
 
-    module MIRROR : sig
-      val start :
-           context
-        -> dbg:debug_info
-        -> sr:sr
-        -> vdi:vdi
-        -> dp:dp
-        -> mirror_vm:vm
-        -> copy_vm:vm
-        -> url:string
-        -> dest:sr
-        -> verify_dest:bool
-        -> Task.id
-
-      val stop : context -> dbg:debug_info -> id:Mirror.id -> unit
-
-      val stat : context -> dbg:debug_info -> id:Mirror.id -> Mirror.t
-
-      val receive_start :
-           context
-        -> dbg:debug_info
-        -> sr:sr
-        -> vdi_info:vdi_info
-        -> id:Mirror.id
-        -> similar:Mirror.similars
-        -> Mirror.mirror_receive_result
-
-      val receive_start2 :
-           context
-        -> dbg:debug_info
-        -> sr:sr
-        -> vdi_info:vdi_info
-        -> id:Mirror.id
-        -> similar:Mirror.similars
-        -> vm:vm
-        -> Mirror.mirror_receive_result
-
-      val receive_finalize : context -> dbg:debug_info -> id:Mirror.id -> unit
-
-      val receive_finalize2 : context -> dbg:debug_info -> id:Mirror.id -> unit
-
-      val receive_cancel : context -> dbg:debug_info -> id:Mirror.id -> unit
-
-      val list : context -> dbg:debug_info -> (Mirror.id * Mirror.t) list
-
-      val import_activate :
-           context
-        -> dbg:debug_info
-        -> dp:dp
-        -> sr:sr
-        -> vdi:vdi
-        -> vm:vm
-        -> sock_path
-
-      val get_nbd_server :
-           context
-        -> dbg:debug_info
-        -> dp:dp
-        -> sr:sr
-        -> vdi:vdi
-        -> vm:vm
-        -> sock_path
-    end
+    module MIRROR : MIRROR
   end
 
   module Policy : sig

ocaml/xapi-idl/storage/storage_skeleton.ml

@@ -155,6 +155,8 @@ module DATA = struct
   let copy ctx ~dbg ~sr ~vdi ~vm ~url ~dest = u "DATA.copy"
 
   module MIRROR = struct
+    type context = unit
+
     (** [start task sr vdi url sr2] creates a VDI in remote [url]'s [sr2] and
         writes data synchronously. It returns the id of the VDI.*)
     let start ctx ~dbg ~sr ~vdi ~dp ~mirror_vm ~copy_vm ~url ~dest =

ocaml/xapi-storage-script/main.ml

@@ -948,6 +948,7 @@ module QueryImpl (M : META) = struct
         ; configuration= response.Xapi_storage.Plugin.configuration
         ; required_cluster_stack=
             response.Xapi_storage.Plugin.required_cluster_stack
+        ; smapi_version= SMAPIv3
         }
     in
     wrap th

ocaml/xapi/dune

@@ -217,8 +217,8 @@
    ((pps ppx_deriving.ord) Xapi_observer_components)
    ((pps ppx_deriving_rpc)
     Config_file_sync Extauth_plugin_ADwinbind Importexport Sparse_dd_wrapper
-    Storage_migrate Storage_mux Storage_smapiv1_wrapper Stream_vdi
-    System_domains Xapi_psr Xapi_services Xapi_udhcpd)))
+    Storage_migrate Storage_migrate_helper Storage_mux Storage_smapiv1_wrapper 
+    Stream_vdi System_domains Xapi_psr Xapi_services Xapi_udhcpd)))
 )
 
 (library

ocaml/xapi/sm_exec.ml

@@ -582,6 +582,7 @@ let parse_sr_get_driver_info driver (xml : Xml.xml) =
   ; sr_driver_configuration= configuration
   ; sr_driver_text_features= text_features
   ; sr_driver_required_cluster_stack= []
+  ; sr_smapi_version= SMAPIv1
   }
 
 let sr_get_driver_info ~dbg driver =

ocaml/xapi/smint.ml

@@ -192,6 +192,7 @@ type sr_driver_info = {
   ; sr_driver_text_features: string list
   ; sr_driver_configuration: (string * string) list
   ; sr_driver_required_cluster_stack: string list
+  ; sr_smapi_version: Storage_interface.smapi_version
 }
 
 let query_result_of_sr_driver_info x =
@@ -206,6 +207,7 @@ let query_result_of_sr_driver_info x =
   ; features= x.sr_driver_text_features
   ; configuration= x.sr_driver_configuration
   ; required_cluster_stack= x.sr_driver_required_cluster_stack
+  ; smapi_version= x.sr_smapi_version
   }
 
 type attach_info = {

ocaml/xapi/storage_access.ml

@@ -264,7 +264,9 @@ let bind ~__context ~pbd =
     let service = make_service uuid ty in
     System_domains.register_service service queue_name ;
     let info = Client.Query.query dbg in
-    Storage_mux.register (Storage_interface.Sr.of_string sr_uuid) rpc uuid info ;
+    Storage_mux_reg.register
+      (Storage_interface.Sr.of_string sr_uuid)
+      rpc uuid info ;
     info
   with e ->
     error
@@ -281,7 +283,7 @@ let unbind ~__context ~pbd =
   let ty = Db.SR.get_type ~__context ~self:sr in
   let sr = Db.SR.get_uuid ~__context ~self:sr in
   info "SR %s will nolonger be implemented by VM %s" sr (Ref.string_of driver) ;
-  Storage_mux.unregister (Storage_interface.Sr.of_string sr) ;
+  Storage_mux_reg.unregister (Storage_interface.Sr.of_string sr) ;
   let service = make_service uuid ty in
   System_domains.unregister_service service