From b02ef25e68dc27f655d713d47c927414836c0ce4 Mon Sep 17 00:00:00 2001 From: Vincent Liu Date: Mon, 24 Mar 2025 16:48:28 +0000 Subject: [PATCH 1/6] Move two storage functions to DATA module `import_activate` and `get_nbd_server` is more like datapath functions so I am moving them into the `DATA` module whereas they were previoulsy in `DATA.MIRROR` module. Reserve `DATA.MIRROR` only for storage migrate functionalities that is implemented in the xapi layer but no in the storage layer. Signed-off-by: Vincent Liu --- ocaml/xapi-idl/storage/storage_interface.ml | 84 ++++++++------ ocaml/xapi-idl/storage/storage_skeleton.ml | 11 +- ocaml/xapi-storage-script/main.ml | 116 ++++++++++---------- ocaml/xapi/storage_migrate.ml | 4 +- ocaml/xapi/storage_mux.ml | 36 +++--- ocaml/xapi/storage_smapiv1.ml | 9 +- ocaml/xapi/storage_smapiv1_wrapper.ml | 86 +++++++-------- 7 files changed, 176 insertions(+), 170 deletions(-) diff --git a/ocaml/xapi-idl/storage/storage_interface.ml b/ocaml/xapi-idl/storage/storage_interface.ml index 34856e0a57b..f6e292b9f29 100644 --- a/ocaml/xapi-idl/storage/storage_interface.ml +++ b/ocaml/xapi-idl/storage/storage_interface.ml @@ -1000,6 +1000,32 @@ module StorageAPI (R : RPC) = struct @-> returning result_p err ) + (** [import_activate dbg dp sr vdi vm] returns a server socket address to + which a fd can be passed via SCM_RIGHTS for mirroring purposes.*) + let import_activate = + declare "DATA.import_activate" [] + (dbg_p + @-> dp_p + @-> sr_p + @-> vdi_p + @-> vm_p + @-> returning sock_path_p err + ) + + (** [get_nbd_server dbg dp sr vdi vm] returns the address of a generic nbd + server that can be connected to. Depending on the backend, this will either + be a nbd server backed by tapdisk or qemu-dp. Note this is different + from [import_activate] as the returned server does not accept fds. *) + let get_nbd_server = + declare "DATA.get_nbd_server" [] + (dbg_p + @-> dp_p + @-> sr_p + @-> vdi_p + @-> vm_p + @-> returning sock_path_p err + ) + module MIRROR = struct let mirror_vm_p = Param.mk ~name:"mirror_vm" Vm.t @@ -1091,32 +1117,6 @@ module StorageAPI (R : RPC) = struct Param.mk ~name:"mirrors" TypeCombinators.(list (pair Mirror.(id, t))) in declare "DATA.MIRROR.list" [] (dbg_p @-> returning result_p err) - - (** [import_activate dbg dp sr vdi vm] returns a server socket address to - which a fd can be passed via SCM_RIGHTS for mirroring purposes.*) - let import_activate = - declare "DATA.MIRROR.import_activate" [] - (dbg_p - @-> dp_p - @-> sr_p - @-> vdi_p - @-> vm_p - @-> returning sock_path_p err - ) - - (** [get_nbd_server dbg dp sr vdi vm] returns the address of a generic nbd - server that can be connected to. Depending on the backend, this will either - be a nbd server backed by tapdisk or qemu-dp. Note this is different - from [import_activate] as the returned server does not accept fds. *) - let get_nbd_server = - declare "DATA.MIRROR.get_nbd_server" [] - (dbg_p - @-> dp_p - @-> sr_p - @-> vdi_p - @-> vm_p - @-> returning sock_path_p err - ) end end @@ -1207,12 +1207,6 @@ module type MIRROR = sig 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 @@ -1471,6 +1465,24 @@ module type Server_impl = sig -> verify_dest:bool -> Task.id + 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 + module MIRROR : MIRROR end @@ -1650,11 +1662,11 @@ module Server (Impl : Server_impl) () = struct Impl.DATA.MIRROR.receive_finalize2 () ~dbg ~id ) ; S.DATA.MIRROR.list (fun dbg -> Impl.DATA.MIRROR.list () ~dbg) ; - S.DATA.MIRROR.import_activate (fun dbg dp sr vdi vm -> - Impl.DATA.MIRROR.import_activate () ~dbg ~dp ~sr ~vdi ~vm + S.DATA.import_activate (fun dbg dp sr vdi vm -> + Impl.DATA.import_activate () ~dbg ~dp ~sr ~vdi ~vm ) ; - S.DATA.MIRROR.get_nbd_server (fun dbg dp sr vdi vm -> - Impl.DATA.MIRROR.get_nbd_server () ~dbg ~dp ~sr ~vdi ~vm + S.DATA.get_nbd_server (fun dbg dp sr vdi vm -> + Impl.DATA.get_nbd_server () ~dbg ~dp ~sr ~vdi ~vm ) ; S.Policy.get_backend_vm (fun dbg vm sr vdi -> Impl.Policy.get_backend_vm () ~dbg ~vm ~sr ~vdi diff --git a/ocaml/xapi-idl/storage/storage_skeleton.ml b/ocaml/xapi-idl/storage/storage_skeleton.ml index 4b5b23e6973..03f3741f513 100644 --- a/ocaml/xapi-idl/storage/storage_skeleton.ml +++ b/ocaml/xapi-idl/storage/storage_skeleton.ml @@ -154,6 +154,11 @@ let get_by_name ctx ~dbg ~name = u "get_by_name" module DATA = struct let copy ctx ~dbg ~sr ~vdi ~vm ~url ~dest = u "DATA.copy" + let import_activate ctx ~dbg ~dp ~sr ~vdi ~vm = + u "DATA.MIRROR.import_activate" + + let get_nbd_server ctx ~dbg ~dp ~sr ~vdi ~vm = u "DATA.MIRROR.get_nbd_server" + module MIRROR = struct type context = unit @@ -179,12 +184,6 @@ module DATA = struct let receive_cancel ctx ~dbg ~id = u "DATA.MIRROR.receive_cancel" let list ctx ~dbg = u "DATA.MIRROR.list" - - let import_activate ctx ~dbg ~dp ~sr ~vdi ~vm = - u "DATA.MIRROR.import_activate" - - let get_nbd_server ctx ~dbg ~dp ~sr ~vdi ~vm = - u "DATA.MIRROR.get_nbd_server" end end diff --git a/ocaml/xapi-storage-script/main.ml b/ocaml/xapi-storage-script/main.ml index 5910d65f28f..0f1e768bc50 100644 --- a/ocaml/xapi-storage-script/main.ml +++ b/ocaml/xapi-storage-script/main.ml @@ -1789,59 +1789,59 @@ end module DATAImpl (M : META) = struct module VDI = VDIImpl (M) - module MIRROR = struct - let data_import_activate_impl dbg _dp sr vdi' vm' = - wrap - @@ - let vdi = Storage_interface.Vdi.string_of vdi' in - let domain = Storage_interface.Vm.string_of vm' in - Attached_SRs.find sr >>>= fun sr -> - (* Discover the URIs using Volume.stat *) - VDI.stat ~dbg ~sr ~vdi >>>= fun response -> - ( match - List.assoc_opt _clone_on_boot_key response.Xapi_storage.Control.keys - with - | None -> - return response - | Some temporary -> - VDI.stat ~dbg ~sr ~vdi:temporary + let data_import_activate_impl dbg _dp sr vdi' vm' = + wrap + @@ + let vdi = Storage_interface.Vdi.string_of vdi' in + let domain = Storage_interface.Vm.string_of vm' in + Attached_SRs.find sr >>>= fun sr -> + (* Discover the URIs using Volume.stat *) + VDI.stat ~dbg ~sr ~vdi >>>= fun response -> + ( match + List.assoc_opt _clone_on_boot_key response.Xapi_storage.Control.keys + with + | None -> + return response + | Some temporary -> + VDI.stat ~dbg ~sr ~vdi:temporary + ) + >>>= fun response -> + choose_datapath response >>>= fun (rpc, datapath, uri) -> + if Datapath_plugins.supports_feature datapath _vdi_mirror_in then + return_data_rpc (fun () -> + Datapath_client.import_activate (rpc ~dbg) dbg uri domain ) - >>>= fun response -> - choose_datapath response >>>= fun (rpc, datapath, uri) -> - if Datapath_plugins.supports_feature datapath _vdi_mirror_in then - return_data_rpc (fun () -> - Datapath_client.import_activate (rpc ~dbg) dbg uri domain - ) - else - fail (Storage_interface.Errors.Unimplemented _vdi_mirror_in) - - let get_nbd_server_impl dbg _dp sr vdi' vm' = - wrap - @@ - let vdi = Storage_interface.Vdi.string_of vdi' in - let domain = Storage_interface.Vm.string_of vm' in - VDI.vdi_attach_common dbg sr vdi domain >>>= function - | response -> ( - let _, _, _, nbds = - Storage_interface.implementations_of_backend - { - Storage_interface.implementations= - List.map convert_implementation - response.Xapi_storage.Data.implementations - } - in - match nbds with - | ({uri} as nbd) :: _ -> - info (fun m -> - m "%s qemu-dp nbd server address is %s" __FUNCTION__ uri - ) - >>= fun () -> - let socket, _export = Storage_interface.parse_nbd_uri nbd in - return socket - | _ -> - fail (backend_error "No nbd server found" []) - ) - end + else + fail (Storage_interface.Errors.Unimplemented _vdi_mirror_in) + + let get_nbd_server_impl dbg _dp sr vdi' vm' = + wrap + @@ + let vdi = Storage_interface.Vdi.string_of vdi' in + let domain = Storage_interface.Vm.string_of vm' in + VDI.vdi_attach_common dbg sr vdi domain >>>= function + | response -> ( + let _, _, _, nbds = + Storage_interface.implementations_of_backend + { + Storage_interface.implementations= + List.map convert_implementation + response.Xapi_storage.Data.implementations + } + in + match nbds with + | ({uri} as nbd) :: _ -> + info (fun m -> + m "%s qemu-dp nbd server address is %s" __FUNCTION__ uri + ) + >>= fun () -> + let socket, _export = Storage_interface.parse_nbd_uri nbd in + return socket + | _ -> + fail (backend_error "No nbd server found" []) + ) + + module MIRROR = struct end end (* Bind the implementations *) @@ -1905,14 +1905,12 @@ let bind ~volume_script_dir = S.DP.attach_info DP.dp_attach_info_impl ; let module DATA = DATAImpl (RuntimeMeta) in - S.DATA.MIRROR.get_nbd_server DATA.MIRROR.get_nbd_server_impl ; - S.DATA.MIRROR.import_activate DATA.MIRROR.data_import_activate_impl ; + S.DATA.get_nbd_server DATA.get_nbd_server_impl ; + S.DATA.import_activate DATA.data_import_activate_impl ; let u name _ = failwith ("Unimplemented: " ^ name) in S.get_by_name (u "get_by_name") ; S.VDI.get_by_name (u "VDI.get_by_name") ; - S.DATA.MIRROR.receive_start (u "DATA.MIRROR.receive_start") ; - S.DATA.MIRROR.receive_start2 (u "DATA.MIRROR.receive_start2") ; S.UPDATES.get (u "UPDATES.get") ; S.SR.update_snapshot_info_dest (u "SR.update_snapshot_info_dest") ; S.DATA.MIRROR.list (u "DATA.MIRROR.list") ; @@ -1923,19 +1921,21 @@ let bind ~volume_script_dir = S.VDI.similar_content (u "VDI.similar_content") ; S.DATA.copy (u "DATA.copy") ; S.DP.stat_vdi (u "DP.stat_vdi") ; + S.DATA.MIRROR.receive_start (u "DATA.MIRROR.receive_start") ; + S.DATA.MIRROR.receive_start2 (u "DATA.MIRROR.receive_start2") ; S.DATA.MIRROR.receive_finalize (u "DATA.MIRROR.receive_finalize") ; S.DATA.MIRROR.receive_finalize2 (u "DATA.MIRROR.receive_finalize2") ; + S.DATA.MIRROR.receive_cancel (u "DATA.MIRROR.receive_cancel") ; S.DP.create (u "DP.create") ; S.TASK.cancel (u "TASK.cancel") ; + S.TASK.list (u "TASK.list") ; S.VDI.attach (u "VDI.attach") ; S.VDI.attach2 (u "VDI.attach2") ; S.VDI.activate (u "VDI.activate") ; S.DATA.MIRROR.stat (u "DATA.MIRROR.stat") ; - S.TASK.list (u "TASK.list") ; S.VDI.get_url (u "VDI.get_url") ; S.DATA.MIRROR.start (u "DATA.MIRROR.start") ; S.Policy.get_backend_vm (u "Policy.get_backend_vm") ; - S.DATA.MIRROR.receive_cancel (u "DATA.MIRROR.receive_cancel") ; S.SR.update_snapshot_info_src (u "SR.update_snapshot_info_src") ; S.DATA.MIRROR.stop (u "DATA.MIRROR.stop") ; Rpc_lwt.server S.implementation diff --git a/ocaml/xapi/storage_migrate.ml b/ocaml/xapi/storage_migrate.ml index 8952f947993..27f91f036b6 100644 --- a/ocaml/xapi/storage_migrate.ml +++ b/ocaml/xapi/storage_migrate.ml @@ -1013,7 +1013,7 @@ let nbd_handler req s ?(vm = "0") sr vdi dp = let vm = Vm.of_string vm in let path = Storage_utils.transform_storage_exn (fun () -> - Local.DATA.MIRROR.import_activate "nbd" dp sr vdi vm + Local.DATA.import_activate "nbd" dp sr vdi vm ) in Http_svr.headers s (Http.http_200_ok () @ ["Transfer-encoding: nbd"]) ; @@ -1043,7 +1043,7 @@ let nbd_proxy req s vm sr vdi dp = let vm = Vm.of_string vm in let path = Storage_utils.transform_storage_exn (fun () -> - Local.DATA.MIRROR.get_nbd_server "nbd" dp sr vdi vm + Local.DATA.get_nbd_server "nbd" dp sr vdi vm ) in debug "%s got nbd server path %s" __FUNCTION__ path ; diff --git a/ocaml/xapi/storage_mux.ml b/ocaml/xapi/storage_mux.ml index 9b071b86187..2c6884d48b5 100644 --- a/ocaml/xapi/storage_mux.ml +++ b/ocaml/xapi/storage_mux.ml @@ -739,6 +739,24 @@ module Mux = struct let copy () ~dbg = with_dbg ~name:"DATA.copy" ~dbg @@ fun dbg -> Storage_migrate.copy ~dbg + let import_activate () ~dbg ~dp ~sr ~vdi ~vm = + with_dbg ~name:"DATA.import_activate" ~dbg @@ fun di -> + info "%s dbg:%s dp:%s sr:%s vdi:%s vm:%s" __FUNCTION__ dbg dp (s_of_sr sr) + (s_of_vdi vdi) (s_of_vm vm) ; + let module C = StorageAPI (Idl.Exn.GenClient (struct + let rpc = of_sr sr + end)) in + C.DATA.import_activate (Debug_info.to_string di) dp sr vdi vm + + let get_nbd_server () ~dbg ~dp ~sr ~vdi ~vm = + with_dbg ~name:"DATA.get_nbd_server" ~dbg @@ fun di -> + info "%s dbg:%s dp:%s sr:%s vdi:%s vm:%s" __FUNCTION__ dbg dp (s_of_sr sr) + (s_of_vdi vdi) (s_of_vm vm) ; + let module C = StorageAPI (Idl.Exn.GenClient (struct + let rpc = of_sr sr + end)) in + C.DATA.get_nbd_server (Debug_info.to_string di) dp sr vdi vm + module MIRROR = struct type context = unit @@ -803,24 +821,6 @@ module Mux = struct with_dbg ~name:"DATA.MIRROR.receive_cancel" ~dbg @@ fun di -> info "%s dbg: %s mirror_id: %s" __FUNCTION__ dbg id ; Storage_migrate.receive_cancel ~dbg:di.log ~id - - let import_activate () ~dbg ~dp ~sr ~vdi ~vm = - with_dbg ~name:"DATA.MIRROR.import_activate" ~dbg @@ fun di -> - info "%s dbg:%s dp:%s sr:%s vdi:%s vm:%s" __FUNCTION__ dbg dp - (s_of_sr sr) (s_of_vdi vdi) (s_of_vm vm) ; - let module C = StorageAPI (Idl.Exn.GenClient (struct - let rpc = of_sr sr - end)) in - C.DATA.MIRROR.import_activate (Debug_info.to_string di) dp sr vdi vm - - let get_nbd_server () ~dbg ~dp ~sr ~vdi ~vm = - with_dbg ~name:"DATA.MIRROR.get_nbd_server" ~dbg @@ fun di -> - info "%s dbg:%s dp:%s sr:%s vdi:%s vm:%s" __FUNCTION__ dbg dp - (s_of_sr sr) (s_of_vdi vdi) (s_of_vm vm) ; - let module C = StorageAPI (Idl.Exn.GenClient (struct - let rpc = of_sr sr - end)) in - C.DATA.MIRROR.get_nbd_server (Debug_info.to_string di) dp sr vdi vm end end diff --git a/ocaml/xapi/storage_smapiv1.ml b/ocaml/xapi/storage_smapiv1.ml index 4373fdaae87..d459c0ee2b0 100644 --- a/ocaml/xapi/storage_smapiv1.ml +++ b/ocaml/xapi/storage_smapiv1.ml @@ -1212,6 +1212,10 @@ module SMAPIv1 : Server_impl = struct let copy _context ~dbg:_ ~sr:_ ~vdi:_ ~vm:_ ~url:_ ~dest:_ ~verify_dest:_ = assert false + let import_activate _context ~dbg:_ ~dp:_ ~sr:_ ~vdi:_ ~vm:_ = assert false + + let get_nbd_server _context ~dbg:_ ~dp:_ ~sr:_ ~vdi:_ ~vm:_ = assert false + module MIRROR = struct type context = unit @@ -1237,11 +1241,6 @@ module SMAPIv1 : Server_impl = struct let receive_finalize2 _context ~dbg:_ ~id:_ = assert false let receive_cancel _context ~dbg:_ ~id:_ = assert false - - let import_activate _context ~dbg:_ ~dp:_ ~sr:_ ~vdi:_ ~vm:_ = - assert false - - let get_nbd_server _context ~dbg:_ ~dp:_ ~sr:_ ~vdi:_ ~vm:_ = assert false end end diff --git a/ocaml/xapi/storage_smapiv1_wrapper.ml b/ocaml/xapi/storage_smapiv1_wrapper.ml index f87bb9ffc4f..7672a4b61e6 100644 --- a/ocaml/xapi/storage_smapiv1_wrapper.ml +++ b/ocaml/xapi/storage_smapiv1_wrapper.ml @@ -1142,6 +1142,47 @@ functor (s_of_vdi vdi) url (s_of_sr dest) ; Impl.DATA.copy context ~dbg ~sr ~vdi ~vm ~url ~dest + (* tapdisk supports three kind of nbd servers, the old style nbdserver, + the new style nbd server and a real nbd server. The old and new style nbd servers + are "special" nbd servers that accept fds passed via SCM_RIGHTS and handle + connection based on that fd. The real nbd server is a "normal" nbd server + that accepts nbd connections from nbd clients, and it does not support fd + passing. *) + let get_nbd_server_common context ~dbg ~dp ~sr ~vdi ~vm ~style = + info "%s DATA.get_nbd_server dbg:%s dp:%s sr:%s vdi:%s vm:%s" + __FUNCTION__ dbg dp (s_of_sr sr) (s_of_vdi vdi) (s_of_vm vm) ; + let attach_info = DP.attach_info context ~dbg:"nbd" ~sr ~vdi ~dp ~vm in + match Storage_migrate.tapdisk_of_attach_info attach_info with + | Some tapdev -> + let minor = Tapctl.get_minor tapdev in + let pid = Tapctl.get_tapdisk_pid tapdev in + let path = + match style with + | `newstyle -> + Printf.sprintf "/var/run/blktap-control/nbdserver-new%d.%d" + pid minor + | `oldstyle -> + Printf.sprintf "/var/run/blktap-control/nbdserver%d.%d" pid + minor + | `real -> + Printf.sprintf "/var/run/blktap-control/nbd%d.%d" pid minor + in + debug "%s nbd server path is %s" __FUNCTION__ path ; + path + | None -> + raise + (Storage_interface.Storage_error + (Backend_error + (Api_errors.internal_error, ["No tapdisk attach info found"]) + ) + ) + + let import_activate context ~dbg ~dp ~sr ~vdi ~vm = + get_nbd_server_common context ~dbg ~dp ~sr ~vdi ~vm ~style:`oldstyle + + let get_nbd_server context ~dbg ~dp ~sr ~vdi ~vm = + get_nbd_server_common context ~dbg ~dp ~sr ~vdi ~vm ~style:`real + module MIRROR = struct type context = unit @@ -1189,51 +1230,6 @@ functor let receive_cancel context ~dbg ~id = info "DATA.MIRROR.receive_cancel dbg:%s id:%s" dbg id ; Impl.DATA.MIRROR.receive_cancel context ~dbg ~id - - (* tapdisk supports three kind of nbd servers, the old style nbdserver, - the new style nbd server and a real nbd server. The old and new style nbd servers - are "special" nbd servers that accept fds passed via SCM_RIGHTS and handle - connection based on that fd. The real nbd server is a "normal" nbd server - that accepts nbd connections from nbd clients, and it does not support fd - passing. *) - let get_nbd_server_common context ~dbg ~dp ~sr ~vdi ~vm ~style = - info "%s DATA.MIRROR.get_nbd_server dbg:%s dp:%s sr:%s vdi:%s vm:%s" - __FUNCTION__ dbg dp (s_of_sr sr) (s_of_vdi vdi) (s_of_vm vm) ; - let attach_info = - DP.attach_info context ~dbg:"nbd" ~sr ~vdi ~dp ~vm - in - match Storage_migrate.tapdisk_of_attach_info attach_info with - | Some tapdev -> - let minor = Tapctl.get_minor tapdev in - let pid = Tapctl.get_tapdisk_pid tapdev in - let path = - match style with - | `newstyle -> - Printf.sprintf "/var/run/blktap-control/nbdserver-new%d.%d" - pid minor - | `oldstyle -> - Printf.sprintf "/var/run/blktap-control/nbdserver%d.%d" pid - minor - | `real -> - Printf.sprintf "/var/run/blktap-control/nbd%d.%d" pid minor - in - debug "%s nbd server path is %s" __FUNCTION__ path ; - path - | None -> - raise - (Storage_interface.Storage_error - (Backend_error - ( Api_errors.internal_error - , ["No tapdisk attach info found"] - ) - ) - ) - - let import_activate context ~dbg ~dp ~sr ~vdi ~vm = - get_nbd_server_common context ~dbg ~dp ~sr ~vdi ~vm ~style:`oldstyle - - let get_nbd_server context ~dbg ~dp ~sr ~vdi ~vm = - get_nbd_server_common context ~dbg ~dp ~sr ~vdi ~vm ~style:`real end end From 00e6954f76cc2b0e0314d42e399d593e9afda902 Mon Sep 17 00:00:00 2001 From: Vincent Liu Date: Mon, 24 Mar 2025 17:08:18 +0000 Subject: [PATCH 2/6] CP-54072: Remove some of the unmuxed functions There are several functions in storage_interface and hence storage_mux, such as `start`, `stop`, `list`. These functions are currently not multiplexed but just called directly into storage_migrate. In fact, they are unlikely to be multiplexed because they use the `State` module in storage migrate, which is a in memory hashtable in xapi, not accessible by xapi-storage-script. So remove them from the storage interface, and callers of these functions can call them from storage_migrate directly rather than going through the storage interface. None of these are remote functions so no need to worry about backwards compatibility. Signed-off-by: Vincent Liu --- ocaml/xapi-idl/storage/storage_interface.ml | 61 ---------- ocaml/xapi-idl/storage/storage_skeleton.ml | 11 -- ocaml/xapi-storage-cli/dune | 1 + ocaml/xapi-storage-cli/main.ml | 10 +- ocaml/xapi-storage-script/main.ml | 4 - ocaml/xapi/storage_access.ml | 2 +- ocaml/xapi/storage_migrate.ml | 126 +++++++++++--------- ocaml/xapi/storage_mux.ml | 26 ---- ocaml/xapi/storage_smapiv1.ml | 10 -- ocaml/xapi/storage_smapiv1_wrapper.ml | 18 --- ocaml/xapi/xapi_vm_migrate.ml | 11 +- 11 files changed, 82 insertions(+), 198 deletions(-) diff --git a/ocaml/xapi-idl/storage/storage_interface.ml b/ocaml/xapi-idl/storage/storage_interface.ml index f6e292b9f29..d3e1448aba8 100644 --- a/ocaml/xapi-idl/storage/storage_interface.ml +++ b/ocaml/xapi-idl/storage/storage_interface.ml @@ -1027,36 +1027,8 @@ module StorageAPI (R : RPC) = struct ) module MIRROR = struct - let mirror_vm_p = Param.mk ~name:"mirror_vm" Vm.t - - let copy_vm_p = Param.mk ~name:"copy_vm" Vm.t - - (** [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 = - declare "DATA.MIRROR.start" [] - (dbg_p - @-> sr_p - @-> vdi_p - @-> dp_p - @-> mirror_vm_p - @-> copy_vm_p - @-> url_p - @-> dest_p - @-> verify_dest_p - @-> returning task_id_p err - ) - let id_p = Param.mk ~name:"id" Mirror.id - (** [stop task sr vdi] stops mirroring local [vdi] *) - let stop = - declare "DATA.MIRROR.stop" [] (dbg_p @-> id_p @-> returning unit_p err) - - let stat = - let result_p = Param.mk ~name:"result" Mirror.t in - declare "DATA.MIRROR.stat" [] (dbg_p @-> id_p @-> returning result_p err) - (** Called on the receiving end @deprecated This function is deprecated, and is only here to keep backward compatibility with old xapis that call Remote.DATA.MIRROR.receive_start during SXM. @@ -1111,12 +1083,6 @@ module StorageAPI (R : RPC) = struct let receive_cancel = declare "DATA.MIRROR.receive_cancel" [] (dbg_p @-> id_p @-> returning unit_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 @@ -1164,23 +1130,6 @@ 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 @@ -1205,8 +1154,6 @@ module type MIRROR = sig 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 end module type Server_impl = sig @@ -1639,13 +1586,6 @@ module Server (Impl : Server_impl) () = struct S.DATA.copy (fun dbg sr vdi vm url dest verify_dest -> Impl.DATA.copy () ~dbg ~sr ~vdi ~vm ~url ~dest ~verify_dest ) ; - S.DATA.MIRROR.start - (fun dbg sr vdi dp mirror_vm copy_vm url dest verify_dest -> - Impl.DATA.MIRROR.start () ~dbg ~sr ~vdi ~dp ~mirror_vm ~copy_vm ~url - ~dest ~verify_dest - ) ; - S.DATA.MIRROR.stop (fun dbg id -> Impl.DATA.MIRROR.stop () ~dbg ~id) ; - S.DATA.MIRROR.stat (fun dbg id -> Impl.DATA.MIRROR.stat () ~dbg ~id) ; S.DATA.MIRROR.receive_start (fun dbg sr vdi_info id similar -> Impl.DATA.MIRROR.receive_start () ~dbg ~sr ~vdi_info ~id ~similar ) ; @@ -1661,7 +1601,6 @@ module Server (Impl : Server_impl) () = struct S.DATA.MIRROR.receive_finalize2 (fun dbg id -> Impl.DATA.MIRROR.receive_finalize2 () ~dbg ~id ) ; - 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 ) ; diff --git a/ocaml/xapi-idl/storage/storage_skeleton.ml b/ocaml/xapi-idl/storage/storage_skeleton.ml index 03f3741f513..04a4bb1e85e 100644 --- a/ocaml/xapi-idl/storage/storage_skeleton.ml +++ b/ocaml/xapi-idl/storage/storage_skeleton.ml @@ -162,15 +162,6 @@ module DATA = struct 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 = - u "DATA.MIRROR.start" - - let stop ctx ~dbg ~id = u "DATA.MIRROR.stop" - - let stat ctx ~dbg ~id = u "DATA.MIRROR.stat" - let receive_start ctx ~dbg ~sr ~vdi_info ~id ~similar = u "DATA.MIRROR.receive_start" @@ -182,8 +173,6 @@ module DATA = struct let receive_finalize2 ctx ~dbg ~id = u "DATA.MIRROR.receive_finalize2" let receive_cancel ctx ~dbg ~id = u "DATA.MIRROR.receive_cancel" - - let list ctx ~dbg = u "DATA.MIRROR.list" end end diff --git a/ocaml/xapi-storage-cli/dune b/ocaml/xapi-storage-cli/dune index 624f2f727e1..c59c5c1fad4 100644 --- a/ocaml/xapi-storage-cli/dune +++ b/ocaml/xapi-storage-cli/dune @@ -5,6 +5,7 @@ xapi-idl xapi-idl.storage xapi-idl.storage.interface + xapi_internal re re.str rpclib.core diff --git a/ocaml/xapi-storage-cli/main.ml b/ocaml/xapi-storage-cli/main.ml index c64a4f6fcd9..536ea02608e 100644 --- a/ocaml/xapi-storage-cli/main.ml +++ b/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 = Client.DATA.MIRROR.list dbg in + let list = Storage_migrate.list ~dbg in List.iter (fun (id, status) -> Printf.printf "%s" (string_of_mirror id status)) list @@ -323,9 +323,9 @@ let mirror_start common_opts sr vdi dp url dest verify_dest = let url = get_opt url "Need a URL" in let dest = get_opt dest "Need a destination SR" in let task = - Client.DATA.MIRROR.start dbg sr vdi dp mirror_vm copy_vm url - (Storage_interface.Sr.of_string dest) - verify_dest + Storage_migrate.start ~dbg ~sr ~vdi ~dp ~mirror_vm ~copy_vm ~url + ~dest:(Storage_interface.Sr.of_string dest) + ~verify_dest in Printf.printf "Task id: %s\n" task ) @@ -335,7 +335,7 @@ let mirror_stop common_opts id = wrap common_opts (fun () -> match id with | Some id -> - Client.DATA.MIRROR.stop dbg id + Storage_migrate.stop ~dbg ~id | None -> failwith "Need an ID" ) diff --git a/ocaml/xapi-storage-script/main.ml b/ocaml/xapi-storage-script/main.ml index 0f1e768bc50..29c321836c6 100644 --- a/ocaml/xapi-storage-script/main.ml +++ b/ocaml/xapi-storage-script/main.ml @@ -1913,7 +1913,6 @@ let bind ~volume_script_dir = S.VDI.get_by_name (u "VDI.get_by_name") ; S.UPDATES.get (u "UPDATES.get") ; S.SR.update_snapshot_info_dest (u "SR.update_snapshot_info_dest") ; - S.DATA.MIRROR.list (u "DATA.MIRROR.list") ; S.TASK.stat (u "TASK.stat") ; S.DP.diagnostics (u "DP.diagnostics") ; S.TASK.destroy (u "TASK.destroy") ; @@ -1932,12 +1931,9 @@ let bind ~volume_script_dir = S.VDI.attach (u "VDI.attach") ; S.VDI.attach2 (u "VDI.attach2") ; S.VDI.activate (u "VDI.activate") ; - S.DATA.MIRROR.stat (u "DATA.MIRROR.stat") ; S.VDI.get_url (u "VDI.get_url") ; - S.DATA.MIRROR.start (u "DATA.MIRROR.start") ; S.Policy.get_backend_vm (u "Policy.get_backend_vm") ; S.SR.update_snapshot_info_src (u "SR.update_snapshot_info_src") ; - S.DATA.MIRROR.stop (u "DATA.MIRROR.stop") ; Rpc_lwt.server S.implementation let process_smapiv2_requests server txt = diff --git a/ocaml/xapi/storage_access.ml b/ocaml/xapi/storage_access.ml index 0aeed25125d..6eaee5a029e 100644 --- a/ocaml/xapi/storage_access.ml +++ b/ocaml/xapi/storage_access.ml @@ -439,7 +439,7 @@ let update_task ~__context id = let update_mirror ~__context id = try let dbg = Context.string_of_task __context in - let m = Client.DATA.MIRROR.stat dbg id in + let m = Storage_migrate.stat ~dbg ~id in if m.Mirror.failed then debug "Mirror %s has failed" id ; let task = get_mirror_task id in diff --git a/ocaml/xapi/storage_migrate.ml b/ocaml/xapi/storage_migrate.ml index 27f91f036b6..023a984256e 100644 --- a/ocaml/xapi/storage_migrate.ml +++ b/ocaml/xapi/storage_migrate.ml @@ -401,6 +401,70 @@ module MigrateLocal = struct | e -> raise (Storage_error (Internal_error (Printexc.to_string e))) + let stop_internal ~dbg ~id = + (* Find the local VDI *) + let alm = State.find_active_local_mirror id in + match alm with + | Some alm -> + ( match alm.State.Send_state.remote_info with + | Some remote_info -> ( + let sr, vdi = State.of_mirror_id id in + let vdis = Local.SR.scan dbg sr in + let local_vdi = + try List.find (fun x -> x.vdi = vdi) vdis + with Not_found -> + failwith + (Printf.sprintf "Local VDI %s not found" + (Storage_interface.Vdi.string_of vdi) + ) + in + let local_vdi = add_to_sm_config local_vdi "mirror" "null" in + let local_vdi = remove_from_sm_config local_vdi "base_mirror" in + (* Disable mirroring on the local machine *) + let snapshot = Local.VDI.snapshot dbg sr local_vdi in + Local.VDI.destroy dbg sr snapshot.vdi ; + (* Destroy the snapshot, if it still exists *) + let snap = + try + Some + (List.find + (fun x -> + List.mem_assoc "base_mirror" x.sm_config + && List.assoc "base_mirror" x.sm_config = id + ) + vdis + ) + with _ -> None + in + ( match snap with + | Some s -> + debug "Found snapshot VDI: %s" + (Storage_interface.Vdi.string_of s.vdi) ; + Local.VDI.destroy dbg sr s.vdi + | None -> + debug "Snapshot VDI already cleaned up" + ) ; + + let (module Remote) = + get_remote_backend remote_info.url remote_info.verify_dest + in + try Remote.DATA.MIRROR.receive_cancel dbg id with _ -> () + ) + | None -> + () + ) ; + State.remove_local_mirror id + | None -> + raise (Storage_interface.Storage_error (Does_not_exist ("mirror", id))) + + let stop ~dbg ~id = + try stop_internal ~dbg ~id with + | Storage_error (Backend_error (code, params)) + | Api_errors.Server_error (code, params) -> + raise (Storage_error (Backend_error (code, params))) + | e -> + raise e + let start ~task ~dbg ~sr ~vdi ~dp ~mirror_vm ~copy_vm ~url ~dest ~verify_dest = SXM.info @@ -586,7 +650,7 @@ module MigrateLocal = struct in inner () ) ; - on_fail := (fun () -> Local.DATA.MIRROR.stop dbg mirror_id) :: !on_fail ; + on_fail := (fun () -> stop ~dbg ~id:mirror_id) :: !on_fail ; (* Copy the snapshot to the remote *) let new_parent = Storage_task.with_subtask task "copy" (fun () -> @@ -615,62 +679,6 @@ module MigrateLocal = struct perform_cleanup_actions !on_fail ; raise e - let stop ~dbg ~id = - (* Find the local VDI *) - let alm = State.find_active_local_mirror id in - match alm with - | Some alm -> - ( match alm.State.Send_state.remote_info with - | Some remote_info -> ( - let sr, vdi = State.of_mirror_id id in - let vdis = Local.SR.scan dbg sr in - let local_vdi = - try List.find (fun x -> x.vdi = vdi) vdis - with Not_found -> - failwith - (Printf.sprintf "Local VDI %s not found" - (Storage_interface.Vdi.string_of vdi) - ) - in - let local_vdi = add_to_sm_config local_vdi "mirror" "null" in - let local_vdi = remove_from_sm_config local_vdi "base_mirror" in - (* Disable mirroring on the local machine *) - let snapshot = Local.VDI.snapshot dbg sr local_vdi in - Local.VDI.destroy dbg sr snapshot.vdi ; - (* Destroy the snapshot, if it still exists *) - let snap = - try - Some - (List.find - (fun x -> - List.mem_assoc "base_mirror" x.sm_config - && List.assoc "base_mirror" x.sm_config = id - ) - vdis - ) - with _ -> None - in - ( match snap with - | Some s -> - debug "Found snapshot VDI: %s" - (Storage_interface.Vdi.string_of s.vdi) ; - Local.VDI.destroy dbg sr s.vdi - | None -> - debug "Snapshot VDI already cleaned up" - ) ; - - let (module Remote) = - get_remote_backend remote_info.url remote_info.verify_dest - in - try Remote.DATA.MIRROR.receive_cancel dbg id with _ -> () - ) - | None -> - () - ) ; - State.remove_local_mirror id - | None -> - raise (Storage_interface.Storage_error (Does_not_exist ("mirror", id))) - let stat ~dbg:_ ~id = let recv_opt = State.find_active_receive_mirror id in let send_opt = State.find_active_local_mirror id in @@ -1061,6 +1069,9 @@ let nbd_proxy req s vm sr vdi dp = ) (fun () -> Unix.close control_fd) +let with_dbg ~name ~dbg f = + Debug_info.with_dbg ~with_thread:true ~module_name:__MODULE__ ~name ~dbg f + let with_task_and_thread ~dbg f = let task = Storage_task.add tasks dbg.Debug_info.log (fun task -> @@ -1097,6 +1108,7 @@ let copy ~dbg ~sr ~vdi ~vm ~url ~dest ~verify_dest = ) let start ~dbg ~sr ~vdi ~dp ~mirror_vm ~copy_vm ~url ~dest ~verify_dest = + with_dbg ~name:__FUNCTION__ ~dbg @@ fun dbg -> with_task_and_thread ~dbg (fun task -> MigrateLocal.start ~task ~dbg:dbg.Debug_info.log ~sr ~vdi ~dp ~mirror_vm ~copy_vm ~url ~dest ~verify_dest diff --git a/ocaml/xapi/storage_mux.ml b/ocaml/xapi/storage_mux.ml index 2c6884d48b5..0a90d55e05f 100644 --- a/ocaml/xapi/storage_mux.ml +++ b/ocaml/xapi/storage_mux.ml @@ -760,32 +760,6 @@ module Mux = struct module MIRROR = struct type context = unit - let start () ~dbg ~sr ~vdi ~dp ~mirror_vm ~copy_vm ~url ~dest ~verify_dest - = - with_dbg ~name:"DATA.MIRROR.start" ~dbg @@ fun di -> - info - "%s dbg:%s sr: %s vdi: %s dp:%s mirror_vm: %s copy_vm: %s url: %s \ - dest sr: %s verify_dest: %B" - __FUNCTION__ dbg (s_of_sr sr) (s_of_vdi vdi) dp (s_of_vm mirror_vm) - (s_of_vm copy_vm) url (s_of_sr dest) verify_dest ; - Storage_migrate.start ~dbg:di ~sr ~vdi ~dp ~mirror_vm ~copy_vm ~url - ~dest ~verify_dest - - let stop () ~dbg ~id = - with_dbg ~name:"DATA.MIRROR.stop" ~dbg @@ fun di -> - info "%s dbg:%s mirror_id: %s" __FUNCTION__ dbg id ; - Storage_migrate.stop ~dbg:di.log ~id - - let list () ~dbg = - with_dbg ~name:"DATA.MIRROR.list" ~dbg @@ fun di -> - info "%s dbg: %s" __FUNCTION__ dbg ; - Storage_migrate.list ~dbg:di.log - - let stat () ~dbg ~id = - with_dbg ~name:"DATA.MIRROR.stat" ~dbg @@ fun di -> - info "%s dbg: %s mirror_id: %s" __FUNCTION__ di.log id ; - Storage_migrate.stat ~dbg:di.log ~id - let receive_start () ~dbg ~sr ~vdi_info ~id ~similar = with_dbg ~name:"DATA.MIRROR.receive_start" ~dbg @@ fun di -> info "%s dbg: %s sr: %s vdi_info: %s mirror_id: %s similar: %s" diff --git a/ocaml/xapi/storage_smapiv1.ml b/ocaml/xapi/storage_smapiv1.ml index d459c0ee2b0..a1beed1afe8 100644 --- a/ocaml/xapi/storage_smapiv1.ml +++ b/ocaml/xapi/storage_smapiv1.ml @@ -1219,16 +1219,6 @@ module SMAPIv1 : Server_impl = struct module MIRROR = struct type context = unit - let start _context ~dbg:_ ~sr:_ ~vdi:_ ~dp:_ ~mirror_vm:_ ~copy_vm:_ - ~url:_ ~dest:_ ~verify_dest:_ = - assert false - - let stop _context ~dbg:_ ~id:_ = assert false - - let list _context ~dbg:_ = assert false - - let stat _context ~dbg:_ ~id:_ = assert false - let receive_start _context ~dbg:_ ~sr:_ ~vdi_info:_ ~id:_ ~similar:_ = assert false diff --git a/ocaml/xapi/storage_smapiv1_wrapper.ml b/ocaml/xapi/storage_smapiv1_wrapper.ml index 7672a4b61e6..dd8aad1d13f 100644 --- a/ocaml/xapi/storage_smapiv1_wrapper.ml +++ b/ocaml/xapi/storage_smapiv1_wrapper.ml @@ -1186,24 +1186,6 @@ functor module MIRROR = struct type context = unit - let start context ~dbg ~sr ~vdi ~dp ~mirror_vm ~copy_vm ~url ~dest = - info "DATA.MIRROR.start dbg:%s sr:%s vdi:%s url:%s dest:%s" dbg - (s_of_sr sr) (s_of_vdi vdi) url (s_of_sr dest) ; - Impl.DATA.MIRROR.start context ~dbg ~sr ~vdi ~dp ~mirror_vm ~copy_vm - ~url ~dest - - let stop context ~dbg ~id = - info "DATA.MIRROR.stop dbg:%s id:%s" dbg id ; - Impl.DATA.MIRROR.stop context ~dbg ~id - - let list context ~dbg = - info "DATA.MIRROR.active dbg:%s" dbg ; - Impl.DATA.MIRROR.list context ~dbg - - let stat context ~dbg ~id = - info "DATA.MIRROR.stat dbg:%s id:%s" dbg id ; - Impl.DATA.MIRROR.stat context ~dbg ~id - let receive_start context ~dbg ~sr ~vdi_info ~id ~similar = info "DATA.MIRROR.receive_start dbg:%s sr:%s id:%s similar:[%s]" dbg (s_of_sr sr) id diff --git a/ocaml/xapi/xapi_vm_migrate.ml b/ocaml/xapi/xapi_vm_migrate.ml index b09adef7f9d..1d4e7377b66 100644 --- a/ocaml/xapi/xapi_vm_migrate.ml +++ b/ocaml/xapi/xapi_vm_migrate.ml @@ -1035,8 +1035,9 @@ let vdi_copy_fun __context dbg vdi_map remote is_intra_pool remote_vdis so_far (Vm.string_of vconf.copy_vm) ; (* Layering violation!! *) ignore (Storage_access.register_mirror __context id) ; - SMAPI.DATA.MIRROR.start dbg vconf.sr vconf.location new_dp - vconf.mirror_vm vconf.copy_vm remote.sm_url dest_sr is_intra_pool + Storage_migrate.start ~dbg ~sr:vconf.sr ~vdi:vconf.location ~dp:new_dp + ~mirror_vm:vconf.mirror_vm ~copy_vm:vconf.copy_vm ~url:remote.sm_url + ~dest:dest_sr ~verify_dest:is_intra_pool in let mapfn x = let total = Int64.to_float total_size in @@ -1061,7 +1062,7 @@ let vdi_copy_fun __context dbg vdi_map remote is_intra_pool remote_vdis so_far (None, vdi.vdi) ) else let mirrorid = task_result |> mirror_of_task dbg in - let m = SMAPI.DATA.MIRROR.stat dbg mirrorid in + let m = Storage_migrate.stat ~dbg ~id:mirrorid in (Some mirrorid, m.Mirror.dest_vdi) in so_far := Int64.add !so_far vconf.size ; @@ -1090,8 +1091,8 @@ let vdi_copy_fun __context dbg vdi_map remote is_intra_pool remote_vdis so_far match mirror_id with | Some mid -> ignore (Storage_access.unregister_mirror mid) ; - let m = SMAPI.DATA.MIRROR.stat dbg mid in - (try SMAPI.DATA.MIRROR.stop dbg mid with _ -> ()) ; + let m = Storage_migrate.stat ~dbg ~id:mid in + (try Storage_migrate.stop ~dbg ~id:mid with _ -> ()) ; m.Mirror.failed | None -> false From 63d7ee3a75c61021e874c103da37c3e57ded5987 Mon Sep 17 00:00:00 2001 From: Vincent Liu Date: Tue, 25 Mar 2025 16:52:03 +0000 Subject: [PATCH 3/6] CP-54072: Define new `MIRROR.send_start` function The `send_start` function is a subroutine inside the `Storage_migrate.start` function, which takes the mirror prepared by the `receive_start` and initiates mirroring to the remote VDI. This commit only defines the interface, which means this function is currently unused. Signed-off-by: Vincent Liu --- ocaml/xapi-idl/storage/storage_interface.ml | 74 +++++++++++++++++++++ ocaml/xapi-idl/storage/storage_skeleton.ml | 4 ++ ocaml/xapi-storage-script/main.ml | 1 + ocaml/xapi/storage_mux.ml | 7 ++ ocaml/xapi/storage_smapiv1.ml | 5 ++ ocaml/xapi/storage_smapiv1_wrapper.ml | 8 +++ 6 files changed, 99 insertions(+) diff --git a/ocaml/xapi-idl/storage/storage_interface.ml b/ocaml/xapi-idl/storage/storage_interface.ml index d3e1448aba8..311c9f2dfdf 100644 --- a/ocaml/xapi-idl/storage/storage_interface.ml +++ b/ocaml/xapi-idl/storage/storage_interface.ml @@ -1027,8 +1027,43 @@ module StorageAPI (R : RPC) = struct ) module MIRROR = struct + let mirror_vm_p = Param.mk ~name:"mirror_vm" Vm.t + + let copy_vm_p = Param.mk ~name:"copy_vm" Vm.t + + let live_vm_p = Param.mk ~name:"live_vm" Vm.t + let id_p = Param.mk ~name:"id" Mirror.id + (** [send_start dbg dp task src_sr vdi mirror_vm mirror_id local_vdi copy_vm + live_vm url remote_mirror dest_sr verify_dest] + takes the remote mirror [remote_mirror] prepared by the destination host + and initiates the mirroring of [vdi] from the source *) + let send_start = + let recv_result_p = + Param.mk ~name:"recv_result" Mirror.mirror_receive_result + in + let local_vdi_p = Param.mk ~name:"local_vdi" vdi_info in + let src_sr_p = Param.mk ~name:"src_sr" Sr.t in + let dest_sr_p = Param.mk ~name:"dest_sr" Sr.t in + declare "DATA.MIRROR.send_start" [] + (dbg_p + @-> dp_p + @-> task_id_p + @-> src_sr_p + @-> vdi_p + @-> mirror_vm_p + @-> id_p + @-> local_vdi_p + @-> copy_vm_p + @-> live_vm_p + @-> url_p + @-> recv_result_p + @-> dest_sr_p + @-> verify_dest_p + @-> returning unit_p err + ) + (** Called on the receiving end @deprecated This function is deprecated, and is only here to keep backward compatibility with old xapis that call Remote.DATA.MIRROR.receive_start during SXM. @@ -1130,6 +1165,24 @@ end module type MIRROR = sig type context = unit + val send_start : + context + -> dbg:debug_info + -> task_id:Task.id + -> dp:dp + -> sr:sr + -> vdi:vdi + -> mirror_vm:vm + -> mirror_id:Mirror.id + -> local_vdi:vdi_info + -> copy_vm:vm + -> live_vm:vm + -> url:string + -> remote_mirror:Mirror.mirror_receive_result + -> dest_sr:sr + -> verify_dest:bool + -> unit + val receive_start : context -> dbg:debug_info @@ -1586,6 +1639,27 @@ module Server (Impl : Server_impl) () = struct S.DATA.copy (fun dbg sr vdi vm url dest verify_dest -> Impl.DATA.copy () ~dbg ~sr ~vdi ~vm ~url ~dest ~verify_dest ) ; + S.DATA.MIRROR.send_start + (fun + dbg + task_id + dp + sr + vdi + mirror_vm + mirror_id + local_vdi + copy_vm + live_vm + url + remote_mirror + dest_sr + verify_dest + -> + Impl.DATA.MIRROR.send_start () ~dbg ~task_id ~dp ~sr ~vdi ~mirror_vm + ~mirror_id ~local_vdi ~copy_vm ~live_vm ~url ~remote_mirror ~dest_sr + ~verify_dest + ) ; S.DATA.MIRROR.receive_start (fun dbg sr vdi_info id similar -> Impl.DATA.MIRROR.receive_start () ~dbg ~sr ~vdi_info ~id ~similar ) ; diff --git a/ocaml/xapi-idl/storage/storage_skeleton.ml b/ocaml/xapi-idl/storage/storage_skeleton.ml index 04a4bb1e85e..27197b06c7c 100644 --- a/ocaml/xapi-idl/storage/storage_skeleton.ml +++ b/ocaml/xapi-idl/storage/storage_skeleton.ml @@ -162,6 +162,10 @@ module DATA = struct module MIRROR = struct type context = unit + let send_start ctx ~dbg ~task_id ~dp ~sr ~vdi ~mirror_vm ~mirror_id + ~local_vdi ~copy_vm ~live_vm ~url ~remote_mirror ~dest_sr ~verify_dest = + u "DATA.MIRROR.send_start" + let receive_start ctx ~dbg ~sr ~vdi_info ~id ~similar = u "DATA.MIRROR.receive_start" diff --git a/ocaml/xapi-storage-script/main.ml b/ocaml/xapi-storage-script/main.ml index 29c321836c6..eb63f132e98 100644 --- a/ocaml/xapi-storage-script/main.ml +++ b/ocaml/xapi-storage-script/main.ml @@ -1920,6 +1920,7 @@ let bind ~volume_script_dir = S.VDI.similar_content (u "VDI.similar_content") ; S.DATA.copy (u "DATA.copy") ; S.DP.stat_vdi (u "DP.stat_vdi") ; + S.DATA.MIRROR.send_start (u "DATA.MIRROR.send_start") ; S.DATA.MIRROR.receive_start (u "DATA.MIRROR.receive_start") ; S.DATA.MIRROR.receive_start2 (u "DATA.MIRROR.receive_start2") ; S.DATA.MIRROR.receive_finalize (u "DATA.MIRROR.receive_finalize") ; diff --git a/ocaml/xapi/storage_mux.ml b/ocaml/xapi/storage_mux.ml index 0a90d55e05f..6614177e3e3 100644 --- a/ocaml/xapi/storage_mux.ml +++ b/ocaml/xapi/storage_mux.ml @@ -760,6 +760,13 @@ module Mux = struct module MIRROR = struct type context = unit + let u x = raise Storage_interface.(Storage_error (Errors.Unimplemented x)) + + let send_start _ctx ~dbg:_ ~task_id:_ ~dp:_ ~sr:_ ~vdi:_ ~mirror_vm:_ + ~mirror_id:_ ~local_vdi:_ ~copy_vm:_ ~live_vm:_ ~url:_ + ~remote_mirror:_ ~dest_sr:_ ~verify_dest:_ = + u "DATA.MIRROR.send_start" (* see storage_smapi{v1,v3}_migrate.ml *) + let receive_start () ~dbg ~sr ~vdi_info ~id ~similar = with_dbg ~name:"DATA.MIRROR.receive_start" ~dbg @@ fun di -> info "%s dbg: %s sr: %s vdi_info: %s mirror_id: %s similar: %s" diff --git a/ocaml/xapi/storage_smapiv1.ml b/ocaml/xapi/storage_smapiv1.ml index a1beed1afe8..1616d1a65f9 100644 --- a/ocaml/xapi/storage_smapiv1.ml +++ b/ocaml/xapi/storage_smapiv1.ml @@ -1219,6 +1219,11 @@ module SMAPIv1 : Server_impl = struct module MIRROR = struct type context = unit + let send_start _ctx ~dbg:_ ~task_id:_ ~dp:_ ~sr:_ ~vdi:_ ~mirror_vm:_ + ~mirror_id:_ ~local_vdi:_ ~copy_vm:_ ~live_vm:_ ~url:_ + ~remote_mirror:_ ~dest_sr:_ ~verify_dest:_ = + assert false + let receive_start _context ~dbg:_ ~sr:_ ~vdi_info:_ ~id:_ ~similar:_ = assert false diff --git a/ocaml/xapi/storage_smapiv1_wrapper.ml b/ocaml/xapi/storage_smapiv1_wrapper.ml index dd8aad1d13f..8a9b053f509 100644 --- a/ocaml/xapi/storage_smapiv1_wrapper.ml +++ b/ocaml/xapi/storage_smapiv1_wrapper.ml @@ -1186,6 +1186,14 @@ functor module MIRROR = struct type context = unit + let u x = + raise Storage_interface.(Storage_error (Errors.Unimplemented x)) + + let send_start _ctx ~dbg:_ ~task_id:_ ~dp:_ ~sr:_ ~vdi:_ ~mirror_vm:_ + ~mirror_id:_ ~local_vdi:_ ~copy_vm:_ ~live_vm:_ ~url:_ + ~remote_mirror:_ ~dest_sr:_ ~verify_dest:_ = + u "DATA.MIRROR.send_start" + let receive_start context ~dbg ~sr ~vdi_info ~id ~similar = info "DATA.MIRROR.receive_start dbg:%s sr:%s id:%s similar:[%s]" dbg (s_of_sr sr) id From 36d41aa24e582fece281b076b8b2bca807bd6e37 Mon Sep 17 00:00:00 2001 From: Vincent Liu Date: Tue, 25 Mar 2025 17:35:59 +0000 Subject: [PATCH 4/6] CP-54072: Create template for storage_smapi{v1,v3}_migrate Just so that they type check, some of the functions are still unimplemented, and these functions are still unused. Signed-off-by: Vincent Liu --- ocaml/xapi/storage_smapiv1_migrate.ml | 177 +++++++++++++++++++++++++ ocaml/xapi/storage_smapiv1_migrate.mli | 17 +++ ocaml/xapi/storage_smapiv3_migrate.ml | 39 ++++++ ocaml/xapi/storage_smapiv3_migrate.mli | 17 +++ 4 files changed, 250 insertions(+) create mode 100644 ocaml/xapi/storage_smapiv1_migrate.ml create mode 100644 ocaml/xapi/storage_smapiv1_migrate.mli create mode 100644 ocaml/xapi/storage_smapiv3_migrate.ml create mode 100644 ocaml/xapi/storage_smapiv3_migrate.mli diff --git a/ocaml/xapi/storage_smapiv1_migrate.ml b/ocaml/xapi/storage_smapiv1_migrate.ml new file mode 100644 index 00000000000..83dd41d4972 --- /dev/null +++ b/ocaml/xapi/storage_smapiv1_migrate.ml @@ -0,0 +1,177 @@ +(* + * Copyright (c) Cloud Software Group + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published + * by the Free Software Foundation; version 2.1 only. with the special + * exception on linking described in file LICENSE. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + *) + +module D = Debug.Make (struct let name = "storage_smapiv1_migrate" end) + +module Unixext = Xapi_stdext_unix.Unixext +open Storage_interface +open Storage_migrate_helper +module State = Storage_migrate_helper.State +module SXM = Storage_migrate_helper.SXM + +module type SMAPIv2_MIRROR = Storage_interface.MIRROR + +module MIRROR : SMAPIv2_MIRROR = struct + type context = unit + + let u x = raise Storage_interface.(Storage_error (Errors.Unimplemented x)) + + let send_start _ctx = u __FUNCTION__ + + let receive_start_common ~dbg ~sr ~vdi_info ~id ~similar ~vm = + let on_fail : (unit -> unit) list ref = ref [] in + let vdis = Local.SR.scan dbg sr in + (* We drop cbt_metadata VDIs that do not have any actual data *) + let vdis = List.filter (fun vdi -> vdi.ty <> "cbt_metadata") vdis in + let leaf_dp = Local.DP.create dbg Uuidx.(to_string (make ())) in + try + let vdi_info = {vdi_info with sm_config= [("base_mirror", id)]} in + let leaf = Local.VDI.create dbg sr vdi_info in + D.info "Created leaf VDI for mirror receive: %s" (string_of_vdi_info leaf) ; + on_fail := (fun () -> Local.VDI.destroy dbg sr leaf.vdi) :: !on_fail ; + (* dummy VDI is created so that the leaf VDI becomes a differencing disk, + useful for calling VDI.compose later on *) + let dummy = Local.VDI.snapshot dbg sr leaf in + on_fail := (fun () -> Local.VDI.destroy dbg sr dummy.vdi) :: !on_fail ; + D.debug "%s Created dummy snapshot for mirror receive: %s" __FUNCTION__ + (string_of_vdi_info dummy) ; + let _ : backend = Local.VDI.attach3 dbg leaf_dp sr leaf.vdi vm true in + Local.VDI.activate3 dbg leaf_dp sr leaf.vdi vm ; + let nearest = + List.fold_left + (fun acc content_id -> + match acc with + | Some _ -> + acc + | None -> ( + try + Some + (List.find + (fun vdi -> + vdi.content_id = content_id + && vdi.virtual_size <= vdi_info.virtual_size + ) + vdis + ) + with Not_found -> None + ) + ) + None similar + in + D.debug "Nearest VDI: content_id=%s vdi=%s" + (Option.fold ~none:"None" ~some:(fun x -> x.content_id) nearest) + (Option.fold ~none:"None" + ~some:(fun x -> Storage_interface.Vdi.string_of x.vdi) + nearest + ) ; + let parent = + match nearest with + | Some vdi -> + D.debug "Cloning VDI" ; + let vdi = add_to_sm_config vdi "base_mirror" id in + let vdi_clone = Local.VDI.clone dbg sr vdi in + D.debug "Clone: %s" (Storage_interface.Vdi.string_of vdi_clone.vdi) ; + ( if vdi_clone.virtual_size <> vdi_info.virtual_size then + let new_size = + Local.VDI.resize dbg sr vdi_clone.vdi vdi_info.virtual_size + in + D.debug "Resize local clone VDI to %Ld: result %Ld" + vdi_info.virtual_size new_size + ) ; + vdi_clone + | None -> + D.debug "Creating a blank remote VDI" ; + Local.VDI.create dbg sr vdi_info + in + D.debug "Parent disk content_id=%s" parent.content_id ; + State.add id + State.( + Recv_op + Receive_state. + { + sr + ; dummy_vdi= dummy.vdi + ; leaf_vdi= leaf.vdi + ; leaf_dp + ; parent_vdi= parent.vdi + ; remote_vdi= vdi_info.vdi + ; mirror_vm= vm + } + ) ; + let nearest_content_id = Option.map (fun x -> x.content_id) nearest in + Mirror.Vhd_mirror + { + Mirror.mirror_vdi= leaf + ; mirror_datapath= leaf_dp + ; copy_diffs_from= nearest_content_id + ; copy_diffs_to= parent.vdi + ; dummy_vdi= dummy.vdi + } + with e -> + List.iter + (fun op -> + try op () + with e -> + D.debug "Caught exception in on_fail: %s" (Printexc.to_string e) + ) + !on_fail ; + raise e + + let receive_start _ctx ~dbg ~sr ~vdi_info ~id ~similar = + receive_start_common ~dbg ~sr ~vdi_info ~id ~similar ~vm:(Vm.of_string "0") + + let receive_start2 _ctx ~dbg ~sr ~vdi_info ~id ~similar ~vm = + receive_start_common ~dbg ~sr ~vdi_info ~id ~similar ~vm + + let receive_finalize _ctx ~dbg ~id = + let recv_state = State.find_active_receive_mirror id in + let open State.Receive_state in + Option.iter (fun r -> Local.DP.destroy dbg r.leaf_dp false) recv_state ; + State.remove_receive_mirror id + + let receive_finalize2 _ctx ~dbg ~id = + let recv_state = State.find_active_receive_mirror id in + let open State.Receive_state in + Option.iter + (fun r -> + SXM.info + "%s Mirror done. Compose on the dest sr %s parent %s and leaf %s" + __FUNCTION__ (Sr.string_of r.sr) + (Vdi.string_of r.parent_vdi) + (Vdi.string_of r.leaf_vdi) ; + Local.DP.destroy2 dbg r.leaf_dp r.sr r.leaf_vdi r.mirror_vm false ; + Local.VDI.compose dbg r.sr r.parent_vdi r.leaf_vdi ; + (* On SMAPIv3, compose would have removed the now invalid dummy vdi, so + there is no need to destroy it anymore, while this is necessary on SMAPIv1 SRs. *) + D.log_and_ignore_exn (fun () -> Local.VDI.destroy dbg r.sr r.dummy_vdi) ; + Local.VDI.remove_from_sm_config dbg r.sr r.leaf_vdi "base_mirror" + ) + recv_state ; + State.remove_receive_mirror id + + let receive_cancel _ctx ~dbg ~id = + let receive_state = State.find_active_receive_mirror id in + let open State.Receive_state in + Option.iter + (fun r -> + D.log_and_ignore_exn (fun () -> Local.DP.destroy dbg r.leaf_dp false) ; + List.iter + (fun v -> + D.log_and_ignore_exn (fun () -> Local.VDI.destroy dbg r.sr v) + ) + [r.dummy_vdi; r.leaf_vdi; r.parent_vdi] + ) + receive_state ; + State.remove_receive_mirror id +end diff --git a/ocaml/xapi/storage_smapiv1_migrate.mli b/ocaml/xapi/storage_smapiv1_migrate.mli new file mode 100644 index 00000000000..d47b82cd86c --- /dev/null +++ b/ocaml/xapi/storage_smapiv1_migrate.mli @@ -0,0 +1,17 @@ +(* + * Copyright (c) Cloud Software Group + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published + * by the Free Software Foundation; version 2.1 only. with the special + * exception on linking described in file LICENSE. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + *) + +module type SMAPIv2_MIRROR = Storage_interface.MIRROR + +module MIRROR : SMAPIv2_MIRROR diff --git a/ocaml/xapi/storage_smapiv3_migrate.ml b/ocaml/xapi/storage_smapiv3_migrate.ml new file mode 100644 index 00000000000..4cfcf1c831e --- /dev/null +++ b/ocaml/xapi/storage_smapiv3_migrate.ml @@ -0,0 +1,39 @@ +(* + * Copyright (c) Cloud Software Group + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published + * by the Free Software Foundation; version 2.1 only. with the special + * exception on linking described in file LICENSE. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + *) + +module D = Debug.Make (struct let name = "storage_smapiv1_migrate" end) + +module Unixext = Xapi_stdext_unix.Unixext +module State = Storage_migrate_helper.State +module SXM = Storage_migrate_helper.SXM + +module type SMAPIv2_MIRROR = Storage_interface.MIRROR + +module MIRROR : SMAPIv2_MIRROR = struct + type context = unit + + let u x = raise Storage_interface.(Storage_error (Errors.Unimplemented x)) + + let send_start _ctx = u __FUNCTION__ + + let receive_start _ctx = u __FUNCTION__ + + let receive_start2 _ctx = u __FUNCTION__ + + let receive_finalize _ctx = u __FUNCTION__ + + let receive_finalize2 _ctx = u __FUNCTION__ + + let receive_cancel _ctx = u __FUNCTION__ +end diff --git a/ocaml/xapi/storage_smapiv3_migrate.mli b/ocaml/xapi/storage_smapiv3_migrate.mli new file mode 100644 index 00000000000..d47b82cd86c --- /dev/null +++ b/ocaml/xapi/storage_smapiv3_migrate.mli @@ -0,0 +1,17 @@ +(* + * Copyright (c) Cloud Software Group + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published + * by the Free Software Foundation; version 2.1 only. with the special + * exception on linking described in file LICENSE. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + *) + +module type SMAPIv2_MIRROR = Storage_interface.MIRROR + +module MIRROR : SMAPIv2_MIRROR From 7f96646d118bd3d4f98fdf01cf80a69af8d918df Mon Sep 17 00:00:00 2001 From: Vincent Liu Date: Fri, 4 Apr 2025 11:04:43 +0100 Subject: [PATCH 5/6] style: List.find/List.find_opt/s Signed-off-by: Vincent Liu --- ocaml/xapi/storage_migrate.ml | 28 ++++++++++++--------------- ocaml/xapi/storage_migrate_helper.ml | 4 ++-- ocaml/xapi/storage_migrate_helper.mli | 2 ++ 3 files changed, 16 insertions(+), 18 deletions(-) diff --git a/ocaml/xapi/storage_migrate.ml b/ocaml/xapi/storage_migrate.ml index 023a984256e..e9fa4f18481 100644 --- a/ocaml/xapi/storage_migrate.ml +++ b/ocaml/xapi/storage_migrate.ml @@ -411,12 +411,12 @@ module MigrateLocal = struct let sr, vdi = State.of_mirror_id id in let vdis = Local.SR.scan dbg sr in let local_vdi = - try List.find (fun x -> x.vdi = vdi) vdis - with Not_found -> - failwith - (Printf.sprintf "Local VDI %s not found" - (Storage_interface.Vdi.string_of vdi) - ) + match List.find_opt (fun x -> x.vdi = vdi) vdis with + | None -> + failwith_fmt "Local VDI %s not found" + (Storage_interface.Vdi.string_of vdi) + | Some v -> + v in let local_vdi = add_to_sm_config local_vdi "mirror" "null" in let local_vdi = remove_from_sm_config local_vdi "base_mirror" in @@ -425,16 +425,12 @@ module MigrateLocal = struct Local.VDI.destroy dbg sr snapshot.vdi ; (* Destroy the snapshot, if it still exists *) let snap = - try - Some - (List.find - (fun x -> - List.mem_assoc "base_mirror" x.sm_config - && List.assoc "base_mirror" x.sm_config = id - ) - vdis - ) - with _ -> None + List.find_opt + (fun x -> + List.mem_assoc "base_mirror" x.sm_config + && List.assoc "base_mirror" x.sm_config = id + ) + vdis in ( match snap with | Some s -> diff --git a/ocaml/xapi/storage_migrate_helper.ml b/ocaml/xapi/storage_migrate_helper.ml index b7b1eb6c6f9..e924c208d8f 100644 --- a/ocaml/xapi/storage_migrate_helper.ml +++ b/ocaml/xapi/storage_migrate_helper.ml @@ -24,9 +24,9 @@ open Storage_interface open Xapi_stdext_pervasives.Pervasiveext open Xmlrpc_client -module State = struct - let failwith_fmt fmt = Printf.ksprintf failwith fmt +let failwith_fmt fmt = Printf.ksprintf failwith fmt +module State = struct module Receive_state = struct type t = { sr: Sr.t diff --git a/ocaml/xapi/storage_migrate_helper.mli b/ocaml/xapi/storage_migrate_helper.mli index 29753436c78..8ac0da552e2 100644 --- a/ocaml/xapi/storage_migrate_helper.mli +++ b/ocaml/xapi/storage_migrate_helper.mli @@ -14,6 +14,8 @@ module SXM : Debug.DEBUG +val failwith_fmt : ('a, unit, string, 'b) format4 -> 'a + module State : sig module Receive_state : sig type t = { From 24905957c1aadf337a75db31be34688b4dc66a7c Mon Sep 17 00:00:00 2001 From: Vincent Liu Date: Wed, 9 Apr 2025 17:15:44 +0100 Subject: [PATCH 6/6] style: Use List.assoc_opt Signed-off-by: Vincent Liu --- ocaml/xapi/storage_migrate.ml | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/ocaml/xapi/storage_migrate.ml b/ocaml/xapi/storage_migrate.ml index e9fa4f18481..2a35eae710c 100644 --- a/ocaml/xapi/storage_migrate.ml +++ b/ocaml/xapi/storage_migrate.ml @@ -426,10 +426,7 @@ module MigrateLocal = struct (* Destroy the snapshot, if it still exists *) let snap = List.find_opt - (fun x -> - List.mem_assoc "base_mirror" x.sm_config - && List.assoc "base_mirror" x.sm_config = id - ) + (fun x -> List.assoc_opt "base_mirror" x.sm_config = Some id) vdis in ( match snap with