Bring back DATA.MIRROR.list to storage_mux

Previously this was deleted in commit 1fe6389 as it was not multiplexed,
but looks like we still need to keep it in storage_mux because sm-cli
needs to make rpc calls to storage_mux when trying to list all the
mirrors to make it work properly, due to the fact that the sr plugins
are stored in the address space of the xapi process.

There are other invocations in sm-cli such as `Storage_migrate.start`
which may have similar problems. But I have left them alone as I don't
any reasonable way of calling them from the cli.

Signed-off-by: Vincent Liu <[email protected]>

Author: Vincent-lau

ocaml/xapi-idl/storage/storage_interface.ml

@@ -1190,6 +1190,12 @@ module StorageAPI (R : RPC) = struct
         in
         declare "DATA.MIRROR.is_mirror_failed" []
           (dbg_p @-> id_p @-> sr_p @-> returning mirror_failed_p err)
+
+      let list =
+        let result_p =
+          Param.mk ~name:"mirrors" TypeCombinators.(list (pair Mirror.(id, t)))
+        in
+        declare "DATA.MIRROR.list" [] (dbg_p @-> returning result_p err)
     end
   end
 
@@ -1302,6 +1308,8 @@ module type MIRROR = sig
 
   val is_mirror_failed :
     context -> dbg:debug_info -> mirror_id:Mirror.id -> sr:Sr.t -> bool
+
+  val list : context -> dbg:debug_info -> (Mirror.id * Mirror.t) list
 end
 
 module type Server_impl = sig
@@ -1782,6 +1790,7 @@ module Server (Impl : Server_impl) () = struct
     S.DATA.MIRROR.is_mirror_failed (fun dbg mirror_id sr ->
         Impl.DATA.MIRROR.is_mirror_failed () ~dbg ~mirror_id ~sr
     ) ;
+    S.DATA.MIRROR.list (fun dbg -> Impl.DATA.MIRROR.list () ~dbg) ;
     S.DATA.import_activate (fun dbg dp sr vdi vm ->
         Impl.DATA.import_activate () ~dbg ~dp ~sr ~vdi ~vm
     ) ;

ocaml/xapi-idl/storage/storage_skeleton.ml

@@ -188,6 +188,8 @@ module DATA = struct
 
     let is_mirror_failed ctx ~dbg ~mirror_id ~sr =
       u "DATA.MIRROR.is_mirror_failed"
+
+    let list ctx ~dbg = u "DATA.MIRROR.list"
   end
 end
 

ocaml/xapi-storage-cli/main.ml

@@ -149,7 +149,7 @@ let string_of_file filename =
 
 let mirror_list common_opts =
   wrap common_opts (fun () ->
-      let list = Storage_migrate.list ~dbg in
+      let list = Client.DATA.MIRROR.list dbg in
       List.iter
         (fun (id, status) -> Printf.printf "%s" (string_of_mirror id status))
         list

ocaml/xapi-storage-script/main.ml

@@ -1929,6 +1929,7 @@ let bind ~volume_script_dir =
   S.DATA.MIRROR.receive_cancel2 (u "DATA.MIRROR.receive_cancel2") ;
   S.DATA.MIRROR.pre_deactivate_hook (u "DATA.MIRROR.pre_deactivate_hook") ;
   S.DATA.MIRROR.is_mirror_failed (u "DATA.MIRROR.is_mirror_failed") ;
+  S.DATA.MIRROR.list (u "DATA.MIRROR.list") ;
   S.DP.create (u "DP.create") ;
   S.TASK.cancel (u "TASK.cancel") ;
   S.TASK.list (u "TASK.list") ;

ocaml/xapi/storage_mux.ml

@@ -863,6 +863,11 @@ module Mux = struct
 
       let is_mirror_failed _ctx ~dbg:_ ~mirror_id:_ ~sr:_ =
         u "DATA.MIRROR.is_mirror_failed"
+
+      let list () ~dbg =
+        with_dbg ~name:"DATA.MIRROR.list" ~dbg @@ fun di ->
+        info "%s dbg: %s" __FUNCTION__ dbg ;
+        Storage_migrate.list ~dbg:di.log
     end
   end
 

ocaml/xapi/storage_smapiv1.ml

@@ -1161,6 +1161,8 @@ module SMAPIv1 : Server_impl = struct
       let pre_deactivate_hook _context ~dbg:_ ~dp:_ ~sr:_ ~vdi:_ = assert false
 
       let is_mirror_failed _context ~dbg:_ ~mirror_id:_ ~sr:_ = assert false
+
+      let list _context ~dbg:_ = assert false
     end
   end
 

ocaml/xapi/storage_smapiv1_migrate.ml

@@ -825,4 +825,6 @@ module MIRROR : SMAPIv2_MIRROR = struct
     )
     | _ ->
         false
+
+  let list _ctx = u __FUNCTION__
 end

ocaml/xapi/storage_smapiv1_wrapper.ml

@@ -1224,6 +1224,8 @@ functor
           u __FUNCTION__
 
         let is_mirror_failed _context ~dbg:_ ~mirror_id:_ ~sr:_ = u __FUNCTION__
+
+        let list _context ~dbg:_ = u __FUNCTION__
       end
     end
 

ocaml/xapi/storage_smapiv3_migrate.ml

@@ -42,4 +42,6 @@ module MIRROR : SMAPIv2_MIRROR = struct
   let is_mirror_failed _ctx = u __FUNCTION__
 
   let pre_deactivate_hook _ctx = u __FUNCTION__
+
+  let list _ctx = u __FUNCTION__
 end