CP-54020: Refactor sxm and storage_mux code

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