Skip to content

CA-390277: Reduce record usage on CLI cross-pool migrations #5773

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 4 commits into from
Jul 16, 2024
Merged

CA-390277: Reduce record usage on CLI cross-pool migrations #5773

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
8689af4
gen_empty_custom: avoid wildcards for actions
psafont Mar 28, 2024
c6984ad
CA-390277: Add API to fetch references matching a query
psafont Mar 28, 2024
caadaf2
xapi-cli-server: use helper remote in migrate function
psafont Jul 3, 2024
ba47a87
CA-390277: Reduce record usage on CLI cross-pool migrations
psafont Mar 28, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions ocaml/idl/datamodel_types.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -586,6 +586,7 @@ and obj_op =
| GetByLabel
| GetRecord
| GetAll
| GetAllWhere
| GetAllRecordsWhere
| GetAllRecords
| Private of private_op
Expand Down
1 change: 1 addition & 0 deletions ocaml/idl/datamodel_types.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -210,6 +210,7 @@ and obj_op =
| GetByLabel
| GetRecord
| GetAll
| GetAllWhere
| GetAllRecordsWhere
| GetAllRecords
| Private of private_op
Expand Down
32 changes: 31 additions & 1 deletion ocaml/idl/datamodel_utils.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -683,6 +683,36 @@ let messages_of_obj (x : obj) document_order : message list =
}
in

let get_all_where =
{
get_all_public with
msg_name= "get_all_where"
; msg_tag= FromObject GetAllWhere
; msg_params=
[
{
param_type= String
; param_name= "expr"
; param_doc= "expression matching records"
; param_release= x.obj_release
; param_default= None
}
]
; msg_result= Some (Set (Ref x.name), "references to all matching objects")
; msg_release=
{
opensource= []
; internal=
x.obj_release.internal
(* This should be the release of getallwhere, or the class'
introduction, whichever is last. *)
; internal_deprecated_since= None
}
; msg_allowed_roles= x.obj_implicit_msg_allowed_roles
; msg_hide_from_docs= true
}
in

(* And the 'get_all_records_where' semi-public function *)
let get_all_records_where =
{
Expand Down Expand Up @@ -738,7 +768,7 @@ let messages_of_obj (x : obj) document_order : message list =
in
let get_all_public =
if List.mem x.name expose_get_all_messages_for then
[get_all_public; get_all_records_where; get_all_records]
[get_all_public; get_all_where; get_all_records_where; get_all_records]
else
[]
in
Expand Down
6 changes: 6 additions & 0 deletions ocaml/idl/ocaml_backend/gen_db_actions.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -536,6 +536,12 @@ let db_action api : O.Module.t =
"let expr' = Xapi_database.Db_filter.expr_of_string expr in"
; "get_records_where ~" ^ Gen_common.context ^ " ~expr:expr'"
]
| FromObject GetAllWhere ->
String.concat "\n"
[
"let expr' = Xapi_database.Db_filter.expr_of_string expr in"
; "get_refs_where ~" ^ Gen_common.context ^ " ~expr:expr'"
]
| _ ->
assert false
in
Expand Down
7 changes: 4 additions & 3 deletions ocaml/idl/ocaml_backend/gen_empty_custom.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -62,20 +62,21 @@ let operation_requires_side_effect ({msg_tag= tag; _} as msg) =
match tag with
| FromField (Setter, fld) ->
fld.DT.field_has_effect
| FromField ((Getter | Add | Remove), _) ->
false
| FromObject
( GetRecord
| GetByUuid
| GetByLabel
| GetAll
| GetAllWhere
| GetAllRecordsWhere
| GetAllRecords ) ->
false
| FromObject _ ->
| FromObject (Make | Delete | Private _) ->
true
| Custom ->
msg.DT.msg_has_effect && msg.DT.msg_forward_to = None
| _ ->
false

let make_custom_api api =
Dm_api.filter
Expand Down
160 changes: 67 additions & 93 deletions ocaml/xapi-cli-server/cli_operations.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4580,68 +4580,58 @@ let vm_migrate printer rpc session_id params =
Client.Session.login_with_password ~rpc:remote_rpc ~uname ~pwd
~version:"1.3" ~originator:Constants.xapi_user_agent
in
let remote f = f ~rpc:remote_rpc ~session_id:remote_session in
finally
(fun () ->
let host, host_record =
let all =
Client.Host.get_all_records ~rpc:remote_rpc
~session_id:remote_session
let host =
let expr_match x =
Printf.sprintf
{|(field "hostname"="%s") or (field "name__label"="%s") or (field "uuid"="%s")|}
x x x
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
)
all
with Not_found ->
failwith (Printf.sprintf "Failed to find host: %s" x)
else
List.hd all
let expr, fail_msg =
match List.assoc_opt "host" params with
| Some x ->
(expr_match x, Printf.sprintf "Failed to find host: %s" x)
| None ->
("true", Printf.sprintf "Failed to find a suitable host")
in
match remote Client.Host.get_all_where ~expr with
| host :: _ ->
host
| [] ->
failwith fail_msg
in
let network, network_record =
let all =
Client.Network.get_all_records ~rpc:remote_rpc
~session_id:remote_session
let network =
let expr x =
Printf.sprintf
{|(field "bridge"="%s") or (field "name__label"="%s") or (field "uuid"="%s")|}
x x x
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 self ->
Client.PIF.get_management ~rpc:remote_rpc
~session_id:remote_session ~self
)
pifs
in
if management_pifs = [] 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 ~rpc:remote_rpc ~session_id:remote_session
~self:pif
in
( net
, Client.Network.get_record ~rpc:remote_rpc
~session_id:remote_session ~self:net
match List.assoc_opt "remote-network" params with
| Some x -> (
match remote Client.Network.get_all_where ~expr:(expr x) with
| network :: _ ->
network
| [] ->
failwith (Printf.sprintf "Failed to find network: %s" x)
)
| None -> (
let expr =
Printf.sprintf
{|(field "host"="%s") and (field "management"="true")|}
Ref.(string_of host)
in
let management_pifs = remote Client.PIF.get_all_where ~expr in
match management_pifs with
| [] ->
let host_uuid = remote Client.Host.get_uuid ~self:host in
failwith
(Printf.sprintf "Could not find management PIF on host %s"
host_uuid
)
| pif :: _ ->
remote Client.PIF.get_network ~self:pif
)
in
let vif_map =
Expand All @@ -4650,10 +4640,7 @@ let vm_migrate printer rpc session_id params =
let vif =
Client.VIF.get_by_uuid ~rpc ~session_id ~uuid:vif_uuid
in
let net =
Client.Network.get_by_uuid ~rpc:remote_rpc
~session_id:remote_session ~uuid:net_uuid
in
let net = remote Client.Network.get_by_uuid ~uuid:net_uuid in
(vif, net)
)
(read_map_params "vif" params)
Expand All @@ -4664,10 +4651,7 @@ let vm_migrate printer rpc session_id params =
let vdi =
Client.VDI.get_by_uuid ~rpc ~session_id ~uuid:vdi_uuid
in
let sr =
Client.SR.get_by_uuid ~rpc:remote_rpc ~session_id:remote_session
~uuid:sr_uuid
in
let sr = remote Client.SR.get_by_uuid ~uuid:sr_uuid in
(vdi, sr)
)
(read_map_params "vdi" params)
Expand All @@ -4679,8 +4663,7 @@ let vm_migrate printer rpc session_id params =
Client.VGPU.get_by_uuid ~rpc ~session_id ~uuid:vgpu_uuid
in
let gpu_group =
Client.GPU_group.get_by_uuid ~rpc:remote_rpc
~session_id:remote_session ~uuid:gpu_group_uuid
remote Client.GPU_group.get_by_uuid ~uuid:gpu_group_uuid
in
(vgpu, gpu_group)
)
Expand All @@ -4696,19 +4679,12 @@ let vm_migrate printer rpc session_id params =
{|(field "host"="%s") and (field "currently_attached"="true")|}
(Ref.string_of host)
in
let host_pbds =
Client.PBD.get_all_records_where ~rpc:remote_rpc
~session_id:remote_session ~expr
in
let srs =
List.map
(fun (_, pbd_rec) ->
( pbd_rec.API.pBD_SR
, Client.SR.get_record ~rpc:remote_rpc
~session_id:remote_session ~self:pbd_rec.API.pBD_SR
)
)
host_pbds
remote Client.PBD.get_all_where ~expr
|> List.map (fun pbd ->
let sr = remote Client.PBD.get_SR ~self:pbd in
(sr, remote Client.SR.get_record ~self:sr)
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

so it is safe to use the SR record, but not the host and network record?

Copy link
Member Author

@psafont psafont Jul 4, 2024 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

It's not safe, but not using them means risking a large amount of roundtrips between both servers to order the SRs.

The internal tests should now try to find this issue continually and catch this issue in time

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

So using SR record is unsafe, but there hasn't been problems using them. And we can fix them once there are changes causing them to become real problems, is that right?

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

And we can fix them once there are changes causing them to become real problems, is that right?

We have 3 options here:

  • Roll back breaking changes when the are found
  • Create queries for sorting (mimicking SORT BY, similar to the current where) and use that. This seems like reinventing SQL queries.
  • Make the client robust to adding fields (ignore them), and removing them (allowing client to fail if they needed it)

)
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
Expand Down Expand Up @@ -4807,13 +4783,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
Expand All @@ -4822,16 +4805,13 @@ let vm_migrate printer rpc session_id params =
(Cli_printer.PMsg
(Printf.sprintf "VDI %s -> SR %s"
(Client.VDI.get_uuid ~rpc ~session_id ~self:vdi)
(Client.SR.get_uuid ~rpc:remote_rpc
~session_id:remote_session ~self:sr
)
(remote Client.SR.get_uuid ~self:sr)
)
)
)
vdi_map ;
let token =
Client.Host.migrate_receive ~rpc:remote_rpc ~session_id:remote_session
~host ~network ~options
remote Client.Host.migrate_receive ~host ~network ~options
in
let new_vm =
do_vm_op ~include_control_vms:false ~include_template_vms:true printer
Expand All @@ -4847,13 +4827,7 @@ let vm_migrate printer rpc session_id params =
|> List.hd
in
if get_bool_param params "copy" then
printer
(Cli_printer.PList
[
Client.VM.get_uuid ~rpc:remote_rpc ~session_id:remote_session
~self:new_vm
]
)
printer (Cli_printer.PList [remote Client.VM.get_uuid ~self:new_vm])
)
(fun () ->
Client.Session.logout ~rpc:remote_rpc ~session_id:remote_session
Expand Down
23 changes: 12 additions & 11 deletions ocaml/xapi/xapi_role.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -92,25 +92,26 @@ let get_record ~__context ~self =
~static_fn:(fun static_record -> get_api_record ~static_record)
~db_fn:(fun ~__context ~self -> Db.Role.get_record ~__context ~self)

(* val get_all_records_where : __context:Context.t -> expr:string -> ref_role_to_role_t_map*)
let expr_no_permissions = "subroles<>[]"

let expr_only_permissions = "subroles=[]"

let get_all_records_where ~__context ~expr =
let get_common_where ~__context ~expr ~f =
if expr = expr_no_permissions then (* composite role, ie. not a permission *)
List.map
(fun r -> (ref_of_role ~role:r, get_api_record ~static_record:r))
Rbac_static.all_static_roles
List.map f Rbac_static.all_static_roles
else if expr = expr_only_permissions then
(* composite role, ie. a permission *)
List.map
(fun r -> (ref_of_role ~role:r, get_api_record ~static_record:r))
Rbac_static.all_static_permissions
List.map f Rbac_static.all_static_permissions
else (* anything in this table, ie. roles+permissions *)
List.map
(fun r -> (ref_of_role ~role:r, get_api_record ~static_record:r))
get_all_static_roles
List.map f get_all_static_roles

let get_all_where ~__context ~expr =
let f r = ref_of_role ~role:r in
get_common_where ~__context ~expr ~f

let get_all_records_where ~__context ~expr =
let f r = (ref_of_role ~role:r, get_api_record ~static_record:r) in
get_common_where ~__context ~expr ~f

(*@ (* concatenate with Db table *)
(* TODO: this line is crashing for some unknown reason, but not needed in RBAC 1 *)
Expand Down
2 changes: 1 addition & 1 deletion quality-gate.sh
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,7 @@
set -e

list-hd () {
N=306
N=304
LIST_HD=$(git grep -r --count 'List.hd' -- **/*.ml | cut -d ':' -f 2 | paste -sd+ - | bc)
if [ "$LIST_HD" -eq "$N" ]; then
echo "OK counted $LIST_HD List.hd usages"
Expand Down
Loading