From 5abccbfdd207536703fc0d35425a138f8e66445b Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Thu, 28 Mar 2024 13:02:32 +0000 Subject: [PATCH] CA-390277: Stop using records on CLI cross-pool migrations Using records in cross-pool migration code is dangerous, as the code interacts with potentially newer hosts. This means that fields in the record might be different from what's expected. In particular adding an enum field can break the deserialization, and removing a field as well. The tradeoff here is that there are more remote roundtrips to get the data needed. Signed-off-by: Pau Ruiz Safont --- ocaml/xapi-cli-server/cli_operations.ml | 208 ++++++++++++++++-------- 1 file changed, 139 insertions(+), 69 deletions(-) diff --git a/ocaml/xapi-cli-server/cli_operations.ml b/ocaml/xapi-cli-server/cli_operations.ml index d698e847d67..318e0f470fd 100644 --- a/ocaml/xapi-cli-server/cli_operations.ml +++ b/ocaml/xapi-cli-server/cli_operations.ml @@ -4312,54 +4312,98 @@ let vm_migrate printer rpc session_id params = in finally (fun () -> - let host, host_record = - let all = Client.Host.get_all_records remote_rpc remote_session in - if List.mem_assoc "host" params then - let x = List.assoc "host" params in - try - List.find - (fun (_, h) -> - h.API.host_hostname = x - || h.API.host_name_label = x - || h.API.host_uuid = x + let host = + let host_matches x self = + let hostname () = + Client.Host.get_hostname ~rpc:remote_rpc + ~session_id:remote_session ~self + in + let uuid () = + Client.Host.get_uuid ~rpc:remote_rpc ~session_id:remote_session + ~self + in + let name_label () = + Client.Host.get_name_label ~rpc:remote_rpc + ~session_id:remote_session ~self + in + hostname () = x || uuid () = x || name_label () = x + in + let matches, fail_msg = + match List.assoc_opt "host" params with + | Some x -> + (host_matches x, Printf.sprintf "Failed to find host: %s" x) + | None -> + ( (fun _ -> true) + , Printf.sprintf "Failed to find a suitable host" ) - all - with Not_found -> - failwith (Printf.sprintf "Failed to find host: %s" x) - else - List.hd all + in + let all_hosts = + Client.Host.get_all ~rpc:remote_rpc ~session_id:remote_session + in + match List.filter matches all_hosts with + | host :: _ -> + host + | [] -> + failwith fail_msg in - let network, network_record = - let all = Client.Network.get_all_records remote_rpc remote_session in - if List.mem_assoc "remote-network" params then - let x = List.assoc "remote-network" params in - try - List.find - (fun (_, net) -> - net.API.network_bridge = x - || net.API.network_name_label = x - || net.API.network_uuid = x - ) - all - with Not_found -> - failwith (Printf.sprintf "Failed to find network: %s" x) - else - let pifs = host_record.API.host_PIFs in - let management_pifs = - List.filter - (fun pif -> - Client.PIF.get_management remote_rpc remote_session pif - ) - pifs + let network = + let network_matches x self = + let bridge () = + Client.Network.get_bridge ~rpc:remote_rpc + ~session_id:remote_session ~self in - if List.length management_pifs = 0 then - failwith - (Printf.sprintf "Could not find management PIF on host %s" - host_record.API.host_uuid - ) ; - let pif = List.hd management_pifs in - let net = Client.PIF.get_network remote_rpc remote_session pif in - (net, Client.Network.get_record remote_rpc remote_session net) + let uuid () = + Client.Network.get_uuid ~rpc:remote_rpc ~session_id:remote_session + ~self + in + let name_label () = + Client.Network.get_name_label ~rpc:remote_rpc + ~session_id:remote_session ~self + in + bridge () = x || uuid () = x || name_label () = x + in + match List.assoc_opt "remote-network" params with + | Some x -> ( + let all_networks = + Client.Network.get_all ~rpc:remote_rpc + ~session_id:remote_session + in + match List.filter (network_matches x) all_networks with + | network :: _ -> + network + | [] -> + failwith (Printf.sprintf "Failed to find network: %s" x) + ) + | None -> ( + let pifs = + Client.Host.get_PIFs ~rpc:remote_rpc ~session_id:remote_session + ~self:host + in + let management_pifs = + List.filter + (fun self -> + Client.PIF.get_management ~rpc:remote_rpc + ~session_id:remote_session ~self + ) + pifs + in + match management_pifs with + | [] -> + let host_uuid = + Client.Host.get_uuid ~rpc:remote_rpc + ~session_id:remote_session ~self:host + in + failwith + (Printf.sprintf "Could not find management PIF on host %s" + host_uuid + ) + | pif :: _ -> + let net = + Client.PIF.get_network ~rpc:remote_rpc + ~session_id:remote_session ~self:pif + in + net + ) in let vif_map = List.map @@ -4400,43 +4444,62 @@ let vm_migrate printer rpc session_id params = and among the choices of that the shared is preferred first(as it is recommended to have shared storage in pool to host VMs), and then the one with the maximum available space *) try - let query = - Printf.sprintf - {|(field "host"="%s") and (field "currently_attached"="true")|} - (Ref.string_of host) - in - let host_pbds = - Client.PBD.get_all_records_where remote_rpc remote_session query + let pbd_in_host self = + let host_of () = + Client.PBD.get_host ~rpc:remote_rpc ~session_id:remote_session + ~self + in + let attached () = + Client.PBD.get_currently_attached ~rpc:remote_rpc + ~session_id:remote_session ~self + in + host_of () = host && attached () in let srs = - List.map - (fun (pbd_ref, pbd_rec) -> - ( pbd_rec.API.pBD_SR - , Client.SR.get_record remote_rpc remote_session - pbd_rec.API.pBD_SR - ) - ) - host_pbds + Client.PBD.get_all ~rpc:remote_rpc ~session_id:remote_session + |> List.filter pbd_in_host + |> List.map (fun self -> + Client.PBD.get_SR ~rpc:remote_rpc + ~session_id:remote_session ~self + ) in (* In the following loop, the current SR:sr' will be compared with previous checked ones, first if it is an ISO type, then pass this one for selection, then the only shared one from this and previous one will be valued, and if not that case (both shared or none shared), choose the one with more space available *) + let is_iso self = + let typ = + Client.SR.get_content_type ~rpc:remote_rpc + ~session_id:remote_session ~self + in + typ = "iso" + in + let physical_size self = + Client.SR.get_physical_size ~rpc:remote_rpc + ~session_id:remote_session ~self + in + let physical_utilisation self = + Client.SR.get_physical_utilisation ~rpc:remote_rpc + ~session_id:remote_session ~self + in + let shared self = + Client.SR.get_shared ~rpc:remote_rpc ~session_id:remote_session + ~self + in let sr, _ = List.fold_left - (fun (sr, free_space) ((_, sr_rec') as sr') -> - if sr_rec'.API.sR_content_type = "iso" then + (fun (sr, free_space) sr' -> + if is_iso sr' then (sr, free_space) else let free_space' = - Int64.sub sr_rec'.API.sR_physical_size - sr_rec'.API.sR_physical_utilisation + Int64.sub (physical_size sr') (physical_utilisation sr') in match sr with | None -> (Some sr', free_space') - | Some ((_, sr_rec) as sr) -> ( - match (sr_rec.API.sR_shared, sr_rec'.API.sR_shared) with + | Some sr -> ( + match (shared sr, shared sr') with | true, false -> (Some sr, free_space) | false, true -> @@ -4450,7 +4513,7 @@ let vm_migrate printer rpc session_id params = ) (None, Int64.zero) srs in - match sr with Some (sr_ref, _) -> Some sr_ref | _ -> None + sr with _ -> None in let vdi_map = @@ -4509,13 +4572,20 @@ let vm_migrate printer rpc session_id params = ) params in + let host_name_label = + Client.Host.get_name_label ~rpc:remote_rpc ~session_id:remote_session + ~self:host + in + let network_name_label = + Client.Network.get_name_label ~rpc:remote_rpc + ~session_id:remote_session ~self:network + in printer (Cli_printer.PMsg (Printf.sprintf "Will migrate to remote host: %s, using remote network: %s. \ Here is the VDI mapping:" - host_record.API.host_name_label - network_record.API.network_name_label + host_name_label network_name_label ) ) ; List.iter