From c0aedf960c169d4348d9a0ea1442aafc5780da22 Mon Sep 17 00:00:00 2001 From: Bengang Yuan Date: Thu, 18 Apr 2024 15:00:49 +0800 Subject: [PATCH 01/19] CP-47304: [Toolstack] - Add data model for anti-affinity group CP-47655: [Toolstack] - Associate/disassociate VM to/from anti-affinity group Signed-off-by: Bengang Yuan --- ocaml/idl/datamodel.ml | 3 ++ ocaml/idl/datamodel_common.ml | 2 + ocaml/idl/datamodel_errors.ml | 2 + ocaml/idl/datamodel_vm.ml | 12 +++++ ocaml/idl/datamodel_vm_group.ml | 43 +++++++++++++++++ ocaml/idl/dune | 2 +- ocaml/idl/schematest.ml | 2 +- ocaml/xapi-cli-server/cli_frontend.ml | 18 +++++++ ocaml/xapi-cli-server/cli_operations.ml | 29 +++++++++++ ocaml/xapi-cli-server/record_util.ml | 15 ++++++ ocaml/xapi-cli-server/records.ml | 64 +++++++++++++++++++++++++ ocaml/xapi-consts/api_errors.ml | 2 + ocaml/xapi/api_server.ml | 1 + ocaml/xapi/message_forwarding.ml | 32 +++++++++++++ ocaml/xapi/xapi_vm.ml | 5 ++ ocaml/xapi/xapi_vm.mli | 3 ++ ocaml/xapi/xapi_vm_group.ml | 24 ++++++++++ ocaml/xapi/xapi_vm_group.mli | 22 +++++++++ ocaml/xapi/xapi_vm_helpers.ml | 4 +- ocaml/xe-cli/bash-completion | 7 +++ quality-gate.sh | 2 +- 21 files changed, 290 insertions(+), 4 deletions(-) create mode 100644 ocaml/idl/datamodel_vm_group.ml create mode 100644 ocaml/xapi/xapi_vm_group.ml create mode 100644 ocaml/xapi/xapi_vm_group.mli diff --git a/ocaml/idl/datamodel.ml b/ocaml/idl/datamodel.ml index c8fa2614150..02cd17a1230 100644 --- a/ocaml/idl/datamodel.ml +++ b/ocaml/idl/datamodel.ml @@ -7816,6 +7816,7 @@ let all_system = ; Datamodel_diagnostics.t ; Datamodel_repository.t ; Datamodel_observer.t + ; Datamodel_vm_group.t ] (* If the relation is one-to-many, the "many" nodes (one edge each) must come before the "one" node (many edges) *) @@ -7896,6 +7897,7 @@ let all_relations = ; ((_network_sriov, "physical_PIF"), (_pif, "sriov_physical_PIF_of")) ; ((_network_sriov, "logical_PIF"), (_pif, "sriov_logical_PIF_of")) ; ((_certificate, "host"), (_host, "certificates")) + ; ((_vm, "groups"), (_vm_group, "VMs")) ] let update_lifecycles = @@ -8027,6 +8029,7 @@ let expose_get_all_messages_for = ; _vmpp ; _vmss ; _vm_appliance + ; _vm_group ; _pci ; _pgpu ; _gpu_group diff --git a/ocaml/idl/datamodel_common.ml b/ocaml/idl/datamodel_common.ml index 709cb5eb059..17fd8c3f5c3 100644 --- a/ocaml/idl/datamodel_common.ml +++ b/ocaml/idl/datamodel_common.ml @@ -205,6 +205,8 @@ let _vm_guest_metrics = "VM_guest_metrics" let _vm_appliance = "VM_appliance" +let _vm_group = "VM_group" + let _dr_task = "DR_task" let _vmpp = "VMPP" diff --git a/ocaml/idl/datamodel_errors.ml b/ocaml/idl/datamodel_errors.ml index 0bfbaa21039..5cfbe153f63 100644 --- a/ocaml/idl/datamodel_errors.ml +++ b/ocaml/idl/datamodel_errors.ml @@ -1968,6 +1968,8 @@ let _ = error Api_errors.host_evacuation_is_required ["host"] ~doc:"Host evacuation is required before applying updates." () ; + error Api_errors.too_many_groups [] ~doc:"VM can only belong to one group." () ; + message (fst Api_messages.ha_pool_overcommitted) ~doc: diff --git a/ocaml/idl/datamodel_vm.ml b/ocaml/idl/datamodel_vm.ml index c1a6b9a7d9c..c21a831cc33 100644 --- a/ocaml/idl/datamodel_vm.ml +++ b/ocaml/idl/datamodel_vm.ml @@ -1514,6 +1514,15 @@ let set_appliance = ] ~allowed_roles:_R_POOL_OP () +let set_groups = + call ~name:"set_groups" ~lifecycle:[] ~doc:"Associate this VM with VM groups." + ~params: + [ + (Ref _vm, "self", "The VM") + ; (Set (Ref _vm_group), "value", "The VM groups to set") + ] + ~allowed_roles:_R_VM_ADMIN () + let call_plugin = call ~name:"call_plugin" ~in_product_since:rel_cream ~doc:"Call an API plugin on this vm" @@ -1826,6 +1835,7 @@ let t = ; recover ; import_convert ; set_appliance + ; set_groups ; query_services ; call_plugin ; set_has_vendor_device @@ -2174,6 +2184,8 @@ let t = user should follow to make some updates, e.g. specific hardware \ drivers or CPU features, fully effective, but the 'average user' \ doesn't need to" + ; field ~qualifier:DynamicRO ~lifecycle:[] ~ty:(Set (Ref _vm_group)) + "groups" "VM groups associated with the VM" ] ) () diff --git a/ocaml/idl/datamodel_vm_group.ml b/ocaml/idl/datamodel_vm_group.ml new file mode 100644 index 00000000000..58016a31d0a --- /dev/null +++ b/ocaml/idl/datamodel_vm_group.ml @@ -0,0 +1,43 @@ +(* + * Copyright (c) Cloud Software Group, Inc. + * + * 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. + *) + +open Datamodel_types +open Datamodel_common +open Datamodel_roles + +let placement_policy = + Enum + ( "placement_policy" + , [ + ("anti_affinity", "Anti-affinity placement policy") + ; ("normal", "Default placement policy") + ] + ) + +let t = + create_obj ~name:_vm_group ~descr:"A VM group" ~doccomments:[] + ~gen_constructor_destructor:true ~gen_events:true ~in_db:true ~lifecycle:[] + ~persist:PersistEverything ~in_oss_since:None + ~messages_default_allowed_roles:_R_VM_ADMIN ~messages:[] + ~contents: + [ + uid _vm_group + ; namespace ~name:"name" ~contents:(names None RW) () + ; field ~qualifier:StaticRO ~lifecycle:[] ~ty:placement_policy "placement" + ~default_value:(Some (VEnum "normal")) + "The placement policy of the VM group" + ; field ~qualifier:DynamicRO ~lifecycle:[] ~ty:(Set (Ref _vm)) "VMs" + "The list of VMs associated with the group" + ] + () diff --git a/ocaml/idl/dune b/ocaml/idl/dune index 713462e7ffa..837c3b0013a 100644 --- a/ocaml/idl/dune +++ b/ocaml/idl/dune @@ -6,7 +6,7 @@ datamodel_pool datamodel_cluster datamodel_cluster_host dm_api escaping datamodel_values datamodel_schema datamodel_certificate datamodel_diagnostics datamodel_repository datamodel_lifecycle - datamodel_vtpm datamodel_observer) + datamodel_vtpm datamodel_observer datamodel_vm_group) (libraries ppx_sexp_conv.runtime-lib rpclib.core diff --git a/ocaml/idl/schematest.ml b/ocaml/idl/schematest.ml index c8e5972c9a6..f1af08a92f6 100644 --- a/ocaml/idl/schematest.ml +++ b/ocaml/idl/schematest.ml @@ -3,7 +3,7 @@ let hash x = Digest.string x |> Digest.to_hex (* BEWARE: if this changes, check that schema has been bumped accordingly in ocaml/idl/datamodel_common.ml, usually schema_minor_vsn *) -let last_known_schema_hash = "186131ad48f40dff30246e8e0c0dbf0a" +let last_known_schema_hash = "bd7bd80ec18a0a7ddce47dcfdaa726b5" let current_schema_hash : string = let open Datamodel_types in diff --git a/ocaml/xapi-cli-server/cli_frontend.ml b/ocaml/xapi-cli-server/cli_frontend.ml index f8aa043eb5a..8a8863e6641 100644 --- a/ocaml/xapi-cli-server/cli_frontend.ml +++ b/ocaml/xapi-cli-server/cli_frontend.ml @@ -2647,6 +2647,24 @@ let rec cmdtable_data : (string * cmd_spec) list = ; flags= [] } ) + ; ( "vm-group-create" + , { + reqd= ["name-label"; "placement"] + ; optn= ["name-description"] + ; help= "Create a VM group." + ; implementation= No_fd Cli_operations.VM_group.create + ; flags= [] + } + ) + ; ( "vm-group-destroy" + , { + reqd= ["uuid"] + ; optn= [] + ; help= "Destroy a VM group." + ; implementation= No_fd Cli_operations.VM_group.destroy + ; flags= [] + } + ) ; ( "diagnostic-vm-status" , { reqd= ["uuid"] diff --git a/ocaml/xapi-cli-server/cli_operations.ml b/ocaml/xapi-cli-server/cli_operations.ml index bc0d9ea30bc..5486142552a 100644 --- a/ocaml/xapi-cli-server/cli_operations.ml +++ b/ocaml/xapi-cli-server/cli_operations.ml @@ -1140,6 +1140,11 @@ let gen_cmds rpc session_id = mk get_all_records_where get_by_uuid vm_appliance_record "appliance" [] [] rpc session_id ) + ; Client.VM_group.( + mk get_all_records_where get_by_uuid vm_group_record "vm-group" [] + ["uuid"; "name-label"; "name-description"; "placement"; "vm-uuids"] + rpc session_id + ) ; Client.PGPU.( mk get_all_records_where get_by_uuid pgpu_record "pgpu" [] ["uuid"; "vendor-name"; "device-name"; "gpu-group-uuid"] @@ -7988,3 +7993,27 @@ module Observer = struct let self = Client.Observer.get_by_uuid ~rpc ~session_id ~uuid in Client.Observer.destroy ~rpc ~session_id ~self end + +module VM_group = struct + let create printer rpc session_id params = + let name_label = List.assoc "name-label" params in + let name_description = + List.assoc_opt "name-description" params |> Option.value ~default:"" + in + let placement = + Record_util.vm_placement_policy_of_string (List.assoc "placement" params) + in + let ref = + Client.VM_group.create ~rpc ~session_id ~name_label ~name_description + ~placement + in + let uuid = Client.VM_group.get_uuid ~rpc ~session_id ~self:ref in + printer (Cli_printer.PList [uuid]) + + let destroy _printer rpc session_id params = + let ref = + Client.VM_group.get_by_uuid ~rpc ~session_id + ~uuid:(List.assoc "uuid" params) + in + Client.VM_group.destroy ~rpc ~session_id ~self:ref +end diff --git a/ocaml/xapi-cli-server/record_util.ml b/ocaml/xapi-cli-server/record_util.ml index 5332c2aee16..38f5af414e4 100644 --- a/ocaml/xapi-cli-server/record_util.ml +++ b/ocaml/xapi-cli-server/record_util.ml @@ -1188,3 +1188,18 @@ let update_sync_frequency_of_string s = `weekly | _ -> raise (Record_failure ("Expected 'daily', 'weekly', got " ^ s)) + +let vm_placement_policy_to_string = function + | `normal -> + "normal" + | `anti_affinity -> + "anti-affinity" + +let vm_placement_policy_of_string a = + match String.lowercase_ascii a with + | "normal" -> + `normal + | "anti-affinity" -> + `anti_affinity + | s -> + raise (Record_failure ("Invalid VM placement policy, got " ^ s)) diff --git a/ocaml/xapi-cli-server/records.ml b/ocaml/xapi-cli-server/records.ml index 6648d755876..3a42bc15e66 100644 --- a/ocaml/xapi-cli-server/records.ml +++ b/ocaml/xapi-cli-server/records.ml @@ -2504,6 +2504,21 @@ let vm_record rpc session_id vm = ~value:(Client.VM_appliance.get_by_uuid ~rpc ~session_id ~uuid:x) ) () + ; make_field ~name:"groups" + ~get:(fun () -> get_uuids_from_refs (x ()).API.vM_groups) + ~set:(fun x -> + if x = "" then + Client.VM.set_groups ~rpc ~session_id ~self:vm ~value:[] + else + let value = + get_words ',' x + |> List.map (fun uuid -> + Client.VM_group.get_by_uuid ~rpc ~session_id ~uuid + ) + in + Client.VM.set_groups ~rpc ~session_id ~self:vm ~value + ) + () ; make_field ~name:"snapshot-schedule" ~get:(fun () -> get_uuid_from_ref (x ()).API.vM_snapshot_schedule) ~set:(fun x -> @@ -4070,6 +4085,55 @@ let vm_appliance_record rpc session_id vm_appliance = ] } +let vm_group_record rpc session_id vm_group = + let _ref = ref vm_group in + let empty_record = + ToGet (fun () -> Client.VM_group.get_record ~rpc ~session_id ~self:!_ref) + in + let record = ref empty_record in + let x () = lzy_get record in + { + setref= + (fun r -> + _ref := r ; + record := empty_record + ) + ; setrefrec= + (fun (a, b) -> + _ref := a ; + record := Got b + ) + ; record= x + ; getref= (fun () -> !_ref) + ; fields= + [ + make_field ~name:"uuid" ~get:(fun () -> (x ()).API.vM_group_uuid) () + ; make_field ~name:"name-label" + ~get:(fun () -> (x ()).API.vM_group_name_label) + ~set:(fun value -> + Client.VM_group.set_name_label ~rpc ~session_id ~self:!_ref ~value + ) + () + ; make_field ~name:"name-description" + ~get:(fun () -> (x ()).API.vM_group_name_description) + ~set:(fun value -> + Client.VM_group.set_name_description ~rpc ~session_id ~self:!_ref + ~value + ) + () + ; make_field ~name:"placement" + ~get:(fun () -> + Record_util.vm_placement_policy_to_string + (x ()).API.vM_group_placement + ) + () + ; make_field ~name:"vm-uuids" + ~get:(fun () -> get_uuids_from_refs (x ()).API.vM_group_VMs) + ~get_set:(fun () -> List.map get_uuid_from_ref (x ()).API.vM_group_VMs) + () + ] + } + let dr_task_record rpc session_id dr_task = let _ref = ref dr_task in let empty_record = diff --git a/ocaml/xapi-consts/api_errors.ml b/ocaml/xapi-consts/api_errors.ml index 43fff504a3d..562d95f62ae 100644 --- a/ocaml/xapi-consts/api_errors.ml +++ b/ocaml/xapi-consts/api_errors.ml @@ -1299,3 +1299,5 @@ let telemetry_next_collection_too_late = "TELEMETRY_NEXT_COLLECTION_TOO_LATE" (* FIPS/CC_PREPARATIONS *) let illegal_in_fips_mode = "ILLEGAL_IN_FIPS_MODE" + +let too_many_groups = "TOO_MANY_GROUPS" diff --git a/ocaml/xapi/api_server.ml b/ocaml/xapi/api_server.ml index b7209ec323e..182c587925e 100644 --- a/ocaml/xapi/api_server.ml +++ b/ocaml/xapi/api_server.ml @@ -39,6 +39,7 @@ module Actions = struct module VMPP = Xapi_vmpp module VMSS = Xapi_vmss module VM_appliance = Xapi_vm_appliance + module VM_group = Xapi_vm_group module DR_task = Xapi_dr_task module LVHD = struct end diff --git a/ocaml/xapi/message_forwarding.ml b/ocaml/xapi/message_forwarding.ml index b2eb86c805d..3c774cbe9ba 100644 --- a/ocaml/xapi/message_forwarding.ml +++ b/ocaml/xapi/message_forwarding.ml @@ -416,6 +416,17 @@ functor Ref.string_of vm_appliance with _ -> "invalid" + let vm_group_uuid ~__context vm_group = + try + if Pool_role.is_master () then + let name = Db.VM_group.get_name_label ~__context ~self:vm_group in + Printf.sprintf "%s%s" + (Db.VM_group.get_uuid ~__context ~self:vm_group) + (add_brackets name) + else + Ref.string_of vm_group + with _ -> "invalid" + let sr_uuid ~__context sr = try if Pool_role.is_master () then @@ -2996,6 +3007,12 @@ functor (vm_appliance_uuid ~__context value) ; Local.VM.set_appliance ~__context ~self ~value + let set_groups ~__context ~self ~value = + info "VM.set_groups : self = '%s'; value = [ %s ]" + (vm_uuid ~__context self) + (String.concat "; " (List.map (vm_group_uuid ~__context) value)) ; + Local.VM.set_groups ~__context ~self ~value + let import_convert ~__context ~_type ~username ~password ~sr ~remote_config = info "VM.import_convert: type = '%s'; remote_config = '%s;'" _type @@ -6511,6 +6528,21 @@ functor ) end + module VM_group = struct + let create ~__context ~name_label ~name_description ~placement = + info + "VM_group.create: name_label = '%s'; name_description = '%s'; \ + placement = '%s'" + name_label name_description + (Record_util.vm_placement_policy_to_string placement) ; + Local.VM_group.create ~__context ~name_label ~name_description + ~placement + + let destroy ~__context ~self = + info "VM_group.destroy: self = '%s'" (vm_group_uuid ~__context self) ; + Local.VM_group.destroy ~__context ~self + end + module Observer = struct module RefSet = Set.Make (struct type t = [`host] Ref.t diff --git a/ocaml/xapi/xapi_vm.ml b/ocaml/xapi/xapi_vm.ml index e0de06045e1..767fd18a1b0 100644 --- a/ocaml/xapi/xapi_vm.ml +++ b/ocaml/xapi/xapi_vm.ml @@ -1444,6 +1444,11 @@ let set_appliance ~__context ~self ~value = (* Update the VM's allowed operations - this will update the new appliance's operations, if valid. *) update_allowed_operations ~__context ~self +let set_groups ~__context ~self ~value = + if List.length value > 1 then + raise Api_errors.(Server_error (Api_errors.too_many_groups, [])) ; + Db.VM.set_groups ~__context ~self ~value + let import_convert ~__context ~_type ~username ~password ~sr ~remote_config = let open Vpx in let print_jobInstance (j : Vpx.jobInstance) = diff --git a/ocaml/xapi/xapi_vm.mli b/ocaml/xapi/xapi_vm.mli index c349ff8dcb0..a7fbfb62570 100644 --- a/ocaml/xapi/xapi_vm.mli +++ b/ocaml/xapi/xapi_vm.mli @@ -372,6 +372,9 @@ val set_suspend_VDI : val set_appliance : __context:Context.t -> self:API.ref_VM -> value:API.ref_VM_appliance -> unit +val set_groups : + __context:Context.t -> self:API.ref_VM -> value:API.ref_VM_group_set -> unit + val import_convert : __context:Context.t -> _type:string diff --git a/ocaml/xapi/xapi_vm_group.ml b/ocaml/xapi/xapi_vm_group.ml new file mode 100644 index 00000000000..d475da32542 --- /dev/null +++ b/ocaml/xapi/xapi_vm_group.ml @@ -0,0 +1,24 @@ +(* + * Copyright (c) Cloud Software Group, Inc. + * + * 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 = "xapi_vm_group" end) + +let create ~__context ~name_label ~name_description ~placement = + let uuid = Uuidx.make () in + let ref = Ref.make () in + Db.VM_group.create ~__context ~ref ~uuid:(Uuidx.to_string uuid) ~name_label + ~name_description ~placement ; + ref + +let destroy ~__context ~self = Db.VM_group.destroy ~__context ~self diff --git a/ocaml/xapi/xapi_vm_group.mli b/ocaml/xapi/xapi_vm_group.mli new file mode 100644 index 00000000000..5ea43acc204 --- /dev/null +++ b/ocaml/xapi/xapi_vm_group.mli @@ -0,0 +1,22 @@ +(* + * Copyright (c) Cloud Software Group, Inc. + * + * 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. + *) + +val create : + __context:Context.t + -> name_label:string + -> name_description:string + -> placement:API.placement_policy + -> [`VM_group] Ref.t + +val destroy : __context:Context.t -> self:[`VM_group] Ref.t -> unit diff --git a/ocaml/xapi/xapi_vm_helpers.ml b/ocaml/xapi/xapi_vm_helpers.ml index 538dda7bb01..b8a382e318e 100644 --- a/ocaml/xapi/xapi_vm_helpers.ml +++ b/ocaml/xapi/xapi_vm_helpers.ml @@ -117,7 +117,9 @@ let set_is_a_template ~__context ~self ~value = ) |> List.rev |> List.iter (fun p -> Db.PVS_proxy.destroy ~__context ~self:p) ; - (* delete the vm metrics associated with the vm if it exists, when we templat'ize it *) + (* Remove from any VM groups when we templatize it *) + Db.VM.set_groups ~__context ~self ~value:[] ; + (* Delete the vm metrics associated with the vm if it exists, when we templatize it *) finally (fun () -> Db.VM_metrics.destroy ~__context ~self:m) (fun () -> Db.VM.set_metrics ~__context ~self ~value:Ref.null) diff --git a/ocaml/xe-cli/bash-completion b/ocaml/xe-cli/bash-completion index ce9d5ae5f11..e697d777e37 100644 --- a/ocaml/xe-cli/bash-completion +++ b/ocaml/xe-cli/bash-completion @@ -114,6 +114,7 @@ _xe() pvs-site-*|\ sdn-controller-*|\ network-sriov-*|\ + vm-group-*|\ cluster-host-*) # Chop off at the second '-' and append 'list' cmd="$(echo ${OLDSTYLE_WORDS[1]} | cut -d- -f1-2)-list";; @@ -387,6 +388,12 @@ _xe() return 0 ;; + placement) # for vm-group-create + IFS=$'\n,' + set_completions 'normal,anti-affinity' "$value" + return 0 + ;; + *) snd=`echo ${param} | gawk -F- '{print $NF}'` fst=`echo ${param} | gawk -F- '{printf "%s", $1; for (i=2; i Date: Thu, 18 Apr 2024 15:01:03 +0800 Subject: [PATCH 02/19] UT - CP-47655: [Toolstack] - Associate/disassociate VM to/from anti-affinity group UT - CP-47304: [Toolstack] - Add data model for anti-affinity group Signed-off-by: Bengang Yuan --- ocaml/tests/common/test_common.ml | 7 ++++ ocaml/tests/suite_alcotest.ml | 1 + ocaml/tests/test_vm_group.ml | 55 +++++++++++++++++++++++++++++++ 3 files changed, 63 insertions(+) create mode 100644 ocaml/tests/test_vm_group.ml diff --git a/ocaml/tests/common/test_common.ml b/ocaml/tests/common/test_common.ml index d1433868fdc..cb7b24af99e 100644 --- a/ocaml/tests/common/test_common.ml +++ b/ocaml/tests/common/test_common.ml @@ -674,3 +674,10 @@ let make_observer ~__context ?(ref = Ref.make ()) ?(uuid = make_uuid ()) Db.Observer.create ~__context ~ref ~uuid ~name_label ~name_description ~hosts ~attributes ~endpoints ~components ~enabled ; ref + +let make_vm_group ~__context ?(ref = Ref.make ()) ?(uuid = make_uuid ()) + ?(name_label = "vm_group") ?(name_description = "") ?(placement = `normal) + () = + Db.VM_group.create ~__context ~ref ~uuid ~name_label ~name_description + ~placement ; + ref diff --git a/ocaml/tests/suite_alcotest.ml b/ocaml/tests/suite_alcotest.ml index 21a637d5ea7..be73d7cef06 100644 --- a/ocaml/tests/suite_alcotest.ml +++ b/ocaml/tests/suite_alcotest.ml @@ -46,6 +46,7 @@ let () = ; ("Test_storage_migrate_state", Test_storage_migrate_state.test) ; ("Test_bios_strings", Test_bios_strings.test) ; ("Test_certificates", Test_certificates.test) + ; ("Test_vm_group", Test_vm_group.test) ] @ Test_guest_agent.tests @ Test_nm.tests diff --git a/ocaml/tests/test_vm_group.ml b/ocaml/tests/test_vm_group.ml new file mode 100644 index 00000000000..910711f9646 --- /dev/null +++ b/ocaml/tests/test_vm_group.ml @@ -0,0 +1,55 @@ +(* + * Copyright (c) Cloud Software Group, Inc. + * + * 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 T = Test_common + +let test_associate_vm_with_vm_group () = + let __context = T.make_test_database () in + let rpc, session_id = Test_common.make_client_params ~__context in + let vm1 = T.make_vm ~__context () in + let vm2 = T.make_vm ~__context () in + let vm3 = T.make_vm ~__context () in + let vm_group = T.make_vm_group ~__context ~placement:`anti_affinity () in + Client.Client.VM.set_groups ~rpc ~session_id ~self:vm1 ~value:[vm_group] ; + Client.Client.VM.set_groups ~rpc ~session_id ~self:vm2 ~value:[vm_group] ; + Client.Client.VM.set_groups ~rpc ~session_id ~self:vm3 ~value:[vm_group] ; + let vms = Db.VM_group.get_VMs ~__context ~self:vm_group in + let extract_vm_strings vms = + List.sort String.compare (List.map Ref.string_of vms) + in + Alcotest.(check (slist string String.compare)) + "check VMs are in the group" (extract_vm_strings vms) + (extract_vm_strings [vm1; vm2; vm3]) + +let test_vm_can_only_belong_to_one_group () = + let __context = T.make_test_database () in + let rpc, session_id = Test_common.make_client_params ~__context in + let vm = T.make_vm ~__context () in + let vm_group1 = T.make_vm_group ~__context ~placement:`anti_affinity () in + let vm_group2 = T.make_vm_group ~__context ~placement:`anti_affinity () in + Alcotest.check_raises "should fail" + (Api_errors.Server_error (Api_errors.too_many_groups, [])) + (fun () -> + Client.Client.VM.set_groups ~rpc ~session_id ~self:vm + ~value:[vm_group1; vm_group2] + ) + +let test = + [ + ("test_associate_vm_with_vm_group", `Quick, test_associate_vm_with_vm_group) + ; ( "test_vm_can_only_belong_to_one_group" + , `Quick + , test_vm_can_only_belong_to_one_group + ) + ] From 2c920ed032c5bd8073996dab2f055f3af2122622 Mon Sep 17 00:00:00 2001 From: Bengang Yuan Date: Fri, 19 Apr 2024 17:55:31 +0800 Subject: [PATCH 03/19] CA-391880: Update related field 'groups' of VM when destroying VM group. In VM anti-affinity datamodel PR (https://github.com/xapi-project/xen-api/pull/5573), there is many-many relation between VMs and VM groups. When changing the VM.groups manually, the VM_group.VMs will be updated automatically. But when removing a VM group, the VM.groups will not be updated automatically. This commit aims to update VM.groups for all VMs in a VM group when it is being removed. Signed-off-by: Bengang Yuan --- ocaml/xapi/xapi_vm_group.ml | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/ocaml/xapi/xapi_vm_group.ml b/ocaml/xapi/xapi_vm_group.ml index d475da32542..0d77e9d3f51 100644 --- a/ocaml/xapi/xapi_vm_group.ml +++ b/ocaml/xapi/xapi_vm_group.ml @@ -21,4 +21,8 @@ let create ~__context ~name_label ~name_description ~placement = ~name_description ~placement ; ref -let destroy ~__context ~self = Db.VM_group.destroy ~__context ~self +let destroy ~__context ~self = + List.iter + (fun vm -> Db.VM.remove_groups ~__context ~self:vm ~value:self) + (Db.VM_group.get_VMs ~__context ~self) ; + Db.VM_group.destroy ~__context ~self From 1425790608f8bdbe5da47ac4d66201b3c8c5f384 Mon Sep 17 00:00:00 2001 From: Bengang Yuan Date: Thu, 25 Apr 2024 15:36:29 +0800 Subject: [PATCH 04/19] CP-47302: VM start with anti-affinity VM in an anti-affinity group will choose a host based on the following steps: 1. If the VM is associated with an anti-affinity group, compute the number of VMs associated with this anti-affinity group for each host. 2. Group these hosts based on the VM's count. The hosts in one group have the same number of VMs in one anti-affinity group. Sort all the host groups ascending based on the VM's count. 3. If a host is the affinity host of this VM, it will be treated as a single host group and be put on the head of the group list. 4. Choose a host randomly which the VM can run on it from each group. Signed-off-by: Bengang Yuan --- ocaml/xapi/xapi_vm_helpers.ml | 105 ++++++++++++++++++++++++++++++++-- 1 file changed, 100 insertions(+), 5 deletions(-) diff --git a/ocaml/xapi/xapi_vm_helpers.ml b/ocaml/xapi/xapi_vm_helpers.ml index b8a382e318e..ec6868db0e4 100644 --- a/ocaml/xapi/xapi_vm_helpers.ml +++ b/ocaml/xapi/xapi_vm_helpers.ml @@ -35,6 +35,12 @@ module SRSet = Set.Make (struct let compare = Stdlib.compare end) +module RefMap = Map.Make (struct + type t = [`host] Ref.t + + let compare = Ref.compare +end) + let compute_memory_overhead ~__context ~vm = let vm_record = Db.VM.get_record ~__context ~self:vm in Memory_check.vm_compute_memory_overhead ~vm_record @@ -931,6 +937,20 @@ let vm_can_run_on_host ~__context ~vm ~snapshot ~do_memory_check host = && host_evacuate_in_progress with _ -> false +let vm_has_anti_affinity ~__context ~vm = + List.find_opt + (fun g -> Db.VM_group.get_placement ~__context ~self:g = `anti_affinity) + (Db.VM.get_groups ~__context ~self:vm) + |> Option.map (fun group -> + debug + "The VM (uuid %s) is associated with an anti-affinity group (uuid: \ + %s, name: %s)" + (Db.VM.get_uuid ~__context ~self:vm) + (Db.VM_group.get_uuid ~__context ~self:group) + (Db.VM_group.get_name_label ~__context ~self:group) ; + `AntiAffinity group + ) + let vm_has_vgpu ~__context ~vm = match Db.VM.get_VGPUs ~__context ~self:vm with | [] -> @@ -950,7 +970,11 @@ let vm_has_sriov ~__context ~vm = let ( >>= ) opt f = match opt with Some _ as v -> v | None -> f let get_group_key ~__context ~vm = - match None >>= vm_has_vgpu ~__context ~vm >>= vm_has_sriov ~__context ~vm with + match + vm_has_anti_affinity ~__context ~vm + >>= vm_has_vgpu ~__context ~vm + >>= vm_has_sriov ~__context ~vm + with | Some x -> x | None -> @@ -996,12 +1020,81 @@ let rank_hosts_by_best_vgpu ~__context vgpu visible_hosts = 0L ) hosts - |> List.map (fun g -> List.map (fun (h, _) -> h) g) + |> List.map (fun g -> List.map fst g) + +(* Group all hosts to 2 parts: + 1. A list of affinity host (only one host). + 2. A list of lists, each list contains hosts with the same number of + running VM in that anti-affinity group. + These lists are sorted by VM's count. + Combine these lists into one list. The list is like below: + [ [host1] (affinity host) + , [host2, host3] (no VM running) + , [host4, host5] (one VM running) + , [host6, host7] (more VMs running) + , ... + ] +*) +let rank_hosts_by_placement ~__context ~vm ~group = + let affinity_host = + match Db.VM.get_affinity ~__context ~self:vm with + | ref when Db.is_valid_ref __context ref -> + [ref] + | _ -> + [] + in + let sorted_hosts = + let host_without_affinity_host = + Db.Host.get_all ~__context + |> List.filter (fun host -> not (List.mem host affinity_host)) + in + let host_of_vm vm = + let vm_rec = Db.VM.get_record ~__context ~self:vm in + (* 1. When a VM starts migrating, it's 'scheduled_to_be_resident_on' will be set, + while its 'resident_on' is not cleared. In this case, + 'scheduled_to_be_resident_on' should be treated as its running host. + 2. For paused VM, its 'resident_on' has value, but it will not be considered + while computing the amount of VMs. *) + match + ( vm_rec.API.vM_scheduled_to_be_resident_on + , vm_rec.API.vM_resident_on + , vm_rec.API.vM_power_state + ) + with + | sh, _, _ when sh <> Ref.null -> + Some sh + | _, h, `Running when h <> Ref.null -> + Some h + | _ -> + None + in + let host_map = + Db.VM_group.get_VMs ~__context ~self:group + |> List.fold_left + (fun m vm -> + match host_of_vm vm with + | Some h -> + RefMap.update h + (fun c -> Option.(value ~default:0 c |> succ |> some)) + m + | None -> + m + ) + RefMap.empty + in + host_without_affinity_host + |> Helpers.group_by ~ordering:`ascending (fun h -> + RefMap.find_opt h host_map |> Option.value ~default:0 + ) + |> List.map (fun g -> List.map fst g) + in + affinity_host :: sorted_hosts |> List.filter (( <> ) []) (* Selects a single host from the set of all hosts on which the given [vm] can boot. Raises [Api_errors.no_hosts_available] if no such host exists. - 1.Take Vgpu or Network SR-IOV as a group_key for group all hosts into host list list - 2.helper function's order determine the priority of resources,now vgpu has higher priority than Network SR-IOV + 1.Take anti-affinity, or VGPU, or Network SR-IOV as a group_key for group all hosts into host list list + 2.helper function's order determine the priority of resources,now anti-affinity has the highest priority, + VGPU is the second, Network SR-IOV is the lowest 3.If no key found in VM,then host_lists will be [all_hosts] *) let choose_host_for_vm_no_wlb ~__context ~vm ~snapshot = let validate_host = @@ -1013,6 +1106,8 @@ let choose_host_for_vm_no_wlb ~__context ~vm ~snapshot = match group_key with | `Other -> [all_hosts] + | `AntiAffinity group -> + rank_hosts_by_placement ~__context ~vm ~group | `VGPU vgpu -> let can_host_vm ~__context host vm = try @@ -1027,7 +1122,7 @@ let choose_host_for_vm_no_wlb ~__context ~vm ~snapshot = let host_group = Xapi_network_sriov_helpers.group_hosts_by_best_sriov ~__context ~network - |> List.map (fun g -> List.map (fun (h, _) -> h) g) + |> List.map (fun g -> List.map fst g) in if host_group <> [] then host_group From 0de00bad675cb99f90c835fafca8556ef93ff92d Mon Sep 17 00:00:00 2001 From: Bengang Yuan Date: Thu, 25 Apr 2024 15:36:39 +0800 Subject: [PATCH 05/19] CP-47302: UT for VM start with anti-affinity Signed-off-by: Bengang Yuan --- ocaml/tests/test_vm_helpers.ml | 515 ++++++++++++++++++++++++++++++++- 1 file changed, 509 insertions(+), 6 deletions(-) diff --git a/ocaml/tests/test_vm_helpers.ml b/ocaml/tests/test_vm_helpers.ml index bdd8dc061d8..f62c5145971 100644 --- a/ocaml/tests/test_vm_helpers.ml +++ b/ocaml/tests/test_vm_helpers.ml @@ -159,7 +159,7 @@ let rec assert_equivalent expected_grouping actual_grouping = assert_host_groups_equal e g ; assert_equivalent es gs -let assert_host_groups_equal_for_vgpu g g' = +let assert_host_groups_equal g g' = match g' with | [] -> () @@ -170,7 +170,7 @@ let assert_host_groups_equal_for_vgpu g g' = Alcotest.(check (slist string String.compare)) "check host strings" (extract_host_strings g) (extract_host_strings g') -let rec assert_equivalent_for_vgpu expected_grouping actual_grouping = +let rec assert_equivalent_for_grouping expected_grouping actual_grouping = match (expected_grouping, actual_grouping) with | [], [] -> () @@ -181,13 +181,13 @@ let rec assert_equivalent_for_vgpu expected_grouping actual_grouping = Alcotest.fail (Printf.sprintf "%d fewer groups than expected." (List.length xx)) | e :: es, g :: gs -> - assert_host_groups_equal_for_vgpu e g ; - assert_equivalent_for_vgpu es gs + assert_host_groups_equal e g ; + assert_equivalent_for_grouping es gs let assert_grouping ~__context gpu_group ~visible_hosts vgpu_type g = let vgpu = VGPU_T.make_vgpu ~__context ~gPU_group:gpu_group vgpu_type in let host_lists = rank_hosts_by_best_vgpu ~__context vgpu visible_hosts in - assert_equivalent_for_vgpu g host_lists + assert_equivalent_for_grouping g host_lists let check_expectations ~__context gpu_group visible_hosts vgpu_type expected_grouping = @@ -524,6 +524,44 @@ let test_group_hosts_netsriov_with_allocated () = "Test-failure: Unexpected number of sriov network in test" ) +let on_pool_of_anti_affinity placement + (f : Context.t -> API.ref_host -> API.ref_host -> API.ref_host -> 'a) = + let __context = T.make_test_database () in + let h1 = + match Db.Host.get_all ~__context with + | h :: _ -> + h + | [] -> + T.make_host ~__context () + in + (* Make two more hosts *) + let h2 = T.make_host ~__context () in + let h3 = T.make_host ~__context () in + let g = T.make_vm_group ~__context ~placement () in + f __context h1 h2 h3 g + +let test_get_group_key_anti_affinity () = + on_pool_of_anti_affinity `anti_affinity (fun __context _ _ _ g -> + let vm = T.make_vm ~__context () in + Db.VM.set_groups ~__context ~self:vm ~value:[g] ; + match Xapi_vm_helpers.get_group_key ~__context ~vm with + | `AntiAffinity _ -> + () + | _ -> + Alcotest.fail "Test-failure: Unexpected Group Key in test" + ) + +let test_get_group_key_normal_group () = + on_pool_of_anti_affinity `normal (fun __context _ _ _ g -> + let vm = T.make_vm ~__context () in + Db.VM.set_groups ~__context ~self:vm ~value:[g] ; + match Xapi_vm_helpers.get_group_key ~__context ~vm with + | `Other -> + () + | _ -> + Alcotest.fail "Test-failure: Unexpected Group Key in test" + ) + let test_get_group_key_vgpu () = on_pool_of_intel_i350 (fun __context _ _ _ -> let group = List.hd (Db.GPU_group.get_all ~__context) in @@ -573,6 +611,461 @@ let test_get_group_key_vgpu_and_netsriov () = Alcotest.fail "Test-failure: Unexpected Group Key in test" ) +let test_get_group_key_anti_affinity_and_vgpu_and_netsriov () = + on_pool_of_intel_i350 (fun __context _ _ _ -> + let group = + match Db.GPU_group.get_all ~__context with + | g :: _ -> + g + | [] -> + Alcotest.fail "Can not find any GPU_group" + in + let vm = make_vm_with_vgpu_in_group ~__context VGPU_T.k100 group in + let sriov_network = + List.find + (fun network -> + Xapi_network_sriov_helpers.is_sriov_network ~__context ~self:network + ) + (Db.Network.get_all ~__context) + in + let (_ : API.ref_VIF) = + T.make_vif ~__context ~vM:vm ~network:sriov_network () + in + let anti_affinity_group = + T.make_vm_group ~__context ~placement:`anti_affinity () + in + Db.VM.set_groups ~__context ~self:vm ~value:[anti_affinity_group] ; + match Xapi_vm_helpers.get_group_key ~__context ~vm with + | `AntiAffinity _ -> + () + | _ -> + Alcotest.fail "Test-failure: Unexpected Group Key in test" + ) + +module VMAntiAffinityRankedGrpTest = struct + type vm_state = Running | Starting | Migrating | Suspended | Paused | Halted + + type vm_info = { + name: string option + ; host: string option + ; group: string option + ; state: vm_state + } + + type test_case = { + description: string + ; vm_to_start: vm_info + ; other_vms: vm_info list + ; hosts: string option list + ; affinity_host: string option + ; expected: string option list list + } + + let vm_to_start = Some "vm" + + let vm1 = Some "vm1" + + let vm2 = Some "vm2" + + let vm3 = Some "vm3" + + let vm4 = Some "vm4" + + let vm5 = Some "vm5" + + let vm6 = Some "vm6" + + let h1 = Some "h1" + + let h2 = Some "h2" + + let h3 = Some "h3" + + let anti_affinity = Some "anti-affinity" + + let other_group = Some "other-group" + + let test_cases = + [ + { + description= "No other VM" + ; vm_to_start= + {name= vm_to_start; host= None; group= anti_affinity; state= Halted} + ; other_vms= [] + ; hosts= [h1; h2; h3] + ; affinity_host= None + ; expected= [[h1; h2; h3]] + } + ; { + description= "VMs not in group" + ; vm_to_start= + {name= vm_to_start; host= None; group= anti_affinity; state= Halted} + ; other_vms= + [ + {name= vm1; host= h2; group= None; state= Running} + ; {name= vm2; host= h3; group= None; state= Running} + ; {name= vm3; host= h3; group= None; state= Running} + ] + ; hosts= [h1; h2; h3] + ; affinity_host= None + ; expected= [[h1; h2; h3]] + } + ; { + description= "VMs in other group" + ; vm_to_start= + {name= vm_to_start; host= None; group= anti_affinity; state= Halted} + ; other_vms= + [ + {name= vm1; host= h2; group= other_group; state= Running} + ; {name= vm2; host= h3; group= other_group; state= Running} + ; {name= vm3; host= h3; group= other_group; state= Running} + ] + ; hosts= [h1; h2; h3] + ; affinity_host= None + ; expected= [[h1; h2; h3]] + } + ; { + description= "3 running VMs (h1(0) h2(1) h3(2))" + ; vm_to_start= + {name= vm_to_start; host= None; group= anti_affinity; state= Halted} + ; other_vms= + [ + {name= vm1; host= h2; group= anti_affinity; state= Running} + ; {name= vm2; host= h3; group= anti_affinity; state= Running} + ; {name= vm3; host= h3; group= anti_affinity; state= Running} + ] + ; hosts= [h1; h2; h3] + ; affinity_host= None + ; expected= [[h1]; [h2]; [h3]] + } + ; { + description= "3 running VMs (h1(1) h2(1) h3(1))" + ; vm_to_start= + {name= vm_to_start; host= None; group= anti_affinity; state= Halted} + ; other_vms= + [ + {name= vm1; host= h1; group= anti_affinity; state= Running} + ; {name= vm2; host= h2; group= anti_affinity; state= Running} + ; {name= vm3; host= h3; group= anti_affinity; state= Running} + ] + ; hosts= [h1; h2; h3] + ; affinity_host= None + ; expected= [[h1; h2; h3]] + } + ; { + description= "3 running VMs (h1(0) h2(0) h3(3))" + ; vm_to_start= + {name= vm_to_start; host= None; group= anti_affinity; state= Halted} + ; other_vms= + [ + {name= vm1; host= h3; group= anti_affinity; state= Running} + ; {name= vm2; host= h3; group= anti_affinity; state= Running} + ; {name= vm3; host= h3; group= anti_affinity; state= Running} + ] + ; hosts= [h1; h2; h3] + ; affinity_host= None + ; expected= [[h1; h2]; [h3]] + } + ; { + description= "3 starting VMs (h1(0) h2(1) h3(2))" + ; vm_to_start= + {name= vm_to_start; host= None; group= anti_affinity; state= Halted} + ; other_vms= + [ + {name= vm1; host= h2; group= anti_affinity; state= Starting} + ; {name= vm2; host= h3; group= anti_affinity; state= Starting} + ; {name= vm3; host= h3; group= anti_affinity; state= Starting} + ] + ; hosts= [h1; h2; h3] + ; affinity_host= None + ; expected= [[h1]; [h2]; [h3]] + } + ; { + description= "3 starting VMs (h1(1) h2(1) h3(1))" + ; vm_to_start= + {name= vm_to_start; host= None; group= anti_affinity; state= Halted} + ; other_vms= + [ + {name= vm1; host= h1; group= anti_affinity; state= Starting} + ; {name= vm2; host= h2; group= anti_affinity; state= Starting} + ; {name= vm3; host= h3; group= anti_affinity; state= Starting} + ] + ; hosts= [h1; h2; h3] + ; affinity_host= None + ; expected= [[h1; h2; h3]] + } + ; { + description= "3 starting VMs (h1(0) h2(0) h3(3))" + ; vm_to_start= + {name= vm_to_start; host= None; group= anti_affinity; state= Halted} + ; other_vms= + [ + {name= vm1; host= h3; group= anti_affinity; state= Starting} + ; {name= vm2; host= h3; group= anti_affinity; state= Starting} + ; {name= vm3; host= h3; group= anti_affinity; state= Starting} + ] + ; hosts= [h1; h2; h3] + ; affinity_host= None + ; expected= [[h1; h2]; [h3]] + } + ; { + description= "3 migrating VMs (h1(0) h2(1) h3(2))" + ; vm_to_start= + {name= vm_to_start; host= None; group= anti_affinity; state= Halted} + ; other_vms= + [ + {name= vm1; host= h2; group= anti_affinity; state= Migrating} + ; {name= vm2; host= h3; group= anti_affinity; state= Migrating} + ; {name= vm3; host= h3; group= anti_affinity; state= Migrating} + ] + ; hosts= [h1; h2; h3] + ; affinity_host= None + ; expected= [[h1]; [h2]; [h3]] + } + ; { + description= "3 migrating VMs (h1(0) h2(0) h3(3))" + ; vm_to_start= + {name= vm_to_start; host= None; group= anti_affinity; state= Halted} + ; other_vms= + [ + {name= vm1; host= h3; group= anti_affinity; state= Migrating} + ; {name= vm2; host= h3; group= anti_affinity; state= Migrating} + ; {name= vm3; host= h3; group= anti_affinity; state= Migrating} + ] + ; hosts= [h1; h2; h3] + ; affinity_host= None + ; expected= [[h1; h2]; [h3]] + } + ; { + description= "3 stopped VMs" + ; vm_to_start= + {name= vm_to_start; host= None; group= anti_affinity; state= Halted} + ; other_vms= + [ + {name= vm1; host= None; group= anti_affinity; state= Halted} + ; {name= vm2; host= None; group= anti_affinity; state= Halted} + ; {name= vm3; host= None; group= anti_affinity; state= Halted} + ] + ; hosts= [h1; h2; h3] + ; affinity_host= None + ; expected= [[h1; h2; h3]] + } + ; { + description= "3 suspended VMs" + ; vm_to_start= + {name= vm_to_start; host= None; group= anti_affinity; state= Halted} + ; other_vms= + [ + {name= vm1; host= None; group= anti_affinity; state= Suspended} + ; {name= vm2; host= None; group= anti_affinity; state= Suspended} + ; {name= vm3; host= None; group= anti_affinity; state= Suspended} + ] + ; hosts= [h1; h2; h3] + ; affinity_host= None + ; expected= [[h1; h2; h3]] + } + ; { + description= "3 paused VMs (h1(0) h2(1) h3(2))" + ; vm_to_start= + {name= vm_to_start; host= None; group= anti_affinity; state= Halted} + ; other_vms= + [ + {name= vm1; host= h2; group= anti_affinity; state= Paused} + ; {name= vm2; host= h3; group= anti_affinity; state= Paused} + ; {name= vm3; host= h3; group= anti_affinity; state= Paused} + ] + ; hosts= [h1; h2; h3] + ; affinity_host= None + ; expected= [[h1; h2; h3]] + } + ; { + description= "3 running VMs with affinity-host" + ; vm_to_start= + {name= vm_to_start; host= None; group= anti_affinity; state= Halted} + ; other_vms= + [ + {name= vm1; host= h1; group= anti_affinity; state= Running} + ; {name= vm2; host= h2; group= anti_affinity; state= Running} + ; {name= vm3; host= h3; group= anti_affinity; state= Running} + ] + ; hosts= [h1; h2; h3] + ; affinity_host= h1 + ; expected= [[h1]; [h2; h3]] + } + ; { + description= "6 running VMs (h1(1) h2(2) h3(3))" + ; vm_to_start= + {name= vm_to_start; host= None; group= anti_affinity; state= Halted} + ; other_vms= + [ + {name= vm1; host= h1; group= anti_affinity; state= Running} + ; {name= vm2; host= h2; group= anti_affinity; state= Running} + ; {name= vm3; host= h2; group= anti_affinity; state= Running} + ; {name= vm4; host= h3; group= anti_affinity; state= Running} + ; {name= vm5; host= h3; group= anti_affinity; state= Running} + ; {name= vm6; host= h3; group= anti_affinity; state= Running} + ] + ; hosts= [h1; h2; h3] + ; affinity_host= None + ; expected= [[h1]; [h2]; [h3]] + } + ; { + description= "6 running VMs (h1(2) h2(2) h3(2))" + ; vm_to_start= + {name= vm_to_start; host= None; group= anti_affinity; state= Halted} + ; other_vms= + [ + {name= vm1; host= h1; group= anti_affinity; state= Running} + ; {name= vm2; host= h1; group= anti_affinity; state= Running} + ; {name= vm3; host= h2; group= anti_affinity; state= Running} + ; {name= vm4; host= h2; group= anti_affinity; state= Running} + ; {name= vm5; host= h3; group= anti_affinity; state= Running} + ; {name= vm6; host= h3; group= anti_affinity; state= Running} + ] + ; hosts= [h1; h2; h3] + ; affinity_host= None + ; expected= [[h1; h2; h3]] + } + ] + + let make_hosts ~__context ~hosts = + match hosts with + | fst :: others -> + let host1 = + match Db.Host.get_all ~__context with + | h :: _ -> + h + | _ -> + T.make_host ~__context () + in + Db.Host.set_name_label ~__context ~self:host1 ~value:(Option.get fst) ; + List.iter + (fun h -> + let _ = T.make_host ~__context ~name_label:(Option.get h) () in + () + ) + others + | [] -> + () + + let make_vm_based_on_vm_info ~__context ~vm_info = + let vm = + T.make_vm ~__context + ~name_label:(Option.value vm_info.name ~default:(Option.get vm_to_start)) + () + in + ( match vm_info.group with + | None -> + () + | Some group_name -> + let group = + match Db.VM_group.get_by_name_label ~__context ~label:group_name with + | g :: _ -> + g + | [] -> + T.make_vm_group ~__context ~placement:`anti_affinity + ~name_label:group_name () + in + Db.VM.set_groups ~__context ~self:vm ~value:[group] + ) ; + ( match vm_info.host with + | None -> + () + | Some host_name -> ( + let host = + match Db.Host.get_by_name_label ~__context ~label:host_name with + | h :: _ -> + h + | [] -> + Alcotest.fail "Can not find any host by name_label" + in + match vm_info.state with + | Running -> + Db.VM.set_power_state ~__context ~self:vm ~value:`Running ; + Db.VM.set_resident_on ~__context ~self:vm ~value:host + | Starting -> + Db.VM.set_power_state ~__context ~self:vm ~value:`Halted ; + Db.VM.set_scheduled_to_be_resident_on ~__context ~self:vm + ~value:host + | Migrating -> + Db.VM.set_power_state ~__context ~self:vm ~value:`Running ; + Db.VM.set_scheduled_to_be_resident_on ~__context ~self:vm + ~value:host ; + let other_hosts = + Db.Host.get_all ~__context + |> List.filter (fun h -> + Db.Host.get_name_label ~__context ~self:h <> host_name + ) + in + let other = match other_hosts with h :: _ -> h | [] -> Ref.null in + Db.VM.set_resident_on ~__context ~self:vm ~value:other + | Suspended -> + Db.VM.set_power_state ~__context ~self:vm ~value:`Suspended + | Paused -> + Db.VM.set_power_state ~__context ~self:vm ~value:`Paused ; + Db.VM.set_resident_on ~__context ~self:vm ~value:host + | Halted -> + Db.VM.set_power_state ~__context ~self:vm ~value:`Halted + ) + ) ; + vm + + let check_anti_affinity_grouping ~__context ~vm ~group expected_grouping = + let host_lists = rank_hosts_by_placement ~__context ~vm ~group in + assert_equivalent_for_grouping expected_grouping host_lists + + let test {vm_to_start; other_vms; hosts; affinity_host; expected; _} () = + let __context = T.make_test_database () in + make_hosts ~__context ~hosts ; + let vm = make_vm_based_on_vm_info ~__context ~vm_info:vm_to_start in + let _ = + List.map + (fun vm -> make_vm_based_on_vm_info ~__context ~vm_info:vm) + other_vms + in + Db.VM.set_affinity ~__context ~self:vm + ~value: + ( match affinity_host with + | None -> + Ref.null + | Some host_name -> ( + match Db.Host.get_by_name_label ~__context ~label:host_name with + | h :: _ -> + h + | [] -> + Alcotest.fail "Can not find any host by name_label" + ) + ) ; + let group = + match Db.VM.get_groups ~__context ~self:vm with + | g :: _ -> + g + | [] -> + Alcotest.fail "The VM is not associated with any group" + in + check_anti_affinity_grouping ~__context ~vm ~group + (List.map + (fun list -> + List.map + (fun h -> + match + Db.Host.get_by_name_label ~__context ~label:(Option.get h) + with + | h :: _ -> + h + | [] -> + Alcotest.fail "Can not find any host by name_label" + ) + list + ) + expected + ) + + let generate_tests case = (case.description, `Quick, test case) + + let tests = List.map generate_tests test_cases +end + let test = [ ("test_gpus_available_succeeds", `Quick, test_gpus_available_succeeds) @@ -612,14 +1105,24 @@ let test = , `Quick , test_group_hosts_netsriov_with_allocated ) + ; ( "test_get_group_key_anti_affinity" + , `Quick + , test_get_group_key_anti_affinity + ) + ; ("test_get_group_key_normal_group", `Quick, test_get_group_key_normal_group) ; ("test_get_group_key_vgpu", `Quick, test_get_group_key_vgpu) ; ("test_get_group_key_netsriov", `Quick, test_get_group_key_netsriov) ; ( "test_get_group_key_vgpu_and_netsriov" , `Quick , test_get_group_key_vgpu_and_netsriov ) + ; ( "test_get_group_key_anti_affinity_and_vgpu_and_netsriov" + , `Quick + , test_get_group_key_anti_affinity_and_vgpu_and_netsriov + ) ] let () = Suite_init.harness_init () ; - Alcotest.run "Test VM Helpers suite" [("Test_vm_helpers", test)] + Alcotest.run "Test VM Helpers suite" + [("Test_vm_helpers", test @ VMAntiAffinityRankedGrpTest.tests)] From 506fb31a7cb1b3889ac08e8061c563bed45e46a2 Mon Sep 17 00:00:00 2001 From: Bengang Yuan Date: Sun, 28 Apr 2024 14:35:29 +0800 Subject: [PATCH 06/19] CA-392177: Keep current group after reverting from snapshot When reverting to a snapshot, "groups" needs to be in `do_not_copy` to reserve the latest value of the VM. Signed-off-by: Bengang Yuan --- ocaml/xapi/xapi_vm_snapshot.ml | 1 + 1 file changed, 1 insertion(+) diff --git a/ocaml/xapi/xapi_vm_snapshot.ml b/ocaml/xapi/xapi_vm_snapshot.ml index b533aef5da4..28c77f920b9 100644 --- a/ocaml/xapi/xapi_vm_snapshot.ml +++ b/ocaml/xapi/xapi_vm_snapshot.ml @@ -383,6 +383,7 @@ let do_not_copy = "snapshots" ; "tags" ; "affinity" + ; "groups" ; (* Current fields should remain to get destroyed during revert process *) "consoles" ; "VBDs" From 69c8aaf1dabdba8d90a37d887dee5cf50f93398e Mon Sep 17 00:00:00 2001 From: Lunfan Zhang Date: Mon, 29 Apr 2024 06:22:59 -0400 Subject: [PATCH 07/19] CP-47656 Anti-affinity feature - resolve cycle dependency issue Resolve dependency cycling issue if we call Xapi_alerts inside pool_features. Error: dependency cycle between modules in _build/default/ocaml/xapi: Xha_statefile -> Sm -> Sm_exec -> Xapi_session -> Pool_features -> Xapi_vm_group_helpers -> Xapi_alert -> Xapi_http -> Xapi_session Signed-off-by: Lunfan Zhang --- ocaml/xapi/pool_features.ml | 81 -------------------- ocaml/xapi/pool_features.mli | 3 - ocaml/xapi/pool_features_helpers.ml | 108 +++++++++++++++++++++++++++ ocaml/xapi/pool_features_helpers.mli | 15 ++++ ocaml/xapi/xapi_host.ml | 4 +- ocaml/xapi/xapi_pool.ml | 2 +- 6 files changed, 126 insertions(+), 87 deletions(-) create mode 100755 ocaml/xapi/pool_features_helpers.ml create mode 100755 ocaml/xapi/pool_features_helpers.mli diff --git a/ocaml/xapi/pool_features.ml b/ocaml/xapi/pool_features.ml index d3a14dd5221..862f11e3004 100644 --- a/ocaml/xapi/pool_features.ml +++ b/ocaml/xapi/pool_features.ml @@ -15,20 +15,14 @@ open Features module D = Debug.Make (struct let name = "pool_features" end) -open D - (* Terminology: - (Feature) flags: The keys in pool.restriction and host.license_params. Strings like "restrict_dmc". - Params: An instance of host.license_params. - Restrictions: A (string * string) list of feature flag to a Boolean string value ("true" or "false"). - Features: Values of type Features.feature. - - Core: Relating to features known by xapi, as define in features.ml. - - Additional: Relating to features provided by v6d beyond the core ones. *) -let all_flags = List.map (fun (k, _) -> k) (to_assoc_list all_features) - let get_pool_features ~__context = let pool = Helpers.get_pool ~__context in of_assoc_list (Db.Pool.get_restrictions ~__context ~self:pool) @@ -43,78 +37,3 @@ let assert_enabled ~__context ~f = (Api_errors.Server_error (Api_errors.license_restriction, [name_of_feature f]) ) - -(* The set of core restrictions of a pool is the intersection of the sets of features - of the individual hosts. *) -let compute_core_features all_host_params = - List.map of_assoc_list all_host_params - |> List.fold_left Xapi_stdext_std.Listext.List.intersect all_features - -(* Find the feature flags in the given license params that are not represented - in the feature type. These are additional flags given to us by v6d. - Assume that their names always start with "restrict_". *) -let find_additional_flags params = - let kvs = - List.filter - (fun (k, _) -> - try String.sub k 0 9 = "restrict_" && not (List.mem k all_flags) - with Invalid_argument _ -> false - ) - params - in - List.map fst kvs - -(* Determine the set of additional features. For each restrict_ flag, - looks for matching flags on all hosts; if one of them is restricted ("true") - or absent, then the feature on the pool level is marked as restricted. *) -let rec compute_additional_restrictions all_host_params = function - | [] -> - [] - | flag :: rest -> - let switches = - List.map - (function - | params -> - if List.mem_assoc flag params then - bool_of_string (List.assoc flag params) - else - true - ) - all_host_params - in - (flag, string_of_bool (List.fold_left ( || ) false switches)) - :: compute_additional_restrictions all_host_params rest - -(* Combine the host-level feature restrictions into pool-level ones, and write - the result to the database. *) -let update_pool_features ~__context = - (* Get information from the database *) - let pool = Helpers.get_pool ~__context in - let old_restrictions = Db.Pool.get_restrictions ~__context ~self:pool in - let all_host_params = - List.map - (fun (_, host_r) -> host_r.API.host_license_params) - (Db.Host.get_all_records ~__context) - in - let master_params = - let master_ref = Db.Pool.get_master ~__context ~self:pool in - Db.Host.get_license_params ~__context ~self:master_ref - in - (* Determine the set of core restrictions *) - let new_core_features = compute_core_features all_host_params in - let new_core_restrictions = to_assoc_list new_core_features in - (* Determine the set of additional restrictions *) - let additional_flags = find_additional_flags master_params in - let new_additional_restrictions = - compute_additional_restrictions all_host_params additional_flags - in - (* The complete set of restrictions is formed by the core feature plus the additional features *) - let new_restrictions = new_additional_restrictions @ new_core_restrictions in - (* Update the DB if the restrictions have changed *) - if new_restrictions <> old_restrictions then ( - let old_core_features = of_assoc_list old_restrictions in - info "Old pool features enabled: %s" (to_compact_string old_core_features) ; - info "New pool features enabled: %s" (to_compact_string new_core_features) ; - Db.Pool.set_restrictions ~__context ~self:pool ~value:new_restrictions ; - Xapi_pool_helpers.apply_guest_agent_config ~__context - ) diff --git a/ocaml/xapi/pool_features.mli b/ocaml/xapi/pool_features.mli index 714c92ca757..9e4cbcef405 100644 --- a/ocaml/xapi/pool_features.mli +++ b/ocaml/xapi/pool_features.mli @@ -20,6 +20,3 @@ val is_enabled : __context:Context.t -> Features.feature -> bool val assert_enabled : __context:Context.t -> f:Features.feature -> unit (** Raise appropriate exception if feature is not enabled. *) - -val update_pool_features : __context:Context.t -> unit -(** Update the pool-level restrictions list in the database. *) diff --git a/ocaml/xapi/pool_features_helpers.ml b/ocaml/xapi/pool_features_helpers.ml new file mode 100755 index 00000000000..a732320271a --- /dev/null +++ b/ocaml/xapi/pool_features_helpers.ml @@ -0,0 +1,108 @@ +(* + * Copyright (C) 2024 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. + *) + +open Features + +module D = Debug.Make (struct let name = "pool_features_helpers" end) + +open D + +(* + Terminology: + - (Feature) flags: The keys in pool.restriction and host.license_params. Strings like "restrict_dmc". + - Params: An instance of host.license_params. + - Restrictions: A (string * string) list of feature flag to a Boolean string value ("true" or "false"). + - Features: Values of type Features.feature. + - Core: Relating to features known by xapi, as define in features.ml. + - Additional: Relating to features provided by v6d beyond the core ones. +*) + +let all_flags = List.map (fun (k, _) -> k) (to_assoc_list all_features) + +(* The set of core restrictions of a pool is the intersection of the sets of features + of the individual hosts. *) +let compute_core_features all_host_params = + List.map of_assoc_list all_host_params + |> List.fold_left Xapi_stdext_std.Listext.List.intersect all_features + +(* Find the feature flags in the given license params that are not represented + in the feature type. These are additional flags given to us by v6d. + Assume that their names always start with "restrict_". *) +let find_additional_flags params = + let kvs = + List.filter + (fun (k, _) -> + try String.sub k 0 9 = "restrict_" && not (List.mem k all_flags) + with Invalid_argument _ -> false + ) + params + in + List.map fst kvs + +(* Determine the set of additional features. For each restrict_ flag, + looks for matching flags on all hosts; if one of them is restricted ("true") + or absent, then the feature on the pool level is marked as restricted. *) +let rec compute_additional_restrictions all_host_params = function + | [] -> + [] + | flag :: rest -> + let switches = + List.map + (function + | params -> + if List.mem_assoc flag params then + bool_of_string (List.assoc flag params) + else + true + ) + all_host_params + in + (flag, string_of_bool (List.fold_left ( || ) false switches)) + :: compute_additional_restrictions all_host_params rest + +(* Combine the host-level feature restrictions into pool-level ones, and write + the result to the database. *) +let update_pool_features ~__context = + (* Get information from the database *) + let pool = Helpers.get_pool ~__context in + let old_restrictions = Db.Pool.get_restrictions ~__context ~self:pool in + let all_host_params = + List.map + (fun (_, host_r) -> host_r.API.host_license_params) + (Db.Host.get_all_records ~__context) + in + let master_params = + let master_ref = Db.Pool.get_master ~__context ~self:pool in + Db.Host.get_license_params ~__context ~self:master_ref + in + (* Determine the set of core restrictions *) + let new_core_features = compute_core_features all_host_params in + let new_core_restrictions = to_assoc_list new_core_features in + (* Determine the set of additional restrictions *) + let additional_flags = find_additional_flags master_params in + let new_additional_restrictions = + compute_additional_restrictions all_host_params additional_flags + in + (* The complete set of restrictions is formed by the core feature plus the additional features *) + let new_restrictions = new_additional_restrictions @ new_core_restrictions in + (* Update the DB if the restrictions have changed *) + if new_restrictions <> old_restrictions then ( + let old_core_features = of_assoc_list old_restrictions in + info "Old pool features enabled: %s" (to_compact_string old_core_features) ; + info "New pool features enabled: %s" (to_compact_string new_core_features) ; + Db.Pool.set_restrictions ~__context ~self:pool ~value:new_restrictions ; + Xapi_vm_group_helpers.update_vm_placement_alert_when_restriction_change + ~__context ~old_restrictions ~new_restrictions ; + Xapi_pool_helpers.apply_guest_agent_config ~__context + ) diff --git a/ocaml/xapi/pool_features_helpers.mli b/ocaml/xapi/pool_features_helpers.mli new file mode 100755 index 00000000000..1b7c52ff1fe --- /dev/null +++ b/ocaml/xapi/pool_features_helpers.mli @@ -0,0 +1,15 @@ +(* + * Copyright (C) 2024 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. + *) + +val update_pool_features : __context:Context.t -> unit diff --git a/ocaml/xapi/xapi_host.ml b/ocaml/xapi/xapi_host.ml index 768f33aba7b..f366b7414db 100644 --- a/ocaml/xapi/xapi_host.ml +++ b/ocaml/xapi/xapi_host.ml @@ -1120,7 +1120,7 @@ let destroy ~__context ~self = Db.Host.destroy ~__context ~self ; Create_misc.create_pool_cpuinfo ~__context ; List.iter (fun vm -> Db.VM.destroy ~__context ~self:vm) my_control_domains ; - Pool_features.update_pool_features ~__context + Pool_features_helpers.update_pool_features ~__context let declare_dead ~__context ~host = precheck_destroy_declare_dead ~__context ~self:host "declare_dead" ; @@ -2032,7 +2032,7 @@ let copy_license_to_db ~__context ~host:_ ~features ~additional = let set_license_params ~__context ~self ~value = Db.Host.set_license_params ~__context ~self ~value ; - Pool_features.update_pool_features ~__context + Pool_features_helpers.update_pool_features ~__context let apply_edition_internal ~__context ~host ~edition ~additional = (* Get localhost's current license state. *) diff --git a/ocaml/xapi/xapi_pool.ml b/ocaml/xapi/xapi_pool.ml index f4736a1a61f..cbd4fc03453 100644 --- a/ocaml/xapi/xapi_pool.ml +++ b/ocaml/xapi/xapi_pool.ml @@ -1991,7 +1991,7 @@ let eject ~__context ~host = Create_misc.create_pool_cpuinfo ~__context ; (* Update pool features, in case this host had a different license to the * rest of the pool. *) - Pool_features.update_pool_features ~__context + Pool_features_helpers.update_pool_features ~__context | true, true -> raise Cannot_eject_master From 22259d0f1d6a82dc7fa0c93cb2fefb7851c47661 Mon Sep 17 00:00:00 2001 From: Lunfan Zhang Date: Mon, 29 Apr 2024 06:58:50 -0400 Subject: [PATCH 08/19] CP-47656 Anti-affinity feature generate alert The generation of breach alerts during operations on VMs or groups, triggered when all running VMs within a group are breached (i.e., placed on the same host). The following may generate or dismiss alerts: Starting and resuming a VM. Stopping and suspending a VM. Pausing and unpausing a VM. Migrating a VM. Moving a VM from one group to another. Destroying a VM group. Changing the license from Premium to Standard dismisses all breach alerts, while changing from Standard to Premium generates them. In other scenarios, such as when a VM changes state from paused to shutdown, rebooting the VM will not trigger or dismiss alerts. Signed-off-by: Lunfan Zhang --- ocaml/xapi-consts/api_messages.ml | 3 + ocaml/xapi/message_forwarding.ml | 7 +- ocaml/xapi/pool_features.ml | 2 - ocaml/xapi/pool_features_helpers.ml | 6 +- ocaml/xapi/pool_features_helpers.mli | 2 +- ocaml/xapi/xapi_vm_group_helpers.ml | 205 +++++++++++++++++++++++++++ ocaml/xapi/xapi_vm_group_helpers.mli | 44 ++++++ ocaml/xapi/xapi_vm_lifecycle.ml | 4 + ocaml/xapi/xapi_vm_migrate.ml | 4 +- 9 files changed, 269 insertions(+), 8 deletions(-) mode change 100755 => 100644 ocaml/xapi/pool_features_helpers.ml create mode 100644 ocaml/xapi/xapi_vm_group_helpers.ml create mode 100644 ocaml/xapi/xapi_vm_group_helpers.mli diff --git a/ocaml/xapi-consts/api_messages.ml b/ocaml/xapi-consts/api_messages.ml index bb63facfe2a..5d9160152c2 100644 --- a/ocaml/xapi-consts/api_messages.ml +++ b/ocaml/xapi-consts/api_messages.ml @@ -365,3 +365,6 @@ let periodic_update_sync_failed = addMessage "PERIODIC_UPDATE_SYNC_FAILED" 3L let xapi_startup_blocked_as_version_higher_than_coordinator = addMessage "XAPI_STARTUP_BLOCKED_AS_VERSION_HIGHER_THAN_COORDINATOR" 2L + +let all_running_vms_in_anti_affinity_grp_on_single_host = + addMessage "ALL_RUNNING_VMS_IN_ANTI_AFFINITY_GRP_ON_SINGLE_HOST" 3L diff --git a/ocaml/xapi/message_forwarding.ml b/ocaml/xapi/message_forwarding.ml index 06fbe9ceb13..bee46eb6925 100644 --- a/ocaml/xapi/message_forwarding.ml +++ b/ocaml/xapi/message_forwarding.ml @@ -3011,7 +3011,10 @@ functor info "VM.set_groups : self = '%s'; value = [ %s ]" (vm_uuid ~__context self) (String.concat "; " (List.map (vm_group_uuid ~__context) value)) ; - Local.VM.set_groups ~__context ~self ~value + let original_groups = Db.VM.get_groups ~__context ~self in + Local.VM.set_groups ~__context ~self ~value ; + Xapi_vm_group_helpers.update_vm_anti_affinity_alert ~__context + ~groups:(original_groups @ value) let import_convert ~__context ~_type ~username ~password ~sr ~remote_config = @@ -6564,6 +6567,8 @@ functor let destroy ~__context ~self = info "VM_group.destroy: self = '%s'" (vm_group_uuid ~__context self) ; + Xapi_vm_group_helpers.remove_vm_anti_affinity_alert ~__context + ~groups:[self] ; Local.VM_group.destroy ~__context ~self end diff --git a/ocaml/xapi/pool_features.ml b/ocaml/xapi/pool_features.ml index 862f11e3004..8821224872a 100644 --- a/ocaml/xapi/pool_features.ml +++ b/ocaml/xapi/pool_features.ml @@ -13,8 +13,6 @@ open Features -module D = Debug.Make (struct let name = "pool_features" end) - (* Terminology: - (Feature) flags: The keys in pool.restriction and host.license_params. Strings like "restrict_dmc". diff --git a/ocaml/xapi/pool_features_helpers.ml b/ocaml/xapi/pool_features_helpers.ml old mode 100755 new mode 100644 index a732320271a..dda8619013c --- a/ocaml/xapi/pool_features_helpers.ml +++ b/ocaml/xapi/pool_features_helpers.ml @@ -1,5 +1,5 @@ (* - * Copyright (C) 2024 Cloud Software Group + * Copyright (c) 2024 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 @@ -102,7 +102,7 @@ let update_pool_features ~__context = info "Old pool features enabled: %s" (to_compact_string old_core_features) ; info "New pool features enabled: %s" (to_compact_string new_core_features) ; Db.Pool.set_restrictions ~__context ~self:pool ~value:new_restrictions ; - Xapi_vm_group_helpers.update_vm_placement_alert_when_restriction_change - ~__context ~old_restrictions ~new_restrictions ; + Xapi_vm_group_helpers.maybe_update_alerts_on_feature_change ~__context + ~old_restrictions ~new_restrictions ; Xapi_pool_helpers.apply_guest_agent_config ~__context ) diff --git a/ocaml/xapi/pool_features_helpers.mli b/ocaml/xapi/pool_features_helpers.mli index 1b7c52ff1fe..d5d610a3544 100755 --- a/ocaml/xapi/pool_features_helpers.mli +++ b/ocaml/xapi/pool_features_helpers.mli @@ -1,5 +1,5 @@ (* - * Copyright (C) 2024 Cloud Software Group + * Copyright (c) 2024 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 diff --git a/ocaml/xapi/xapi_vm_group_helpers.ml b/ocaml/xapi/xapi_vm_group_helpers.ml new file mode 100644 index 00000000000..82d9ebc3508 --- /dev/null +++ b/ocaml/xapi/xapi_vm_group_helpers.ml @@ -0,0 +1,205 @@ +(* + * Copyright (c) 2024 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 = "xapi_vm_group_helpers" end) + +open D + +(** Check the breach state of a group. + When there are no VMs or only one VM in the group, it is not considered a breach. + when there are two or more VMs and all of them are on the same host, it is considered a breach, and the specific host is returned. +*) +let check_breach_on_vm_anti_affinity_rules ~__context ~group = + Db.VM_group.get_VMs ~__context ~self:group + |> List.filter_map (fun vm -> + let vm_rec = Db.VM.get_record ~__context ~self:vm in + match (vm_rec.API.vM_power_state, vm_rec.API.vM_resident_on) with + | `Running, h when h <> Ref.null -> + Some h + | _ -> + None + ) + |> function + | [] | [_] -> + None + | h :: remaining -> + if List.exists (fun h' -> h' <> h) remaining then + None + else + Some h + +let report_anti_affinity_alert ~__context ~group ~host = + let group_uuid = Db.VM_group.get_uuid ~__context ~self:group in + let host_uuid = Db.Host.get_uuid ~__context ~self:host in + let body = + String.concat "" + [ + "Breach on VM anti-affinity rules" + ; group_uuid + ; "" + ; host_uuid + ; "" + ] + in + let obj_uuid = + Db.Pool.get_uuid ~__context ~self:(Helpers.get_pool ~__context) + in + Xapi_alert.add + ~msg:Api_messages.all_running_vms_in_anti_affinity_grp_on_single_host + ~cls:`Pool ~obj_uuid ~body + +let get_anti_affinity_alerts ~__context = + Helpers.call_api_functions ~__context (fun rpc session_id -> + Client.Client.Message.get_all_records ~rpc ~session_id + ) + |> List.filter (fun (_, record) -> + record.API.message_name + = fst Api_messages.all_running_vms_in_anti_affinity_grp_on_single_host + ) + +let alert_matched ~__context ~label_name ~id alert = + let alert_rec = snd alert in + match Xml.parse_string alert_rec.API.message_body with + | Xml.Element ("body", _, children) -> ( + let filtered = + List.filter_map + (function + | Xml.Element (name, _, [Xml.PCData v]) when name = label_name -> + Some v + | _ -> + None + ) + children + in + match filtered with [uuid] when uuid = id -> true | _ -> false + ) + | _ -> + let msg = "Invalid message body of VM group alert" in + error "%s" msg ; + raise Api_errors.(Server_error (internal_error, [msg])) + | exception e -> + let msg = Printf.sprintf "%s" (ExnHelper.string_of_exn e) in + error "%s" msg ; + raise Api_errors.(Server_error (internal_error, [msg])) + +let filter_alerts_with_group ~__context ~group ~alerts = + let group_uuid = Db.VM_group.get_uuid ~__context ~self:group in + List.filter + (alert_matched ~__context ~label_name:"VM_group" ~id:group_uuid) + alerts + +let filter_alerts_with_host ~__context ~host ~alerts = + let host_uuid = Db.Host.get_uuid ~__context ~self:host in + List.filter (alert_matched ~__context ~label_name:"host" ~id:host_uuid) alerts + +(** If it is a breach and no alerts exist, generate one, + If it is not a breach and alerts exist, dismiss the existing alert *) +let update_vm_anti_affinity_alert_for_group ~__context ~group ~alerts = + let breach_on_host = + check_breach_on_vm_anti_affinity_rules ~__context ~group + in + debug "[Anti-affinity] existing alerts of group (UUID: %s) is: %d" + (Db.VM_group.get_uuid ~__context ~self:group) + (List.length alerts) ; + match (alerts, breach_on_host) with + | [], Some host -> + report_anti_affinity_alert ~__context ~group ~host + | alerts, None -> + List.iter + (fun (ref, _) -> + Helpers.call_api_functions ~__context (fun rpc session_id -> + Client.Client.Message.destroy ~rpc ~session_id ~self:ref + ) + ) + alerts + | alerts, Some host when filter_alerts_with_host ~__context ~host ~alerts = [] + -> + List.iter + (fun (ref, _) -> + Helpers.call_api_functions ~__context (fun rpc session_id -> + Client.Client.Message.destroy ~rpc ~session_id ~self:ref + ) + ) + alerts ; + report_anti_affinity_alert ~__context ~group ~host + | _, _ -> + () + +let maybe_update_vm_anti_affinity_alert_for_vm ~__context ~vm = + try + Db.VM.get_groups ~__context ~self:vm + |> List.filter (fun g -> + Db.VM_group.get_placement ~__context ~self:g = `anti_affinity + ) + |> function + | [] -> + () + | group :: _ -> + let alerts = get_anti_affinity_alerts ~__context in + let alerts_of_group = + filter_alerts_with_group ~__context ~group ~alerts + in + update_vm_anti_affinity_alert_for_group ~__context ~group + ~alerts:alerts_of_group + with e -> error "%s" (Printexc.to_string e) + +let remove_vm_anti_affinity_alert_for_group ~__context ~group ~alerts = + debug "[Anti-affinity] remove alert for group:%s" + (Db.VM_group.get_uuid ~__context ~self:group) ; + List.iter + (fun (ref, _) -> + Helpers.call_api_functions ~__context (fun rpc session_id -> + Client.Client.Message.destroy ~rpc ~session_id ~self:ref + ) + ) + alerts + +let update_alert ~__context ~groups ~action = + try + let alerts = get_anti_affinity_alerts ~__context in + groups + |> List.filter (fun g -> + Db.VM_group.get_placement ~__context ~self:g = `anti_affinity + ) + |> List.iter (fun group -> + let alerts_of_group = + filter_alerts_with_group ~__context ~group ~alerts + in + action ~__context ~group ~alerts:alerts_of_group + ) + with e -> error "%s" (Printexc.to_string e) + +let update_vm_anti_affinity_alert ~__context ~groups = + update_alert ~__context ~groups + ~action:update_vm_anti_affinity_alert_for_group + +let remove_vm_anti_affinity_alert ~__context ~groups = + update_alert ~__context ~groups + ~action:remove_vm_anti_affinity_alert_for_group + +let maybe_update_alerts_on_feature_change ~__context ~old_restrictions + ~new_restrictions = + try + let is_enabled restrictions = + List.mem Features.VM_anti_affinity (Features.of_assoc_list restrictions) + in + let groups = Db.VM_group.get_all ~__context in + match (is_enabled old_restrictions, is_enabled new_restrictions) with + | false, true -> + update_vm_anti_affinity_alert ~__context ~groups + | true, false -> + remove_vm_anti_affinity_alert ~__context ~groups + | _, _ -> + () + with e -> error "%s" (Printexc.to_string e) diff --git a/ocaml/xapi/xapi_vm_group_helpers.mli b/ocaml/xapi/xapi_vm_group_helpers.mli new file mode 100644 index 00000000000..310ca5568e9 --- /dev/null +++ b/ocaml/xapi/xapi_vm_group_helpers.mli @@ -0,0 +1,44 @@ +(* + * Copyright (c) 2024 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. + *) + +val maybe_update_vm_anti_affinity_alert_for_vm : + __context:Context.t -> vm:[`VM] API.Ref.t -> unit +(** updates VM anti-affinity alert with a given VM.*) + +val remove_vm_anti_affinity_alert : + __context:Context.t -> groups:[`VM_group] API.Ref.t list -> unit +(** removes VM anti-affinity alert with given groups.*) + +val update_vm_anti_affinity_alert : + __context:Context.t -> groups:[`VM_group] API.Ref.t list -> unit +(** updates VM anti-affinity alert with given groups.*) + +val maybe_update_alerts_on_feature_change : + __context:Context.t + -> old_restrictions:(string * string) list + -> new_restrictions:(string * string) list + -> unit +(** Updates the VM anti-affinity alert only when Features.VM_anti_affinity changes. + + @param __context The context information. + @param old_restrictions The old feature restrictions represented as an association list. + Each entry in the list contains a feature identifier and its corresponding restriction status. + @param new_restrictions The new feature restrictions represented as an association list. + Each entry in the list contains a feature identifier and its corresponding restriction status. + Example: + [ + ("restrict_vlan", "true"); + ("restrict_vm_anti_affinity", "false") + ] +*) diff --git a/ocaml/xapi/xapi_vm_lifecycle.ml b/ocaml/xapi/xapi_vm_lifecycle.ml index ccee66500cd..2f6130641df 100644 --- a/ocaml/xapi/xapi_vm_lifecycle.ml +++ b/ocaml/xapi/xapi_vm_lifecycle.ml @@ -850,6 +850,7 @@ let remove_pending_guidance ~__context ~self ~value = 2. Called on update VM when the power state changes *) let force_state_reset_keep_current_operations ~__context ~self ~value:state = (* First update the power_state. Some operations below indirectly rely on this. *) + let old_state = Db.VM.get_power_state ~__context ~self in Db.VM.set_power_state ~__context ~self ~value:state ; if state = `Suspended then remove_pending_guidance ~__context ~self ~value:`restart_device_model ; @@ -941,6 +942,9 @@ let force_state_reset_keep_current_operations ~__context ~self ~value:state = (Db.PCI.get_all ~__context) ) ; update_allowed_operations ~__context ~self ; + if old_state <> state && (old_state = `Running || state = `Running) then + Xapi_vm_group_helpers.maybe_update_vm_anti_affinity_alert_for_vm ~__context + ~vm:self ; if state = `Halted then (* archive the rrd for this vm *) let vm_uuid = Db.VM.get_uuid ~__context ~self in let master_address = Pool_role.get_master_address_opt () in diff --git a/ocaml/xapi/xapi_vm_migrate.ml b/ocaml/xapi/xapi_vm_migrate.ml index 13d112fd3ce..43993c4fcf9 100644 --- a/ocaml/xapi/xapi_vm_migrate.ml +++ b/ocaml/xapi/xapi_vm_migrate.ml @@ -490,7 +490,9 @@ let pool_migrate_complete ~__context ~vm ~host:_ = Xapi_xenops.add_caches id ; Xapi_xenops.refresh_vm ~__context ~self:vm ; Monitor_dbcalls_cache.clear_cache_for_vm ~vm_uuid:id - ) + ) ; + Xapi_vm_group_helpers.maybe_update_vm_anti_affinity_alert_for_vm ~__context + ~vm type mirror_record = { mr_mirrored: bool From ab19a9c882cf94260557b4479510e4f2f818bef1 Mon Sep 17 00:00:00 2001 From: Bengang Yuan Date: Tue, 21 May 2024 16:39:43 +0800 Subject: [PATCH 09/19] CP-48570: Add a field 'recommendations' in pool The recommendations are read from files '/etc/xapi.pool-recommendations.d/*' and exposed to clients. They are read-only and only for clients, hence they don't impact the behavior of Xapi directly but only indirectly as they inform a client's behavior. Signed-off-by: Bengang Yuan --- ocaml/idl/datamodel_pool.ml | 5 +++++ ocaml/idl/schematest.ml | 2 +- ocaml/tests/common/test_common.ml | 5 +++-- ocaml/xapi-cli-server/records.ml | 6 ++++++ ocaml/xapi/dbsync_master.ml | 2 +- 5 files changed, 16 insertions(+), 4 deletions(-) diff --git a/ocaml/idl/datamodel_pool.ml b/ocaml/idl/datamodel_pool.ml index f556cf56407..249923c73e2 100644 --- a/ocaml/idl/datamodel_pool.ml +++ b/ocaml/idl/datamodel_pool.ml @@ -1490,6 +1490,11 @@ let t = ; field ~qualifier:DynamicRO ~lifecycle:[] ~ty:Bool ~default_value:(Some (VBool false)) "update_sync_enabled" "Whether periodic update synchronization is enabled or not" + ; field ~qualifier:DynamicRO ~lifecycle:[] + ~ty:(Map (String, String)) + ~default_value:(Some (VMap [])) "recommendations" + "The recommended pool properties for clients to respect for \ + optimal performance. e.g. max-vm-group=5" ] ) () diff --git a/ocaml/idl/schematest.ml b/ocaml/idl/schematest.ml index 9d374a66e2c..2d839624ff3 100644 --- a/ocaml/idl/schematest.ml +++ b/ocaml/idl/schematest.ml @@ -3,7 +3,7 @@ let hash x = Digest.string x |> Digest.to_hex (* BEWARE: if this changes, check that schema has been bumped accordingly in ocaml/idl/datamodel_common.ml, usually schema_minor_vsn *) -let last_known_schema_hash = "81ba6b9699b3f6c2969dd5510cbbe4aa" +let last_known_schema_hash = "024b6ce32246d7549898310675631d51" let current_schema_hash : string = let open Datamodel_types in diff --git a/ocaml/tests/common/test_common.ml b/ocaml/tests/common/test_common.ml index cb7b24af99e..66ebe152627 100644 --- a/ocaml/tests/common/test_common.ml +++ b/ocaml/tests/common/test_common.ml @@ -298,7 +298,8 @@ let make_pool ~__context ~master ?(name_label = "") ?(name_description = "") ?(telemetry_uuid = Ref.null) ?(telemetry_frequency = `weekly) ?(telemetry_next_collection = API.Date.never) ?(last_update_sync = API.Date.epoch) ?(update_sync_frequency = `daily) - ?(update_sync_day = 0L) ?(update_sync_enabled = false) () = + ?(update_sync_day = 0L) ?(update_sync_enabled = false) + ?(recommendations = []) () = let pool_ref = Ref.make () in Db.Pool.create ~__context ~ref:pool_ref ~uuid:(make_uuid ()) ~name_label ~name_description ~master ~default_SR ~suspend_image_SR ~crash_dump_SR @@ -316,7 +317,7 @@ let make_pool ~__context ~master ?(name_label = "") ?(name_description = "") ~migration_compression ~coordinator_bias ~telemetry_uuid ~telemetry_frequency ~telemetry_next_collection ~last_update_sync ~local_auth_max_threads:8L ~ext_auth_max_threads:8L ~update_sync_frequency - ~update_sync_day ~update_sync_enabled ; + ~update_sync_day ~update_sync_enabled ~recommendations ; pool_ref let default_sm_features = diff --git a/ocaml/xapi-cli-server/records.ml b/ocaml/xapi-cli-server/records.ml index 2a78e105e5b..8b74ae360e9 100644 --- a/ocaml/xapi-cli-server/records.ml +++ b/ocaml/xapi-cli-server/records.ml @@ -1493,6 +1493,12 @@ let pool_record rpc session_id pool = ; make_field ~name:"update-sync-enabled" ~get:(fun () -> (x ()).API.pool_update_sync_enabled |> string_of_bool) () + ; make_field ~name:"recommendations" + ~get:(fun () -> + Record_util.s2sm_to_string "; " (x ()).API.pool_recommendations + ) + ~get_map:(fun () -> (x ()).API.pool_recommendations) + () ] } diff --git a/ocaml/xapi/dbsync_master.ml b/ocaml/xapi/dbsync_master.ml index 5cdc4b9106e..95626a9c98c 100644 --- a/ocaml/xapi/dbsync_master.ml +++ b/ocaml/xapi/dbsync_master.ml @@ -53,7 +53,7 @@ let create_pool_record ~__context = ~last_update_sync:Xapi_stdext_date.Date.epoch ~update_sync_frequency:`weekly ~update_sync_day:0L ~update_sync_enabled:false ~local_auth_max_threads:8L - ~ext_auth_max_threads:1L + ~ext_auth_max_threads:1L ~recommendations:[] let set_master_ip ~__context = let ip = From 1f9d39e4e66d68f7ff652e7fa14d0ca86d3b8d5d Mon Sep 17 00:00:00 2001 From: Bengang Yuan Date: Tue, 21 May 2024 16:40:36 +0800 Subject: [PATCH 10/19] CP-48570: Load recommendations from config file when Xapi starts The recommendations are read from '/etc/xapi.pool-recommendations.d/*.conf'. When Xapi starts, it will read each file and update the recommendations into the database. If we need to add recommendations to other type objects, e.g. host, VM, etc in the future, just add a similar 'xapi.*-recommendations.d' directory and define the path in xapi_globs. Signed-off-by: Bengang Yuan --- ocaml/xapi/dbsync_master.ml | 16 ++++++++++- ocaml/xapi/recommendations.ml | 50 ++++++++++++++++++++++++++++++++++ ocaml/xapi/recommendations.mli | 17 ++++++++++++ ocaml/xapi/xapi_globs.ml | 6 ++++ 4 files changed, 88 insertions(+), 1 deletion(-) create mode 100644 ocaml/xapi/recommendations.ml create mode 100644 ocaml/xapi/recommendations.mli diff --git a/ocaml/xapi/dbsync_master.ml b/ocaml/xapi/dbsync_master.ml index 95626a9c98c..fc6584a3f67 100644 --- a/ocaml/xapi/dbsync_master.ml +++ b/ocaml/xapi/dbsync_master.ml @@ -19,6 +19,7 @@ module D = Debug.Make (struct let name = "dbsync" end) open D open Client +open Recommendations (* Synchronising code which is specific to the master *) @@ -336,6 +337,18 @@ let setup_telemetry ~__context = ) () +let update_pool_recommendations_noexn ~__context = + Helpers.log_exn_continue "update pool recommendations" + (fun () -> + let pool = Helpers.get_pool ~__context in + let recommendations = + Recommendations.load ~path:!Xapi_globs.pool_recommendations_dir + |> StringMap.bindings + in + Db.Pool.set_recommendations ~__context ~self:pool ~value:recommendations + ) + () + (* Update the database to reflect current state. Called for both start of day and after an agent restart. *) let update_env __context = @@ -360,4 +373,5 @@ let update_env __context = Storage_access.on_xapi_start ~__context ; if !Xapi_globs.create_tools_sr then create_tools_sr_noexn __context ; - ensure_vm_metrics_records_exist_noexn __context + ensure_vm_metrics_records_exist_noexn __context ; + update_pool_recommendations_noexn ~__context diff --git a/ocaml/xapi/recommendations.ml b/ocaml/xapi/recommendations.ml new file mode 100644 index 00000000000..be35ba1316a --- /dev/null +++ b/ocaml/xapi/recommendations.ml @@ -0,0 +1,50 @@ +(* + * Copyright (c) Cloud Software Group, Inc. + * + * 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 Unixext = Xapi_stdext_unix.Unixext +module Config_file = Xcp_service.Config_file + +module D = Debug.Make (struct let name = "recommendations" end) + +open D +module StringMap = Map.Make (String) + +let process_line map data = + match Config_file.parse_line data with + | Some (k, v) -> + debug "Parsing data, key: %s, value: %s" k v ; + StringMap.add k v map + | None -> + map + +let parse map filename = + debug "Parsing recommendations file: %s" filename ; + Unixext.file_lines_fold process_line map filename + +let load ~path = + (try Sys.readdir path with _ -> [||]) + |> Array.to_list + |> List.filter (fun f -> Filename.check_suffix f ".conf") + |> List.stable_sort compare + |> List.map (Filename.concat path) + |> List.filter (fun f -> + match Unix.((stat f).st_kind) with + | Unix.S_REG -> + true + | _ -> + false + | exception _ -> + false + ) + |> List.fold_left parse StringMap.empty diff --git a/ocaml/xapi/recommendations.mli b/ocaml/xapi/recommendations.mli new file mode 100644 index 00000000000..a97a4a39c6d --- /dev/null +++ b/ocaml/xapi/recommendations.mli @@ -0,0 +1,17 @@ +(* + * Copyright (c) Cloud Software Group, Inc. + * + * 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 StringMap : Map.S with type key = string + +val load : path:string -> string StringMap.t diff --git a/ocaml/xapi/xapi_globs.ml b/ocaml/xapi/xapi_globs.ml index 37e9f561537..ca913c57254 100644 --- a/ocaml/xapi/xapi_globs.ml +++ b/ocaml/xapi/xapi_globs.ml @@ -1023,6 +1023,8 @@ let python3_path = ref "/usr/bin/python3" let observer_experimental_components = ref (StringSet.singleton Constants.observer_component_smapi) +let pool_recommendations_dir = ref "/etc/xapi.pool-recommendations.d" + let xapi_globs_spec = [ ( "master_connection_reset_timeout" @@ -1803,6 +1805,10 @@ module Resources = struct , trace_log_dir , "Directory for storing traces exported to logs" ) + ; ( "pool-recommendations-dir" + , pool_recommendations_dir + , "Directory containing files with recommendations in key=value format" + ) ] let xcp_resources = From 606423e3dfa5e94043f913f4f466cfb5985cfaf3 Mon Sep 17 00:00:00 2001 From: Bengang Yuan Date: Tue, 30 Apr 2024 02:18:27 -0400 Subject: [PATCH 11/19] CP-48011: Xapi Support anti-affinity feature flag Check feature flag in these places: 1. VM start. 2. Host evacuation. When this PR is raised, the host evacuation PR is still in review. So this PR doesn't include the checking for host evacuation. It will be included in another new PR. 3. Create VM group. 4. VM.set_groups. Adding VMs to a group and removing VMs from a group are all forbidden. If customers need to remove VMs from a group, just destroy the group. 5. Send VM anti-affinity alerts. Also, based on our discussion, the name of feature is changed from `VM_anti_affinity` to `VM_group`. Signed-off-by: Bengang Yuan --- ocaml/xapi-types/features.ml | 6 +-- ocaml/xapi-types/features.mli | 2 +- ocaml/xapi/xapi_vm.ml | 1 + ocaml/xapi/xapi_vm_group.ml | 1 + ocaml/xapi/xapi_vm_group_helpers.ml | 56 ++++++++++++++++------------ ocaml/xapi/xapi_vm_group_helpers.mli | 4 +- ocaml/xapi/xapi_vm_helpers.ml | 30 +++++++++------ 7 files changed, 57 insertions(+), 43 deletions(-) diff --git a/ocaml/xapi-types/features.ml b/ocaml/xapi-types/features.ml index d55d7d01c37..97fc9b7f7f5 100644 --- a/ocaml/xapi-types/features.ml +++ b/ocaml/xapi-types/features.ml @@ -64,7 +64,7 @@ type feature = | Updates | Internal_repo_access | VTPM - | VM_anti_affinity + | VM_group [@@deriving rpc] type orientation = Positive | Negative @@ -133,9 +133,7 @@ let keys_of_features = , ("restrict_internal_repo_access", Negative, "Internal_repo_access") ) ; (VTPM, ("restrict_vtpm", Negative, "VTPM")) - ; ( VM_anti_affinity - , ("restrict_vm_anti_affinity", Negative, "VM_anti_affinity") - ) + ; (VM_group, ("restrict_vm_group", Negative, "VM_group")) ] (* A list of features that must be considered "enabled" by `of_assoc_list` diff --git a/ocaml/xapi-types/features.mli b/ocaml/xapi-types/features.mli index 0696b3ddb5e..bae1496dd78 100644 --- a/ocaml/xapi-types/features.mli +++ b/ocaml/xapi-types/features.mli @@ -72,7 +72,7 @@ type feature = | Internal_repo_access (** Enable restriction on repository access to pool members only *) | VTPM (** Support VTPM device required by Win11 guests *) - | VM_anti_affinity (** Enable use of VM anti-affinity placement *) + | VM_group (** Enable use of VM group *) val feature_of_rpc : Rpc.t -> feature (** Convert RPC into {!feature}s *) diff --git a/ocaml/xapi/xapi_vm.ml b/ocaml/xapi/xapi_vm.ml index e83bee43d15..93fbf05c8b0 100644 --- a/ocaml/xapi/xapi_vm.ml +++ b/ocaml/xapi/xapi_vm.ml @@ -1442,6 +1442,7 @@ let set_appliance ~__context ~self ~value = update_allowed_operations ~__context ~self let set_groups ~__context ~self ~value = + Pool_features.assert_enabled ~__context ~f:Features.VM_group ; if List.length value > 1 then raise Api_errors.(Server_error (Api_errors.too_many_groups, [])) ; Db.VM.set_groups ~__context ~self ~value diff --git a/ocaml/xapi/xapi_vm_group.ml b/ocaml/xapi/xapi_vm_group.ml index 0d77e9d3f51..f04d73e213a 100644 --- a/ocaml/xapi/xapi_vm_group.ml +++ b/ocaml/xapi/xapi_vm_group.ml @@ -15,6 +15,7 @@ module D = Debug.Make (struct let name = "xapi_vm_group" end) let create ~__context ~name_label ~name_description ~placement = + Pool_features.assert_enabled ~__context ~f:Features.VM_group ; let uuid = Uuidx.make () in let ref = Ref.make () in Db.VM_group.create ~__context ~ref ~uuid:(Uuidx.to_string uuid) ~name_label diff --git a/ocaml/xapi/xapi_vm_group_helpers.ml b/ocaml/xapi/xapi_vm_group_helpers.ml index 82d9ebc3508..0a05f41dd96 100644 --- a/ocaml/xapi/xapi_vm_group_helpers.ml +++ b/ocaml/xapi/xapi_vm_group_helpers.ml @@ -16,9 +16,11 @@ module D = Debug.Make (struct let name = "xapi_vm_group_helpers" end) open D -(** Check the breach state of a group. - When there are no VMs or only one VM in the group, it is not considered a breach. - when there are two or more VMs and all of them are on the same host, it is considered a breach, and the specific host is returned. +(* Check the breach state of a group. + When there are no VMs or only one VM in the group, it is not considered a + breach. + when there are two or more VMs and all of them are on the same host, it is + considered a breach, and the specific host is returned. *) let check_breach_on_vm_anti_affinity_rules ~__context ~group = Db.VM_group.get_VMs ~__context ~self:group @@ -103,8 +105,8 @@ let filter_alerts_with_host ~__context ~host ~alerts = let host_uuid = Db.Host.get_uuid ~__context ~self:host in List.filter (alert_matched ~__context ~label_name:"host" ~id:host_uuid) alerts -(** If it is a breach and no alerts exist, generate one, - If it is not a breach and alerts exist, dismiss the existing alert *) +(* If it is a breach and no alerts exist, generate one, + If it is not a breach and alerts exist, dismiss the existing alert *) let update_vm_anti_affinity_alert_for_group ~__context ~group ~alerts = let breach_on_host = check_breach_on_vm_anti_affinity_rules ~__context ~group @@ -137,22 +139,25 @@ let update_vm_anti_affinity_alert_for_group ~__context ~group ~alerts = () let maybe_update_vm_anti_affinity_alert_for_vm ~__context ~vm = - try - Db.VM.get_groups ~__context ~self:vm - |> List.filter (fun g -> - Db.VM_group.get_placement ~__context ~self:g = `anti_affinity - ) - |> function - | [] -> - () - | group :: _ -> - let alerts = get_anti_affinity_alerts ~__context in - let alerts_of_group = - filter_alerts_with_group ~__context ~group ~alerts - in - update_vm_anti_affinity_alert_for_group ~__context ~group - ~alerts:alerts_of_group - with e -> error "%s" (Printexc.to_string e) + if Pool_features.is_enabled ~__context Features.VM_group then + try + Db.VM.get_groups ~__context ~self:vm + |> List.filter (fun g -> + Db.VM_group.get_placement ~__context ~self:g = `anti_affinity + ) + |> function + | [] -> + () + | group :: _ -> + let alerts = get_anti_affinity_alerts ~__context in + let alerts_of_group = + filter_alerts_with_group ~__context ~group ~alerts + in + update_vm_anti_affinity_alert_for_group ~__context ~group + ~alerts:alerts_of_group + with e -> error "%s" (Printexc.to_string e) + else + debug "VM group feature is disabled, alert will not be updated" let remove_vm_anti_affinity_alert_for_group ~__context ~group ~alerts = debug "[Anti-affinity] remove alert for group:%s" @@ -181,8 +186,11 @@ let update_alert ~__context ~groups ~action = with e -> error "%s" (Printexc.to_string e) let update_vm_anti_affinity_alert ~__context ~groups = - update_alert ~__context ~groups - ~action:update_vm_anti_affinity_alert_for_group + if Pool_features.is_enabled ~__context Features.VM_group then + update_alert ~__context ~groups + ~action:update_vm_anti_affinity_alert_for_group + else + debug "VM group feature is disabled, alert will not be updated" let remove_vm_anti_affinity_alert ~__context ~groups = update_alert ~__context ~groups @@ -192,7 +200,7 @@ let maybe_update_alerts_on_feature_change ~__context ~old_restrictions ~new_restrictions = try let is_enabled restrictions = - List.mem Features.VM_anti_affinity (Features.of_assoc_list restrictions) + List.mem Features.VM_group (Features.of_assoc_list restrictions) in let groups = Db.VM_group.get_all ~__context in match (is_enabled old_restrictions, is_enabled new_restrictions) with diff --git a/ocaml/xapi/xapi_vm_group_helpers.mli b/ocaml/xapi/xapi_vm_group_helpers.mli index 310ca5568e9..c7ed83e39e1 100644 --- a/ocaml/xapi/xapi_vm_group_helpers.mli +++ b/ocaml/xapi/xapi_vm_group_helpers.mli @@ -29,7 +29,7 @@ val maybe_update_alerts_on_feature_change : -> old_restrictions:(string * string) list -> new_restrictions:(string * string) list -> unit -(** Updates the VM anti-affinity alert only when Features.VM_anti_affinity changes. +(** Updates the VM anti-affinity alert only when Features.VM_group changes. @param __context The context information. @param old_restrictions The old feature restrictions represented as an association list. @@ -39,6 +39,6 @@ val maybe_update_alerts_on_feature_change : Example: [ ("restrict_vlan", "true"); - ("restrict_vm_anti_affinity", "false") + ("restrict_vm_group", "false") ] *) diff --git a/ocaml/xapi/xapi_vm_helpers.ml b/ocaml/xapi/xapi_vm_helpers.ml index 2e07c7670cc..9d310d94eeb 100644 --- a/ocaml/xapi/xapi_vm_helpers.ml +++ b/ocaml/xapi/xapi_vm_helpers.ml @@ -913,18 +913,24 @@ let vm_can_run_on_host ~__context ~vm ~snapshot ~do_memory_check host = with _ -> false let vm_has_anti_affinity ~__context ~vm = - List.find_opt - (fun g -> Db.VM_group.get_placement ~__context ~self:g = `anti_affinity) - (Db.VM.get_groups ~__context ~self:vm) - |> Option.map (fun group -> - debug - "The VM (uuid %s) is associated with an anti-affinity group (uuid: \ - %s, name: %s)" - (Db.VM.get_uuid ~__context ~self:vm) - (Db.VM_group.get_uuid ~__context ~self:group) - (Db.VM_group.get_name_label ~__context ~self:group) ; - `AntiAffinity group - ) + if Pool_features.is_enabled ~__context Features.VM_group then + List.find_opt + (fun g -> Db.VM_group.get_placement ~__context ~self:g = `anti_affinity) + (Db.VM.get_groups ~__context ~self:vm) + |> Option.map (fun group -> + debug + "The VM (uuid %s) is associated with an anti-affinity group \ + (uuid: %s, name: %s)" + (Db.VM.get_uuid ~__context ~self:vm) + (Db.VM_group.get_uuid ~__context ~self:group) + (Db.VM_group.get_name_label ~__context ~self:group) ; + `AntiAffinity group + ) + else ( + debug + "VM group feature is disabled, ignore VM anti-affinity during VM start" ; + None + ) let vm_has_vgpu ~__context ~vm = match Db.VM.get_VGPUs ~__context ~self:vm with From 7fcef06a6858a7cdd6cfd2c925369b451c12db18 Mon Sep 17 00:00:00 2001 From: Bengang Yuan Date: Tue, 28 May 2024 09:46:57 +0100 Subject: [PATCH 12/19] CA-393421: Special VMs cannot be added to VM groups Control domains, templates, and snapshots cannot be added to VM groups. Signed-off-by: Bengang Yuan --- ocaml/idl/datamodel_vm.ml | 1 + ocaml/xapi/xapi_vm.ml | 14 ++++++++++++++ 2 files changed, 15 insertions(+) diff --git a/ocaml/idl/datamodel_vm.ml b/ocaml/idl/datamodel_vm.ml index 80622f8ea44..a6ddc015214 100644 --- a/ocaml/idl/datamodel_vm.ml +++ b/ocaml/idl/datamodel_vm.ml @@ -1521,6 +1521,7 @@ let set_groups = (Ref _vm, "self", "The VM") ; (Set (Ref _vm_group), "value", "The VM groups to set") ] + ~errs:[Api_errors.operation_not_allowed] ~allowed_roles:_R_VM_ADMIN () let call_plugin = diff --git a/ocaml/xapi/xapi_vm.ml b/ocaml/xapi/xapi_vm.ml index 93fbf05c8b0..c08877c54c7 100644 --- a/ocaml/xapi/xapi_vm.ml +++ b/ocaml/xapi/xapi_vm.ml @@ -1443,6 +1443,20 @@ let set_appliance ~__context ~self ~value = let set_groups ~__context ~self ~value = Pool_features.assert_enabled ~__context ~f:Features.VM_group ; + if + Db.VM.get_is_control_domain ~__context ~self + || Db.VM.get_is_a_template ~__context ~self + || Db.VM.get_is_a_snapshot ~__context ~self + then + raise + (Api_errors.Server_error + ( Api_errors.operation_not_allowed + , [ + "Control domains, templates, and snapshots cannot be added to VM \ + groups." + ] + ) + ) ; if List.length value > 1 then raise Api_errors.(Server_error (Api_errors.too_many_groups, [])) ; Db.VM.set_groups ~__context ~self ~value From 1efaf1f2f1b9848d9130e2bb312d2bd879a02c2a Mon Sep 17 00:00:00 2001 From: Gang Ji Date: Thu, 16 May 2024 16:49:39 +0800 Subject: [PATCH 13/19] CP-48625: Code refactoring Add func host_to_vm_count_map to be used, rename RefMap to HostMap Signed-off-by: Gang Ji --- ocaml/xapi/xapi_vm_helpers.ml | 89 +++++++++++++++++++++++++++-------- 1 file changed, 70 insertions(+), 19 deletions(-) diff --git a/ocaml/xapi/xapi_vm_helpers.ml b/ocaml/xapi/xapi_vm_helpers.ml index 9d310d94eeb..99fdabc6d38 100644 --- a/ocaml/xapi/xapi_vm_helpers.ml +++ b/ocaml/xapi/xapi_vm_helpers.ml @@ -35,7 +35,7 @@ module SRSet = Set.Make (struct let compare = Stdlib.compare end) -module RefMap = Map.Make (struct +module HostMap = Map.Make (struct type t = [`host] Ref.t let compare = Ref.compare @@ -1003,6 +1003,46 @@ let rank_hosts_by_best_vgpu ~__context vgpu visible_hosts = hosts |> List.map (fun g -> List.map fst g) +let host_to_vm_count_map ~__context group = + let host_of_vm vm = + let vm_rec = Db.VM.get_record ~__context ~self:vm in + (* 1. When a VM starts migrating, it's 'scheduled_to_be_resident_on' will be set, + while its 'resident_on' is not cleared. In this case, + 'scheduled_to_be_resident_on' should be treated as its running host. + 2. For paused VM, its 'resident_on' has value, but it will not be considered + while computing the amount of VMs. *) + match + ( vm_rec.API.vM_scheduled_to_be_resident_on + , vm_rec.API.vM_resident_on + , vm_rec.API.vM_power_state + ) + with + | sh, _, _ when sh <> Ref.null -> + Some sh + | _, h, `Running when h <> Ref.null -> + Some h + | _ -> + None + in + Db.VM_group.get_VMs ~__context ~self:group + |> List.fold_left + (fun m vm -> + match host_of_vm vm with + | Some h -> + HostMap.update h + (fun c -> Option.(value ~default:0 c |> succ |> some)) + m + | None -> + m + ) + HostMap.empty + +let rank_hosts_by_vm_cnt_in_group ~__context group hosts = + let host_map = host_to_vm_count_map ~__context group in + Helpers.group_by ~ordering:`ascending + (fun h -> HostMap.find_opt h host_map |> Option.value ~default:0) + hosts + (* Group all hosts to 2 parts: 1. A list of affinity host (only one host). 2. A list of lists, each list contains hosts with the same number of @@ -1055,22 +1095,43 @@ let rank_hosts_by_placement ~__context ~vm ~group = (fun m vm -> match host_of_vm vm with | Some h -> - RefMap.update h + HostMap.update h (fun c -> Option.(value ~default:0 c |> succ |> some)) m | None -> m ) - RefMap.empty + HostMap.empty in host_without_affinity_host |> Helpers.group_by ~ordering:`ascending (fun h -> - RefMap.find_opt h host_map |> Option.value ~default:0 + HostMap.find_opt h host_map |> Option.value ~default:0 ) |> List.map (fun g -> List.map fst g) in affinity_host :: sorted_hosts |> List.filter (( <> ) []) +let rec select_host_from_ranked_lists ~vm ~host_selector ~ranked_host_lists = + match ranked_host_lists with + | [] -> + raise (Api_errors.Server_error (Api_errors.no_hosts_available, [])) + | hosts :: less_optimal_groups_of_hosts -> ( + debug + "Attempting to select host for VM (%s) in a group of equally optimal \ + hosts [ %s ]" + (Ref.string_of vm) + (String.concat ";" (List.map Ref.string_of hosts)) ; + try host_selector hosts + with _ -> + info + "Failed to select host for VM (%s) in any of [ %s ], continue to \ + select from less optimal hosts" + (Ref.string_of vm) + (String.concat ";" (List.map Ref.string_of hosts)) ; + select_host_from_ranked_lists ~vm ~host_selector + ~ranked_host_lists:less_optimal_groups_of_hosts + ) + (* Selects a single host from the set of all hosts on which the given [vm] can boot. Raises [Api_errors.no_hosts_available] if no such host exists. 1.Take anti-affinity, or VGPU, or Network SR-IOV as a group_key for group all hosts into host list list @@ -1115,22 +1176,12 @@ let choose_host_for_vm_no_wlb ~__context ~vm ~snapshot = ) ) in - let rec select_host_from = function - | [] -> - raise (Api_errors.Server_error (Api_errors.no_hosts_available, [])) - | hosts :: less_optimal_groups_of_hosts -> ( - debug - "Attempting to start VM (%s) on one of equally optimal hosts [ %s ]" - (Ref.string_of vm) - (String.concat ";" (List.map Ref.string_of hosts)) ; - try Xapi_vm_placement.select_host __context vm validate_host hosts - with _ -> - info "Failed to start VM (%s) on any of [ %s ]" (Ref.string_of vm) - (String.concat ";" (List.map Ref.string_of hosts)) ; - select_host_from less_optimal_groups_of_hosts - ) + let host_selector = + Xapi_vm_placement.select_host __context vm validate_host in - try select_host_from host_lists + try + select_host_from_ranked_lists ~vm ~host_selector + ~ranked_host_lists:host_lists with | Api_errors.Server_error (x, []) when x = Api_errors.no_hosts_available -> debug From d1316f13c8e2d0fa832538e7ec0ab5422c1d86d4 Mon Sep 17 00:00:00 2001 From: Gang Ji Date: Thu, 16 May 2024 16:59:42 +0800 Subject: [PATCH 14/19] CP-48625: Code refactoring fixup review comments Signed-off-by: Gang Ji --- ocaml/xapi/xapi_vm_helpers.ml | 78 +++++++++++------------------------ 1 file changed, 24 insertions(+), 54 deletions(-) diff --git a/ocaml/xapi/xapi_vm_helpers.ml b/ocaml/xapi/xapi_vm_helpers.ml index 99fdabc6d38..cc82f304e07 100644 --- a/ocaml/xapi/xapi_vm_helpers.ml +++ b/ocaml/xapi/xapi_vm_helpers.ml @@ -1043,6 +1043,13 @@ let rank_hosts_by_vm_cnt_in_group ~__context group hosts = (fun h -> HostMap.find_opt h host_map |> Option.value ~default:0) hosts +let get_affinity_host ~__context ~vm = + match Db.VM.get_affinity ~__context ~self:vm with + | ref when Db.is_valid_ref __context ref -> + Some ref + | _ -> + None + (* Group all hosts to 2 parts: 1. A list of affinity host (only one host). 2. A list of lists, each list contains hosts with the same number of @@ -1057,77 +1064,40 @@ let rank_hosts_by_vm_cnt_in_group ~__context group hosts = ] *) let rank_hosts_by_placement ~__context ~vm ~group = - let affinity_host = - match Db.VM.get_affinity ~__context ~self:vm with - | ref when Db.is_valid_ref __context ref -> - [ref] - | _ -> - [] + let hosts = Db.Host.get_all ~__context in + let affinity_host = get_affinity_host ~__context ~vm in + let hosts_without_affinity = + Option.fold ~none:hosts + ~some:(fun host -> List.filter (( <> ) host) hosts) + affinity_host in let sorted_hosts = - let host_without_affinity_host = - Db.Host.get_all ~__context - |> List.filter (fun host -> not (List.mem host affinity_host)) - in - let host_of_vm vm = - let vm_rec = Db.VM.get_record ~__context ~self:vm in - (* 1. When a VM starts migrating, it's 'scheduled_to_be_resident_on' will be set, - while its 'resident_on' is not cleared. In this case, - 'scheduled_to_be_resident_on' should be treated as its running host. - 2. For paused VM, its 'resident_on' has value, but it will not be considered - while computing the amount of VMs. *) - match - ( vm_rec.API.vM_scheduled_to_be_resident_on - , vm_rec.API.vM_resident_on - , vm_rec.API.vM_power_state - ) - with - | sh, _, _ when sh <> Ref.null -> - Some sh - | _, h, `Running when h <> Ref.null -> - Some h - | _ -> - None - in - let host_map = - Db.VM_group.get_VMs ~__context ~self:group - |> List.fold_left - (fun m vm -> - match host_of_vm vm with - | Some h -> - HostMap.update h - (fun c -> Option.(value ~default:0 c |> succ |> some)) - m - | None -> - m - ) - HostMap.empty - in - host_without_affinity_host - |> Helpers.group_by ~ordering:`ascending (fun h -> - HostMap.find_opt h host_map |> Option.value ~default:0 - ) - |> List.map (fun g -> List.map fst g) + hosts_without_affinity + |> rank_hosts_by_vm_cnt_in_group ~__context group + |> List.(map (map fst)) in - affinity_host :: sorted_hosts |> List.filter (( <> ) []) + match affinity_host with + | Some host -> + [host] :: sorted_hosts + | None -> + sorted_hosts let rec select_host_from_ranked_lists ~vm ~host_selector ~ranked_host_lists = match ranked_host_lists with | [] -> raise (Api_errors.Server_error (Api_errors.no_hosts_available, [])) | hosts :: less_optimal_groups_of_hosts -> ( + let hosts_str = String.concat ";" (List.map Ref.string_of hosts) in debug "Attempting to select host for VM (%s) in a group of equally optimal \ hosts [ %s ]" - (Ref.string_of vm) - (String.concat ";" (List.map Ref.string_of hosts)) ; + (Ref.string_of vm) hosts_str ; try host_selector hosts with _ -> info "Failed to select host for VM (%s) in any of [ %s ], continue to \ select from less optimal hosts" - (Ref.string_of vm) - (String.concat ";" (List.map Ref.string_of hosts)) ; + (Ref.string_of vm) hosts_str ; select_host_from_ranked_lists ~vm ~host_selector ~ranked_host_lists:less_optimal_groups_of_hosts ) From eaf79451ff027cd7679435c503287eaae0011062 Mon Sep 17 00:00:00 2001 From: Gang Ji Date: Thu, 23 May 2024 15:56:05 +0800 Subject: [PATCH 15/19] opam: add psq to xapi dependencies Signed-off-by: Gang Ji --- ocaml/xapi/dune | 1 + xapi.opam | 1 + xapi.opam.template | 1 + 3 files changed, 3 insertions(+) diff --git a/ocaml/xapi/dune b/ocaml/xapi/dune index 6575b66aea5..7492df39e68 100644 --- a/ocaml/xapi/dune +++ b/ocaml/xapi/dune @@ -84,6 +84,7 @@ pam pciutil pci + psq ptime rpclib.core rpclib.json diff --git a/xapi.opam b/xapi.opam index e414d694b2c..387ba542fe6 100644 --- a/xapi.opam +++ b/xapi.opam @@ -38,6 +38,7 @@ depends: [ "ppx_deriving_rpc" "ppx_sexp_conv" "ppx_deriving" + "psq" "rpclib" "rrdd-plugin" "rresult" diff --git a/xapi.opam.template b/xapi.opam.template index dc48554787e..49f3902f66a 100644 --- a/xapi.opam.template +++ b/xapi.opam.template @@ -36,6 +36,7 @@ depends: [ "ppx_deriving_rpc" "ppx_sexp_conv" "ppx_deriving" + "psq" "rpclib" "rrdd-plugin" "rresult" From 25fa2eb46e5e5138c581339ec156f65d40f336c3 Mon Sep 17 00:00:00 2001 From: Gang Ji Date: Thu, 16 May 2024 16:37:06 +0800 Subject: [PATCH 16/19] CP-49665: Anti-affinity support for host evacuation Host evacuation plan with anti-affinity support will be carried out in 3 phases: 1. Try to get a "spread evenly" plan for anti-affinity VMs, done if all the rest VMs got planned using binpack, otherwise continue. 2. Try to get a "no breach" plan for anti-affinity VMs, done if all the rest VMs got planned using binpack, otherwise continue. 3. Carry out a binpack plan ignoring VM anti-affinity. Signed-off-by: Gang Ji --- ocaml/xapi/xapi_ha_vm_failover.ml | 449 +++++++++++++++++++++++++++--- 1 file changed, 408 insertions(+), 41 deletions(-) diff --git a/ocaml/xapi/xapi_ha_vm_failover.ml b/ocaml/xapi/xapi_ha_vm_failover.ml index 4fbf46860f2..d52fcc1c641 100644 --- a/ocaml/xapi/xapi_ha_vm_failover.ml +++ b/ocaml/xapi/xapi_ha_vm_failover.ml @@ -175,9 +175,6 @@ let order_f (_, vm_rec) = let ( $ ) x y = x y -(*****************************************************************************************************) -(* Planning code follows *) - (* Compute the total memory required of a VM (Running or not) *) let total_memory_of_vm ~__context policy snapshot = let main, shadow = @@ -185,50 +182,411 @@ let total_memory_of_vm ~__context policy snapshot = in Int64.add main shadow -(** Return a VM -> Host plan for the Host.evacuate code. We assume the VMs are all agile. The returned plan may - be incomplete if there was not enough memory. *) -let compute_evacuation_plan ~__context total_hosts remaining_hosts - vms_and_snapshots = - let hosts = - List.map - (fun host -> - ( host - , Memory_check.host_compute_free_memory_with_maximum_compression - ~__context ~host None - ) - ) - remaining_hosts +let host_free_memory ~__context ~host = + Memory_check.host_compute_free_memory_with_maximum_compression ~__context + ~host None + +let vm_memory ~__context snapshot = + let policy = + match Helpers.check_domain_type snapshot.API.vM_domain_type with + | `hvm | `pv -> + Memory_check.Dynamic_min + | `pv_in_pvh | `pvh -> + Memory_check.Static_max in - let vms = - List.map - (fun (vm, snapshot) -> - let policy = - match Helpers.check_domain_type snapshot.API.vM_domain_type with - | `hvm | `pv -> - Memory_check.Dynamic_min - | `pv_in_pvh | `pvh -> - Memory_check.Static_max + total_memory_of_vm ~__context policy snapshot + +module VMGrpRefOrd = struct + type t = [`VM_group] Ref.t + + let compare = Ref.compare +end + +module VMGrpMap = Map.Make (VMGrpRefOrd) + +module HostKey = struct + type t = [`host] Ref.t + + let compare = Ref.compare +end + +(* For a VM anti-affinity group, the state of a host which determines + evacuation planning for anti-affinity VMs in that group: + 1. vm_cnt: the number of running VMs in that group resident on the host + 2. h_size: the amount of free memory of the host *) +module HostStatistics = struct + type t = {vm_cnt: int; h_size: int64} + + (* During evacuation planning for anti-affinity VMs, "vm_cnt" is the first + factor considered, "h_size" is the second factor considered: + Let's say the next anti-affinity VM to be planned belongs to group A, the + host to be selected should be the one which has minimal "vm_cnt" of group + A, for hosts with the same "vm_cnt", pick the one with the minimal + "h_size" which can hold the VM(h_size >= vm_size). *) + let compare {vm_cnt= vm_cnt_0; h_size= h_size_0} + {vm_cnt= vm_cnt_1; h_size= h_size_1} = + match Int.compare vm_cnt_0 vm_cnt_1 with + | 0 -> + Int64.compare h_size_0 h_size_1 + | c -> + c +end + +(* A Psq of hosts for an anti-affinity group, which is used for evacuation + planning for anti-affinity VMs in that group: the minimal host in this Psq + is the first one to be considered to plan a VM from that group. + When several hosts share the minimal "HostStatistics", + the minimal host is the host with the smallest ref. *) +module AntiAffEvacPlanHostPsq = Psq.Make (HostKey) (HostStatistics) + +(* The spread evenly plan pool state determines the spread evenly evacuation + planning for anti-affinity VMs. + It's a VMGrpMap which contains a Psq for each group, and each Psq contains + all the available hosts in the pool. + Let's say the anti-affinity VM to be planned belongs to anti-affinity group + A. To get a spread evenly evacuation plan, the most suitable host to plan + the VM would be the host which has the minimal number of running VMs from + group A resident on it, for the hosts with the same number of running VMs + from group A, the one with the minimal free memory will be checked first, + which is just the minimal host returned from "Psq.min" on the Psq of group + A. *) +let init_spread_evenly_plan_pool_state ~__context anti_aff_vms hosts = + let module Q = AntiAffEvacPlanHostPsq in + let gen_psq grp = + let module H = Xapi_vm_helpers in + let host_vm_cnt = H.host_to_vm_count_map ~__context grp in + List.fold_left + (fun q (h, h_size) -> + let vm_cnt = + H.HostMap.find_opt h host_vm_cnt |> Option.value ~default:0 in - (vm, total_memory_of_vm ~__context policy snapshot) + Q.add h {vm_cnt; h_size} q ) - vms_and_snapshots + Q.empty hosts in + let module VMGrpSet = Set.Make (VMGrpRefOrd) in + anti_aff_vms |> List.map (fun (_, _, grp) -> grp) |> VMGrpSet.of_list + |> fun s -> + VMGrpSet.fold + (fun grp grp_psq -> VMGrpMap.add grp (gen_psq grp) grp_psq) + s VMGrpMap.empty + +(* Update "spread_evenly_plan_pool_state" after a VM from anti-affinity "group" + with memory size: "vm_size" is planned on the "host": + 1. For the "group", increase "vm_cnt" of the "host" by 1. + 2. For each group, updates the host's size by substracting "vm_size". *) +let update_spread_evenly_plan_pool_state vm_size group host pool_state = + let module Q = AntiAffEvacPlanHostPsq in + VMGrpMap.mapi + (fun grp hosts_q -> + Q.adjust host + (fun {vm_cnt; h_size} -> + let h_size = Int64.sub h_size vm_size in + let vm_cnt = vm_cnt + if grp = group then 1 else 0 in + {vm_cnt; h_size} + ) + hosts_q + ) + pool_state + +(* The no breach plan pool state determines the no breach evacuation planning + for anti-affinity VMs. + It's a VMGrpMap which contains "no breach plan state" for each VM anti- + affinity group. + "no breach plan state" has 2 elements: + 1. a Psq which contains "no_resident" hosts for that group. (A "no + resident" host for a group is a host which has no running VMs from that + group resident on it.) + 2. an int which is the number of "resident" hosts for each group. (A + "resident" host for a group is a host which has at least one running VM + from that group resident on it.) + Let's say the anti-affinity VM to be planned belongs to anti-affinity group + A. If for group A, the number of "resident" hosts is already 2 or greater + than 2, then we don't need to plan the VM on any host, if not, we will need + to check the host with the minimal free memory from the "no resident" hosts + queue, which is just the minimal host returned from "Psq.min" on the "no + resident" hosts Psq of group A. *) +let init_no_breach_plan_pool_state spread_evenly_plan_pool_state = + let module Q = AntiAffEvacPlanHostPsq in + spread_evenly_plan_pool_state + |> VMGrpMap.map (fun hs -> + let no_resident_hosts, resident_hosts = + Q.partition (fun _ {vm_cnt; _} -> vm_cnt = 0) hs + in + (no_resident_hosts, Q.size resident_hosts) + ) + +(* Update "no_breach_plan_pool_state" after a VM from anti-affinity "group" + with memory size: "vm_size" is planned on the "host": + 1. For the "group", the "host" is removed from its "no_resident" hosts + queue, and increase its "resident_hosts_cnt" by 1. + 2. For other groups, updates the host's size by substracting "vm_size" if + the host is in that group's "no_resident" hosts queue. *) +let update_no_breach_plan_pool_state vm_size group host pool_state = + let module Q = AntiAffEvacPlanHostPsq in + VMGrpMap.mapi + (fun grp (no_resident_hosts, resident_hosts_cnt) -> + match grp = group with + | true -> + (Q.remove host no_resident_hosts, succ resident_hosts_cnt) + | false -> + let open HostStatistics in + ( Q.update host + (Option.map (fun {vm_cnt; h_size} -> + {vm_cnt; h_size= Int64.sub h_size vm_size} + ) + ) + no_resident_hosts + , resident_hosts_cnt + ) + ) + pool_state + +(* For an anti-affinity group, select host for a VM of memory size: vm_size + from hosts Psq: hosts_psq, returns the selected host for the VM and the + available hosts Psq for the remaining VMs to be planned in that anti- + affinity group. *) +let rec select_host_for_anti_aff_evac_plan vm_size hosts_psq = + let module Q = AntiAffEvacPlanHostPsq in + match Q.pop hosts_psq with + | None -> + None + | Some ((host, {vm_cnt= _; h_size}), rest_hosts) -> ( + match vm_size <= h_size with + | true -> + (* "host", the minimal one in "hosts_psq", might still be able to hold + the next VM: if its free memory, after the current VM is placed on + it, is still larger than the size of the next VM *) + Some (host, hosts_psq) + | false -> + (* "host" will not be available for the remaining VMs as the anti- + affinity VMs to be planned are sorted increasingly in terms of their + size, since the host can't hold current VM, it will not be able to + hold the next VM. *) + select_host_for_anti_aff_evac_plan vm_size rest_hosts + ) + +let impossible_error_handler () = + let msg = "Data corrupted during host evacuation." in + error "%s" msg ; + raise (Api_errors.Server_error (Api_errors.internal_error, [msg])) + +(*****************************************************************************************************) +(* Planning code follows *) + +(* Try to get a spread evenly plan for anti-affinity VMs (for each anti- + affinity group, the number of running VMs from that group are spread evenly + in all the rest hosts in the pool): + 1. For all the anti-affinity VMs which sorted in an increasing order in + terms of the VM's memory size, do host selection as below step 2. + 2. For each anti-affinity VM, select a host which can run it, and which has + the minimal number of VMs in the same anti-affinity group running on it, + for the hosts with the same number of running VMs in that group, pick the + one with the minimal free memory. *) +let compute_spread_evenly_plan ~__context pool_state anti_aff_vms = + info "compute_spread_evenly_plan" ; + List.fold_left + (fun (acc_mapping, acc_pool_state) (vm, vm_size, group) -> + debug "Spread evenly plan: try to plan for anti-affinity VM (%s %s %s)." + (Ref.string_of vm) + (Db.VM.get_name_label ~__context ~self:vm) + (Db.VM_group.get_name_label ~__context ~self:group) ; + match + VMGrpMap.find group acc_pool_state + |> select_host_for_anti_aff_evac_plan vm_size + with + | None -> + debug + "Spread evenly plan: no host can hold this anti-affinity VM. Stop \ + the planning as there won't be a valid plan for this VM." ; + ([], VMGrpMap.empty) + | Some (h, avail_hosts_for_group) -> + debug + "Spread evenly plan: choose the host with the minimal free memory \ + which can run the vm: (%s %s)." + (Ref.string_of h) + (Db.Host.get_name_label ~__context ~self:h) ; + ( (vm, h) :: acc_mapping + , acc_pool_state + |> VMGrpMap.update group (fun _ -> Some avail_hosts_for_group) + |> update_spread_evenly_plan_pool_state vm_size group h + ) + | exception Not_found -> + impossible_error_handler () + ) + ([], pool_state) anti_aff_vms + |> fst + +(* Try to get a no breach plan for anti-affinity VMs (for each anti-affinity + group, there are at least 2 hosts having running VMs in the group): + 1. For all the anti-affinity VMs which sorted in an increasing order in + terms of the VM's memory size, do host selection as below step 2. + 2. For each anti-affinity VM, try to select a host for it so that there are + at least 2 hosts which has running VMs in the same anti-affinity group. + If there are already 2 hosts having running VMs in that group, skip + planning for the VM. *) +let compute_no_breach_plan ~__context pool_state anti_aff_vms = + info "compute_no_breach_plan" ; + List.fold_left + (fun (acc_mapping, acc_not_planned_vms, acc_pool_state) (vm, vm_size, group) -> + debug "No breach plan: try to plan for anti-affinity VM (%s %s %s)." + (Ref.string_of vm) + (Db.VM.get_name_label ~__context ~self:vm) + (Db.VM_group.get_name_label ~__context ~self:group) ; + + match VMGrpMap.find group acc_pool_state with + | no_resident_hosts, resident_hosts_cnt when resident_hosts_cnt < 2 -> ( + debug + "No breach plan: there are less than 2 hosts has running VM in the \ + same anti-affinity group, and there are still host(s) which has 0 \ + running VMs, try to plan for it." ; + match + select_host_for_anti_aff_evac_plan vm_size no_resident_hosts + with + | None -> + debug + "No breach plan: failed to select host on any of the no \ + resident hosts, skip it, continue with the next VM." ; + (acc_mapping, (vm, vm_size) :: acc_not_planned_vms, acc_pool_state) + | Some (h, hosts) -> + debug + "No breach plan: choose the no resident host with the minimal \ + free memory which can run the vm: (%s)." + (Db.Host.get_name_label ~__context ~self:h) ; + ( (vm, h) :: acc_mapping + , acc_not_planned_vms + , acc_pool_state + |> VMGrpMap.update group (Option.map (fun (_, i) -> (hosts, i))) + |> update_no_breach_plan_pool_state vm_size group h + ) + ) + | exception Not_found -> + impossible_error_handler () + | _ -> + debug + "No breach plan: no need to plan for the VM as the number of hosts \ + which has running VMs from the same group is no less than 2, \ + continue to plan for the next one." ; + (acc_mapping, (vm, vm_size) :: acc_not_planned_vms, acc_pool_state) + ) + ([], [], pool_state) anti_aff_vms + |> fun (plan, not_planned_vms, _) -> (plan, not_planned_vms) + +let vms_partition ~__context vms = + vms + |> List.partition_map (fun (vm, vm_size) -> + match Xapi_vm_helpers.vm_has_anti_affinity ~__context ~vm with + | Some (`AntiAffinity group) -> + Either.Left (vm, vm_size, group) + | _ -> + Either.Right (vm, vm_size) + ) + +(* Return an evacuation plan respecting VM anti-affinity rules: it is done in 3 + phases: + 1. Try to get a "spread evenly" plan for anti-affinity VMs, and then a + binpack plan for the rest of VMs. Done if every VM got planned, otherwise + continue. + 2. Try to get a "no breach" plan for anti-affinity VMs, and then a binpack + plan for the rest of VMs. Done if every VM got planned, otherwise + continue. + 3. Carry out a binpack plan ignoring VM anti-affinity. *) +let compute_anti_aff_evac_plan ~__context total_hosts hosts vms = let config = {Binpack.hosts; vms; placement= []; total_hosts; num_failures= 1} in Binpack.check_configuration config ; - debug "Planning configuration for offline agile VMs = %s" - (Binpack.string_of_configuration - (fun x -> - Printf.sprintf "%s (%s)" (Ref.short_string_of x) - (Db.Host.get_hostname ~__context ~self:x) - ) - (fun x -> - Printf.sprintf "%s (%s)" (Ref.short_string_of x) - (Db.VM.get_name_label ~__context ~self:x) - ) - config - ) ; + + let binpack_plan ~__context config vms = + debug "Binpack planning configuration = %s" + (Binpack.string_of_configuration + (fun x -> + Printf.sprintf "%s (%s)" (Ref.short_string_of x) + (Db.Host.get_name_label ~__context ~self:x) + ) + (fun x -> + Printf.sprintf "%s (%s)" (Ref.short_string_of x) + (Db.VM.get_name_label ~__context ~self:x) + ) + config + ) ; + debug "VMs to attempt to evacuate: [ %s ]" + (String.concat "; " + (vms + |> List.map (fun (self, _) -> + Printf.sprintf "%s (%s)" (Ref.short_string_of self) + (Db.VM.get_name_label ~__context ~self) + ) + ) + ) ; + let h = Binpack.choose_heuristic config in + h.Binpack.get_specific_plan config (List.map fst vms) + in + + let binpack_after_plan_applied plan not_planned_vms = + match plan with + | [] -> + None + | plan -> ( + debug "Binpack for the rest VMs" ; + let config_after_plan_applied = Binpack.apply_plan config plan in + let config_after_plan_applied = + {config_after_plan_applied with vms= not_planned_vms} + in + let b_plan = + binpack_plan ~__context config_after_plan_applied not_planned_vms + in + match List.length b_plan = List.length not_planned_vms with + | true -> + debug "Got final plan." ; + Some (plan @ b_plan) + | false -> + debug + "Failed to get final plan as failed to binpack for all the rest \ + VMs." ; + None + ) + in + + match total_hosts with + | h when h < 3 -> + debug + "There are less than 2 available hosts to migrate VMs to, \ + anti-affinity evacuation plan is not needed." ; + binpack_plan ~__context config vms + | _ -> + let anti_aff_vms, non_anti_aff_vms = vms |> vms_partition ~__context in + let spread_evenly_plan_pool_state = + init_spread_evenly_plan_pool_state ~__context anti_aff_vms hosts + in + let anti_aff_vms_increasing = + anti_aff_vms |> List.sort (fun (_, a, _) (_, b, _) -> compare a b) + in + + let ( let* ) o f = match o with None -> f None | p -> p in + (let* _no_plan = + let plan = + compute_spread_evenly_plan ~__context spread_evenly_plan_pool_state + anti_aff_vms_increasing + in + binpack_after_plan_applied plan non_anti_aff_vms + in + let* _no_plan = + let plan, not_planned_vms = + compute_no_breach_plan ~__context + (init_no_breach_plan_pool_state spread_evenly_plan_pool_state) + anti_aff_vms_increasing + in + binpack_after_plan_applied plan (non_anti_aff_vms @ not_planned_vms) + in + binpack_plan ~__context config vms |> Option.some + ) + |> Option.value ~default:[] + +(** Return a VM -> Host plan for the Host.evacuate code. We assume the VMs are all agile. The returned plan may + be incomplete if there was not enough memory. *) +let compute_evacuation_plan ~__context total_hosts remaining_hosts + vms_and_snapshots = debug "VMs to attempt to evacuate: [ %s ]" (String.concat "; " (List.map @@ -239,8 +597,17 @@ let compute_evacuation_plan ~__context total_hosts remaining_hosts vms_and_snapshots ) ) ; - let h = Binpack.choose_heuristic config in - h.Binpack.get_specific_plan config (List.map fst vms_and_snapshots) + let hosts = + List.map + (fun host -> (host, host_free_memory ~__context ~host)) + remaining_hosts + in + let vms = + List.map + (fun (vm, snapshot) -> (vm, vm_memory ~__context snapshot)) + vms_and_snapshots + in + compute_anti_aff_evac_plan ~__context total_hosts hosts vms (** Passed to the planner to reason about other possible configurations, used to block operations which would destroy the HA VM restart plan. *) From fcbab2bfd25967f5f4834d828fc0417754afedea Mon Sep 17 00:00:00 2001 From: Gang Ji Date: Tue, 2 Apr 2024 10:51:21 +0800 Subject: [PATCH 17/19] CP-48752: Update UT Add "groups" "power_state" for VM, vm set_resident_on host Signed-off-by: Gang Ji --- ocaml/tests/test_ha_vm_failover.ml | 49 ++++++++++++++++++++++++++++-- 1 file changed, 46 insertions(+), 3 deletions(-) diff --git a/ocaml/tests/test_ha_vm_failover.ml b/ocaml/tests/test_ha_vm_failover.ml index 4ab377870ab..67adea440e4 100644 --- a/ocaml/tests/test_ha_vm_failover.ml +++ b/ocaml/tests/test_ha_vm_failover.ml @@ -27,6 +27,8 @@ type vbd = {agile: bool} type vif = {agile: bool} +type group = {name_label: string; placement: string} + type vm = { ha_always_run: bool ; ha_restart_priority: string @@ -34,6 +36,8 @@ type vm = { ; name_label: string ; vbds: vbd list ; vifs: vif list + ; groups: group list + ; power_state: string } let basic_vm = @@ -44,6 +48,8 @@ let basic_vm = ; name_label= "vm" ; vbds= [{agile= true}] ; vifs= [{agile= true}] + ; groups= [] + ; power_state= "running" } type host = {memory_total: int64; name_label: string; vms: vm list} @@ -55,8 +61,13 @@ type pool = { ; cluster: int } -let string_of_vm {memory; name_label; _} = - Printf.sprintf "{memory = %Ld; name_label = %S}" memory name_label +let string_of_group {name_label; placement} = + Printf.sprintf "{name_label = %S; placement = %S}" name_label placement + +let string_of_vm {memory; name_label; groups; _} = + Printf.sprintf "{memory = %Ld; name_label = %S; groups = [%s]}" memory + name_label + (Test_printers.list string_of_group groups) let string_of_host {memory_total; name_label; vms} = Printf.sprintf "{memory_total = %Ld; name_label = %S; vms = [%s]}" @@ -71,6 +82,26 @@ let string_of_pool {master; slaves; ha_host_failures_to_tolerate; cluster} = (Test_printers.list string_of_host slaves) ha_host_failures_to_tolerate cluster +let load_group ~__context ~group = + let placement = + match group.placement with + | "anti_affinity" -> + `anti_affinity + | _ -> + `normal + in + match + Db.VM_group.get_all ~__context + |> List.find_opt (fun g -> + Db.VM_group.get_name_label ~__context ~self:g = group.name_label + && Db.VM_group.get_placement ~__context ~self:g = placement + ) + with + | None -> + make_vm_group ~__context ~name_label:group.name_label ~placement () + | Some g -> + g + let load_vm ~__context ~(vm : vm) ~local_sr ~shared_sr ~local_net ~shared_net = let vm_ref = make_vm ~__context ~ha_always_run:vm.ha_always_run @@ -98,6 +129,14 @@ let load_vm ~__context ~(vm : vm) ~local_sr ~shared_sr ~local_net ~shared_net = ) vm.vbds in + let groups = + List.fold_left + (fun acc group -> load_group ~__context ~group :: acc) + [] vm.groups + in + Db.VM.set_groups ~__context ~self:vm_ref ~value:groups ; + if "running" = vm.power_state then + Db.VM.set_power_state ~__context ~self:vm_ref ~value:`Running ; vm_ref let load_host ~__context ~host ~local_sr ~shared_sr ~local_net ~shared_net = @@ -110,7 +149,11 @@ let load_host ~__context ~host ~local_sr ~shared_sr ~local_net ~shared_net = let (_ : API.ref_VM list) = List.map (fun vm -> - load_vm ~__context ~vm ~local_sr ~shared_sr ~local_net ~shared_net + let vm_ref = + load_vm ~__context ~vm ~local_sr ~shared_sr ~local_net ~shared_net + in + Db.VM.set_resident_on ~__context ~self:vm_ref ~value:host_ref ; + vm_ref ) host.vms in From c626cdb2604bdf888ef5300d115e2d515dae15e0 Mon Sep 17 00:00:00 2001 From: Gang Ji Date: Wed, 29 May 2024 15:29:01 +0800 Subject: [PATCH 18/19] CP-48752: Add UT for host evacuation with anti-affinity support Signed-off-by: Gang Ji --- ocaml/tests/test_ha_vm_failover.ml | 883 +++++++++++++++++++++++++++-- ocaml/xapi/xapi_ha_vm_failover.mli | 48 ++ 2 files changed, 880 insertions(+), 51 deletions(-) diff --git a/ocaml/tests/test_ha_vm_failover.ml b/ocaml/tests/test_ha_vm_failover.ml index 67adea440e4..fe915563e18 100644 --- a/ocaml/tests/test_ha_vm_failover.ml +++ b/ocaml/tests/test_ha_vm_failover.ml @@ -27,7 +27,9 @@ type vbd = {agile: bool} type vif = {agile: bool} -type group = {name_label: string; placement: string} +type placement_policy = AntiAffinity | Normal + +type group = {name_label: string; placement: placement_policy} type vm = { ha_always_run: bool @@ -61,8 +63,62 @@ type pool = { ; cluster: int } +let master = "master" + +let slave = "slave" + +let slave1 = "slave1" + +let slave2 = "slave2" + +let slave3 = "slave3" + +let grp1 = "grp1" + +let grp2 = "grp2" + +(** vmX_grpY: in test case for anti_affinity, the VM is the Xth smallest of slave1's VMs of + the same placement type in terms of VM's memory size, and it belows to VM group: grpY. *) +let vm1_grp1 = "vm1_grp1" + +let vm2_grp1 = "vm2_grp1" + +let vm3_grp1 = "vm3_grp1" + +let vm4_grp1 = "vm4_grp1" + +let vm5_grp1 = "vm5_grp1" + +let vm6_grp1 = "vm6_grp1" + +let vm8_grp1 = "vm8_grp1" + +let vm2_grp2 = "vm2_grp2" + +let vm3_grp2 = "vm3_grp2" + +let vm4_grp2 = "vm4_grp2" + +let vm5_grp2 = "vm5_grp2" + +let vm7_grp2 = "vm7_grp2" + +(** In test case for anti_affinity, it is a VM resident on host other than slave1 *) +let vm_grp1 = "vm_grp1" + +(** vmX: in test case for anti_affinity, it is a VM not in any VM group, and it is the Xth + largest of slave1's VMs not in any VM group in terms of VM's memory size. *) +let vm1 = "vm1" + +let vm2 = "vm2" + +let vm3 = "vm3" + +let vm4 = "vm4" + let string_of_group {name_label; placement} = - Printf.sprintf "{name_label = %S; placement = %S}" name_label placement + Printf.sprintf "{name_label = %S; placement = %S}" name_label + (match placement with AntiAffinity -> "anti_affinity" | Normal -> "normal") let string_of_vm {memory; name_label; groups; _} = Printf.sprintf "{memory = %Ld; name_label = %S; groups = [%s]}" memory @@ -85,9 +141,9 @@ let string_of_pool {master; slaves; ha_host_failures_to_tolerate; cluster} = let load_group ~__context ~group = let placement = match group.placement with - | "anti_affinity" -> + | AntiAffinity -> `anti_affinity - | _ -> + | Normal -> `normal in match @@ -227,7 +283,7 @@ module AllProtectedVms = Generic.MakeStateful (struct [ (* No VMs and a single host. *) ( { - master= {memory_total= gib 256L; name_label= "master"; vms= []} + master= {memory_total= gib 256L; name_label= master; vms= []} ; slaves= [] ; ha_host_failures_to_tolerate= 0L ; cluster= 0 @@ -239,7 +295,7 @@ module AllProtectedVms = Generic.MakeStateful (struct master= { memory_total= gib 256L - ; name_label= "master" + ; name_label= master ; vms= [ {basic_vm with ha_always_run= false; ha_restart_priority= ""} @@ -256,7 +312,7 @@ module AllProtectedVms = Generic.MakeStateful (struct master= { memory_total= gib 256L - ; name_label= "master" + ; name_label= master ; vms= [{basic_vm with ha_always_run= false}] } ; slaves= [] @@ -267,8 +323,7 @@ module AllProtectedVms = Generic.MakeStateful (struct ) ; (* One protected VM. *) ( { - master= - {memory_total= gib 256L; name_label= "master"; vms= [basic_vm]} + master= {memory_total= gib 256L; name_label= master; vms= [basic_vm]} ; slaves= [] ; ha_host_failures_to_tolerate= 0L ; cluster= 0 @@ -280,15 +335,15 @@ module AllProtectedVms = Generic.MakeStateful (struct master= { memory_total= gib 256L - ; name_label= "master" + ; name_label= master ; vms= [ - {basic_vm with name_label= "vm1"} + {basic_vm with name_label= vm1} ; { basic_vm with ha_always_run= false ; ha_restart_priority= "" - ; name_label= "vm2" + ; name_label= vm2 } ] } @@ -296,7 +351,7 @@ module AllProtectedVms = Generic.MakeStateful (struct ; ha_host_failures_to_tolerate= 0L ; cluster= 0 } - , ["vm1"] + , [vm1] ) ] end) @@ -336,8 +391,8 @@ module PlanForNFailures = Generic.MakeStateful (struct [ (* Two host pool with no VMs. *) ( { - master= {memory_total= gib 256L; name_label= "master"; vms= []} - ; slaves= [{memory_total= gib 256L; name_label= "slave"; vms= []}] + master= {memory_total= gib 256L; name_label= master; vms= []} + ; slaves= [{memory_total= gib 256L; name_label= slave; vms= []}] ; ha_host_failures_to_tolerate= 1L ; cluster= 0 } @@ -349,10 +404,10 @@ module PlanForNFailures = Generic.MakeStateful (struct master= { memory_total= gib 256L - ; name_label= "master" - ; vms= [{basic_vm with memory= gib 120L; name_label= "vm1"}] + ; name_label= master + ; vms= [{basic_vm with memory= gib 120L; name_label= vm1}] } - ; slaves= [{memory_total= gib 256L; name_label= "slave"; vms= []}] + ; slaves= [{memory_total= gib 256L; name_label= slave; vms= []}] ; ha_host_failures_to_tolerate= 1L ; cluster= 0 } @@ -363,14 +418,14 @@ module PlanForNFailures = Generic.MakeStateful (struct master= { memory_total= gib 256L - ; name_label= "master" + ; name_label= master ; vms= [ - {basic_vm with memory= gib 120L; name_label= "vm1"} - ; {basic_vm with memory= gib 120L; name_label= "vm2"} + {basic_vm with memory= gib 120L; name_label= vm1} + ; {basic_vm with memory= gib 120L; name_label= vm2} ] } - ; slaves= [{memory_total= gib 256L; name_label= "slave"; vms= []}] + ; slaves= [{memory_total= gib 256L; name_label= slave; vms= []}] ; ha_host_failures_to_tolerate= 1L ; cluster= 0 } @@ -381,22 +436,22 @@ module PlanForNFailures = Generic.MakeStateful (struct master= { memory_total= gib 256L - ; name_label= "master" + ; name_label= master ; vms= [ - {basic_vm with memory= gib 120L; name_label= "vm1"} - ; {basic_vm with memory= gib 120L; name_label= "vm2"} + {basic_vm with memory= gib 120L; name_label= vm1} + ; {basic_vm with memory= gib 120L; name_label= vm2} ] } ; slaves= [ { memory_total= gib 256L - ; name_label= "slave" + ; name_label= slave ; vms= [ - {basic_vm with memory= gib 120L; name_label= "vm3"} - ; {basic_vm with memory= gib 120L; name_label= "vm4"} + {basic_vm with memory= gib 120L; name_label= vm3} + ; {basic_vm with memory= gib 120L; name_label= vm4} ] } ] @@ -465,10 +520,10 @@ module AssertNewVMPreservesHAPlan = Generic.MakeStateful (struct master= { memory_total= gib 256L - ; name_label= "master" - ; vms= [{basic_vm with memory= gib 120L; name_label= "vm1"}] + ; name_label= master + ; vms= [{basic_vm with memory= gib 120L; name_label= vm1}] } - ; slaves= [{memory_total= gib 256L; name_label= "slave"; vms= []}] + ; slaves= [{memory_total= gib 256L; name_label= slave; vms= []}] ; ha_host_failures_to_tolerate= 1L ; cluster= 0 } @@ -477,7 +532,7 @@ module AssertNewVMPreservesHAPlan = Generic.MakeStateful (struct ha_always_run= false ; ha_restart_priority= "restart" ; memory= gib 120L - ; name_label= "vm2" + ; name_label= vm2 } ) , Ok () @@ -488,14 +543,14 @@ module AssertNewVMPreservesHAPlan = Generic.MakeStateful (struct master= { memory_total= gib 256L - ; name_label= "master" + ; name_label= master ; vms= [ - {basic_vm with memory= gib 120L; name_label= "vm1"} - ; {basic_vm with memory= gib 120L; name_label= "vm2"} + {basic_vm with memory= gib 120L; name_label= vm1} + ; {basic_vm with memory= gib 120L; name_label= vm2} ] } - ; slaves= [{memory_total= gib 256L; name_label= "slave"; vms= []}] + ; slaves= [{memory_total= gib 256L; name_label= slave; vms= []}] ; ha_host_failures_to_tolerate= 1L ; cluster= 0 } @@ -504,7 +559,7 @@ module AssertNewVMPreservesHAPlan = Generic.MakeStateful (struct ha_always_run= false ; ha_restart_priority= "restart" ; memory= gib 120L - ; name_label= "vm2" + ; name_label= vm2 } ) , Error @@ -518,19 +573,19 @@ module AssertNewVMPreservesHAPlan = Generic.MakeStateful (struct master= { memory_total= gib 256L - ; name_label= "master" + ; name_label= master ; vms= [ - {basic_vm with memory= gib 120L; name_label= "vm1"} - ; {basic_vm with memory= gib 120L; name_label= "vm2"} + {basic_vm with memory= gib 120L; name_label= vm1} + ; {basic_vm with memory= gib 120L; name_label= vm2} ] } ; slaves= [ { memory_total= gib 256L - ; name_label= "slave" - ; vms= [{basic_vm with memory= gib 120L; name_label= "vm1"}] + ; name_label= slave + ; vms= [{basic_vm with memory= gib 120L; name_label= vm1}] } ] ; ha_host_failures_to_tolerate= 1L @@ -541,7 +596,7 @@ module AssertNewVMPreservesHAPlan = Generic.MakeStateful (struct ha_always_run= false ; ha_restart_priority= "restart" ; memory= gib 120L - ; name_label= "vm2" + ; name_label= vm2 } ) , Ok () @@ -576,11 +631,11 @@ module ComputeMaxFailures = Generic.MakeStateful (struct [ (* Three host pool with no VMs. *) ( { - master= {memory_total= gib 256L; name_label= "master"; vms= []} + master= {memory_total= gib 256L; name_label= master; vms= []} ; slaves= [ - {memory_total= gib 256L; name_label= "slave1"; vms= []} - ; {memory_total= gib 256L; name_label= "slave2"; vms= []} + {memory_total= gib 256L; name_label= slave1; vms= []} + ; {memory_total= gib 256L; name_label= slave2; vms= []} ] ; (* Placeholder value that is overridden when we call the compute function *) ha_host_failures_to_tolerate= 3L @@ -591,8 +646,8 @@ module ComputeMaxFailures = Generic.MakeStateful (struct ) ; (* Two hosts pool with no VMs *) ( { - master= {memory_total= gib 256L; name_label= "master"; vms= []} - ; slaves= [{memory_total= gib 256L; name_label= "slave1"; vms= []}] + master= {memory_total= gib 256L; name_label= master; vms= []} + ; slaves= [{memory_total= gib 256L; name_label= slave1; vms= []}] ; ha_host_failures_to_tolerate= 2L ; cluster= 2 } @@ -601,8 +656,8 @@ module ComputeMaxFailures = Generic.MakeStateful (struct ) ; (* Two host pool with one down *) ( { - master= {memory_total= gib 256L; name_label= "master"; vms= []} - ; slaves= [{memory_total= gib 256L; name_label= "slave1"; vms= []}] + master= {memory_total= gib 256L; name_label= master; vms= []} + ; slaves= [{memory_total= gib 256L; name_label= slave1; vms= []}] ; ha_host_failures_to_tolerate= 2L ; cluster= 1 } @@ -612,4 +667,730 @@ module ComputeMaxFailures = Generic.MakeStateful (struct ] end) -let tests = [("plan_for_n_failures", PlanForNFailures.tests)] +let extract_output_for_anti_aff_plan ~__context plan = + plan + |> List.map (fun (vm, host) -> + ( Db.VM.get_name_label ~__context ~self:vm + , Db.Host.get_name_label ~__context ~self:host + ) + ) + +let anti_aff_grp1 = {name_label= grp1; placement= AntiAffinity} + +let anti_aff_plan_test_cases = + [ + (* Test 0: No VMs in slave1 to be evacuated. *) + ( { + master= {memory_total= gib 256L; name_label= master; vms= []} + ; slaves= + [ + {memory_total= gib 256L; name_label= slave1; vms= []} + ; {memory_total= gib 256L; name_label= slave2; vms= []} + ] + ; ha_host_failures_to_tolerate= 0L + ; cluster= 0 + } + , (* Assert that spread_evenly_plan returns as expected *) + [] + , (* Assert that no_breach_plan returns as expected *) + [] + ) + ; (* Test 1: No anti-affinity VMs in slave1 to be evacuated *) + ( { + master= {memory_total= gib 256L; name_label= master; vms= []} + ; slaves= + [ + { + memory_total= gib 256L + ; name_label= slave1 + ; vms= + [ + {basic_vm with memory= gib 120L; name_label= vm1} + ; {basic_vm with memory= gib 120L; name_label= vm2} + ] + } + ; {memory_total= gib 256L; name_label= slave2; vms= []} + ] + ; ha_host_failures_to_tolerate= 0L + ; cluster= 0 + } + , (* Assert that spread_evenly_plan returns as expected *) + [] + , (* Assert that no_breach_plan returns as expected *) + [] + ) + ; (* Test 2: One anti-affinity VM in slave1 to be evacuated *) + ( { + master= {memory_total= gib 512L; name_label= master; vms= []} + ; slaves= + [ + { + memory_total= gib 256L + ; name_label= slave1 + ; vms= + [ + { + basic_vm with + memory= gib 120L + ; name_label= vm1_grp1 + ; groups= [anti_aff_grp1] + } + ; {basic_vm with memory= gib 120L; name_label= vm1} + ] + } + ; {memory_total= gib 256L; name_label= slave2; vms= []} + ] + ; ha_host_failures_to_tolerate= 0L + ; cluster= 0 + } + , (* Assert that spread_evenly_plan returns as expected *) + [(vm1_grp1, slave2)] + , (* Assert that no_breach_plan returns as expected *) + [(vm1_grp1, slave2)] + ) + ; (* Test 3: One anti-affinity VM in slave1 to be evacuated, the smallest host already has anti-affinity VM in the same group *) + ( { + master= {memory_total= gib 512L; name_label= master; vms= []} + ; slaves= + [ + { + memory_total= gib 256L + ; name_label= slave1 + ; vms= + [ + { + basic_vm with + memory= gib 120L + ; name_label= vm1_grp1 + ; groups= [anti_aff_grp1] + } + ; {basic_vm with memory= gib 120L; name_label= "vm2"} + ] + } + ; { + memory_total= gib 256L + ; name_label= slave2 + ; vms= + [ + { + basic_vm with + memory= gib 120L + ; name_label= vm_grp1 + ; groups= [anti_aff_grp1] + } + ] + } + ] + ; ha_host_failures_to_tolerate= 0L + ; cluster= 0 + } + , (* Assert that spread_evenly_plan returns as expected *) + [(vm1_grp1, master)] + , (* Assert that no_breach_plan returns as expected *) + [(vm1_grp1, master)] + ) + ; (* Test 4: Two anti-affinity VMs belong to one group in slave1 to be evacuated *) + ( { + master= {memory_total= gib 512L; name_label= master; vms= []} + ; slaves= + [ + { + memory_total= gib 256L + ; name_label= slave1 + ; vms= + [ + { + basic_vm with + memory= gib 120L + ; name_label= vm1_grp1 + ; groups= [anti_aff_grp1] + } + ; { + basic_vm with + memory= gib 130L + ; name_label= vm2_grp1 + ; groups= [anti_aff_grp1] + } + ] + } + ; {memory_total= gib 256L; name_label= slave2; vms= []} + ] + ; ha_host_failures_to_tolerate= 0L + ; cluster= 0 + } + , (* Assert that spread_evenly_plan returns as expected *) + [(vm2_grp1, master); (vm1_grp1, slave2)] + , (* Assert that no_breach_plan returns as expected *) + [(vm2_grp1, master); (vm1_grp1, slave2)] + ) + ; (* Test 5: Two anti-affinity VMs belong to one group in slave1 to be evacuated, only 1 can be planed *) + ( { + master= {memory_total= gib 512L; name_label= master; vms= []} + ; slaves= + [ + { + memory_total= gib 256L + ; name_label= slave1 + ; vms= + [ + { + basic_vm with + memory= gib 120L + ; name_label= vm1_grp1 + ; groups= [anti_aff_grp1] + } + ; { + basic_vm with + memory= gib 513L + ; name_label= vm2_grp1 + ; groups= [anti_aff_grp1] + } + ] + } + ; {memory_total= gib 256L; name_label= slave2; vms= []} + ] + ; ha_host_failures_to_tolerate= 0L + ; cluster= 0 + } + , (* Assert that spread_evenly_plan returns as expected *) + [] + , (* Assert that no_breach_plan returns as expected *) + [(vm1_grp1, slave2)] + ) + ; (* Test 6: 6 anti-affinity VMs belong to one group in slave1 to be evacuated, only 5 can be planned *) + ( { + master= {memory_total= gib 640L; name_label= master; vms= []} + ; slaves= + [ + { + memory_total= gib 256L + ; name_label= slave1 + ; vms= + [ + { + basic_vm with + memory= gib 120L + ; name_label= vm2_grp1 + ; groups= [anti_aff_grp1] + } + ; { + basic_vm with + memory= gib 60L + ; name_label= vm1_grp1 + ; groups= [anti_aff_grp1] + } + ; { + basic_vm with + memory= gib 400L + ; name_label= vm6_grp1 + ; groups= [anti_aff_grp1] + } + ; { + basic_vm with + memory= gib 250L + ; name_label= vm4_grp1 + ; groups= [anti_aff_grp1] + } + ; { + basic_vm with + memory= gib 260L + ; name_label= vm5_grp1 + ; groups= [anti_aff_grp1] + } + ; { + basic_vm with + memory= gib 130L + ; name_label= vm3_grp1 + ; groups= [anti_aff_grp1] + } + ] + } + ; {memory_total= gib 256L; name_label= slave2; vms= []} + ] + ; ha_host_failures_to_tolerate= 0L + ; cluster= 0 + } + , (* Assert that spread_evenly_plan returns as expected *) + [] + , (* Assert that no_breach_plan returns as expected *) + [(vm2_grp1, master); (vm1_grp1, slave2)] + ) + ; (* Test 7: Two groups anti-affinity VMs in slave1 to be evacuated *) + ( { + master= {memory_total= gib 512L; name_label= master; vms= []} + ; slaves= + [ + { + memory_total= gib 256L + ; name_label= slave1 + ; vms= + [ + { + basic_vm with + memory= gib 120L + ; name_label= vm6_grp1 + ; groups= [anti_aff_grp1] + } + ; { + basic_vm with + memory= gib 60L + ; name_label= vm5_grp2 + ; groups= [{name_label= grp2; placement= AntiAffinity}] + } + ; { + basic_vm with + memory= gib 130L + ; name_label= vm7_grp2 + ; groups= [{name_label= grp2; placement= AntiAffinity}] + } + ; { + basic_vm with + memory= gib 1L + ; name_label= vm1_grp1 + ; groups= [anti_aff_grp1] + } + ; { + basic_vm with + memory= gib 2L + ; name_label= vm2_grp2 + ; groups= [{name_label= grp2; placement= AntiAffinity}] + } + ; { + basic_vm with + memory= gib 3L + ; name_label= vm3_grp1 + ; groups= [anti_aff_grp1] + } + ; { + basic_vm with + memory= gib 4L + ; name_label= vm4_grp2 + ; groups= [{name_label= grp2; placement= AntiAffinity}] + } + ] + } + ; {memory_total= gib 256L; name_label= slave2; vms= []} + ] + ; ha_host_failures_to_tolerate= 0L + ; cluster= 0 + } + , (* Assert that spread_evenly_plan returns as expected *) + [ + (vm7_grp2, master) + ; (vm6_grp1, slave2) + ; (vm5_grp2, slave2) + ; (vm4_grp2, master) + ; (vm3_grp1, master) + ; (vm2_grp2, slave2) + ; (vm1_grp1, slave2) + ] + , (* Assert that no_breach_plan returns as expected *) + [ + (vm4_grp2, master) + ; (vm3_grp1, master) + ; (vm2_grp2, slave2) + ; (vm1_grp1, slave2) + ] + ) + ; (* Test 8: Two groups anti-affinity VMs in slave1 to be evacuated, master is bigger than slave2 in size when started, but becomes smaller during planning *) + ( { + master= {memory_total= gib 512L; name_label= master; vms= []} + ; slaves= + [ + { + memory_total= gib 256L + ; name_label= slave1 + ; vms= + [ + { + basic_vm with + memory= gib 120L + ; name_label= vm6_grp1 + ; groups= [anti_aff_grp1] + } + ; { + basic_vm with + memory= gib 60L + ; name_label= vm5_grp2 + ; groups= [{name_label= grp2; placement= AntiAffinity}] + } + ; { + basic_vm with + memory= gib 130L + ; name_label= vm7_grp2 + ; groups= [{name_label= grp2; placement= AntiAffinity}] + } + ; { + basic_vm with + memory= gib 1L + ; name_label= vm1_grp1 + ; groups= [anti_aff_grp1] + } + ; { + basic_vm with + memory= gib 6L + ; name_label= vm3_grp2 + ; groups= [{name_label= grp2; placement= AntiAffinity}] + } + ; { + basic_vm with + memory= gib 5L + ; name_label= vm2_grp1 + ; groups= [anti_aff_grp1] + } + ; { + basic_vm with + memory= gib 7L + ; name_label= vm4_grp2 + ; groups= [{name_label= grp2; placement= AntiAffinity}] + } + ] + } + ; {memory_total= gib 510L; name_label= slave2; vms= []} + ] + ; ha_host_failures_to_tolerate= 0L + ; cluster= 0 + } + , (* Assert that spread_evenly_plan returns as expected *) + [ + (vm7_grp2, slave2) + ; (vm6_grp1, master) + ; (vm5_grp2, master) + ; (vm4_grp2, slave2) + ; (vm3_grp2, master) + ; (vm2_grp1, master) + ; (vm1_grp1, slave2) + ] + , (* Assert that no_breach_plan returns as expected *) + [ + (vm4_grp2, slave2) + ; (vm3_grp2, master) + ; (vm2_grp1, master) + ; (vm1_grp1, slave2) + ] + ) + ] + +module Slave1EvacuationVMAntiAffinitySpreadEvenlyPlan = +Generic.MakeStateful (struct + module Io = struct + type input_t = pool + + type output_t = (string * string) list + + let string_of_input_t = string_of_pool + + let string_of_output_t = Test_printers.(list (pair string string)) + end + + module State = Test_state.XapiDb + + let load_input __context = setup ~__context + + let extract_output __context _ = + let slv1 = + Db.Host.get_all ~__context + |> List.find (fun self -> Db.Host.get_name_label ~__context ~self = slave1) + in + let slave1_anti_aff_vms = + Db.Host.get_resident_VMs ~__context ~self:slv1 + |> List.map (fun self -> (self, Db.VM.get_record ~__context ~self)) + |> List.filter (fun (_, record) -> not record.API.vM_is_control_domain) + |> List.map (fun (self, record) -> + (self, Xapi_ha_vm_failover.vm_memory ~__context record) + ) + |> Xapi_ha_vm_failover.vms_partition ~__context + |> fst + in + let hosts = + Db.Host.get_all ~__context + |> List.filter (( <> ) slv1) + |> List.map (fun host -> + (host, Xapi_ha_vm_failover.host_free_memory ~__context ~host) + ) + in + let pool_state = + Xapi_ha_vm_failover.init_spread_evenly_plan_pool_state ~__context + slave1_anti_aff_vms hosts + in + extract_output_for_anti_aff_plan ~__context + (Xapi_ha_vm_failover.compute_spread_evenly_plan ~__context pool_state + (slave1_anti_aff_vms + |> List.sort (fun (_, a, _) (_, b, _) -> compare a b) + ) + ) + + let tests = + `QuickAndAutoDocumented + (anti_aff_plan_test_cases + |> List.map (fun (pool, spread_evenly_plan, _no_breach_plan) -> + (pool, spread_evenly_plan) + ) + ) +end) + +module Slave1EvacuationVMAntiAffinityNoBreachPlan = Generic.MakeStateful (struct + module Io = struct + type input_t = pool + + type output_t = (string * string) list + + let string_of_input_t = string_of_pool + + let string_of_output_t = Test_printers.(list (pair string string)) + end + + module State = Test_state.XapiDb + + let load_input __context = setup ~__context + + let extract_output __context _ = + let slv1 = + Db.Host.get_all ~__context + |> List.find (fun self -> Db.Host.get_name_label ~__context ~self = slave1) + in + let slave1_anti_aff_vms = + Db.Host.get_resident_VMs ~__context ~self:slv1 + |> List.map (fun self -> (self, Db.VM.get_record ~__context ~self)) + |> List.filter (fun (_, record) -> not record.API.vM_is_control_domain) + |> List.map (fun (self, record) -> + (self, Xapi_ha_vm_failover.vm_memory ~__context record) + ) + |> Xapi_ha_vm_failover.vms_partition ~__context + |> fst + in + let hosts = + Db.Host.get_all ~__context + |> List.filter (( <> ) slv1) + |> List.map (fun host -> + (host, Xapi_ha_vm_failover.host_free_memory ~__context ~host) + ) + in + let pool_state = + Xapi_ha_vm_failover.init_spread_evenly_plan_pool_state ~__context + slave1_anti_aff_vms hosts + |> Xapi_ha_vm_failover.init_no_breach_plan_pool_state + in + extract_output_for_anti_aff_plan ~__context + (Xapi_ha_vm_failover.compute_no_breach_plan ~__context pool_state + (slave1_anti_aff_vms + |> List.sort (fun (_, a, _) (_, b, _) -> compare a b) + ) + |> fst + ) + + let tests = + `QuickAndAutoDocumented + (anti_aff_plan_test_cases + |> List.map (fun (pool, _spread_evenly_plan, no_breach_plan) -> + (pool, no_breach_plan) + ) + ) +end) + +module Slave1EvacuationPlan = Generic.MakeStateful (struct + module Io = struct + type input_t = pool + + type output_t = (string * string) list + + let string_of_input_t = string_of_pool + + let string_of_output_t = Test_printers.(list (pair string string)) + end + + module State = Test_state.XapiDb + + let load_input __context = setup ~__context + + let extract_output __context _ = + let all_hosts = Db.Host.get_all ~__context in + let slv1 = + Db.Host.get_all ~__context + |> List.find (fun self -> Db.Host.get_name_label ~__context ~self = slave1) + in + let slave1_vms = + Db.Host.get_resident_VMs ~__context ~self:slv1 + |> List.map (fun self -> (self, Db.VM.get_record ~__context ~self)) + |> List.filter (fun (_, record) -> not record.API.vM_is_control_domain) + |> List.map (fun (self, record) -> + (self, Xapi_ha_vm_failover.vm_memory ~__context record) + ) + in + let hosts = + all_hosts + |> List.filter (( <> ) slv1) + |> List.map (fun host -> + (host, Xapi_ha_vm_failover.host_free_memory ~__context ~host) + ) + in + Xapi_ha_vm_failover.compute_anti_aff_evac_plan ~__context + (List.length all_hosts) hosts slave1_vms + |> List.map (fun (vm, host) -> + ( Db.VM.get_name_label ~__context ~self:vm + , Db.Host.get_name_label ~__context ~self:host + ) + ) + + let tests = + `QuickAndAutoDocumented + [ + (* Test 0: Spread evenly plan is taken. *) + ( { + master= {memory_total= gib 200L; name_label= master; vms= []} + ; slaves= + [ + { + memory_total= gib 256L + ; name_label= slave1 + ; vms= + [ + { + basic_vm with + memory= gib 24L + ; name_label= vm4_grp1 + ; groups= [anti_aff_grp1] + } + ; { + basic_vm with + memory= gib 23L + ; name_label= vm3_grp1 + ; groups= [anti_aff_grp1] + } + ; { + basic_vm with + memory= gib 22L + ; name_label= vm2_grp1 + ; groups= [anti_aff_grp1] + } + ; { + basic_vm with + memory= gib 21L + ; name_label= vm1_grp1 + ; groups= [anti_aff_grp1] + } + ] + } + ; {memory_total= gib 60L; name_label= slave2; vms= []} + ] + ; ha_host_failures_to_tolerate= 0L + ; cluster= 0 + } + , (* Assert that spread_evenly_plan is taken. *) + [ + (vm4_grp1, master) + ; (vm3_grp1, slave2) + ; (vm2_grp1, master) + ; (vm1_grp1, slave2) + ] + ) + (* Test 1: No breach plan is taken. *) + ; ( { + master= {memory_total= gib 100L; name_label= master; vms= []} + ; slaves= + [ + { + memory_total= gib 256L + ; name_label= slave1 + ; vms= + [ + {basic_vm with memory= gib 85L; name_label= vm1} + ; {basic_vm with memory= gib 65L; name_label= vm2} + ; { + basic_vm with + memory= gib 30L + ; name_label= vm3_grp1 + ; groups= [anti_aff_grp1] + } + ; { + basic_vm with + memory= gib 20L + ; name_label= vm2_grp1 + ; groups= [anti_aff_grp1] + } + ; { + basic_vm with + memory= gib 10L + ; name_label= vm1_grp1 + ; groups= [anti_aff_grp1] + } + ] + } + ; {memory_total= gib 90L; name_label= slave2; vms= []} + ; {memory_total= gib 70L; name_label= slave3; vms= []} + ] + ; ha_host_failures_to_tolerate= 0L + ; cluster= 0 + } + , (* Assert that no-breach-plan is taken *) + [ + (vm2_grp1, slave2) + ; (vm1_grp1, slave3) + ; (vm3_grp1, slave3) + ; (vm2, slave2) + ; (vm1, master) + ] + ) + (* Test 2: Fallback to binpack plan. *) + ; ( { + master= {memory_total= gib 100L; name_label= master; vms= []} + ; slaves= + [ + { + memory_total= gib 256L + ; name_label= slave1 + ; vms= + [ + {basic_vm with memory= gib 95L; name_label= vm1} + ; {basic_vm with memory= gib 75L; name_label= vm2} + ; { + basic_vm with + memory= gib 30L + ; name_label= vm3_grp1 + ; groups= [anti_aff_grp1] + } + ; { + basic_vm with + memory= gib 20L + ; name_label= vm2_grp1 + ; groups= [anti_aff_grp1] + } + ; { + basic_vm with + memory= gib 10L + ; name_label= vm1_grp1 + ; groups= [anti_aff_grp1] + } + ] + } + ; {memory_total= gib 80L; name_label= slave2; vms= []} + ; {memory_total= gib 70L; name_label= slave3; vms= []} + ] + ; ha_host_failures_to_tolerate= 0L + ; cluster= 0 + } + , (* Assert that binpack-plan is taken *) + [ + (vm1_grp1, slave3) + ; (vm2_grp1, slave3) + ; (vm3_grp1, slave3) + ; (vm2, slave2) + ; (vm1, master) + ] + ) + ] +end) + +let tests = + [ + ("plan_for_n_failures", PlanForNFailures.tests) + ; ( "anti-affinity spread evenly plan" + , Slave1EvacuationVMAntiAffinitySpreadEvenlyPlan.tests + ) + ; ( "anti-affinity no breach plan" + , Slave1EvacuationVMAntiAffinityNoBreachPlan.tests + ) + ; ( "3 phases planning: spread evenly plan, no breach plan, binpacking plan" + , Slave1EvacuationPlan.tests + ) + ] diff --git a/ocaml/xapi/xapi_ha_vm_failover.mli b/ocaml/xapi/xapi_ha_vm_failover.mli index 89a4c3d20e5..20eb3b6b844 100644 --- a/ocaml/xapi/xapi_ha_vm_failover.mli +++ b/ocaml/xapi/xapi_ha_vm_failover.mli @@ -86,3 +86,51 @@ val assert_nfailures_change_preserves_ha_plan : __context:Context.t -> int -> unit val assert_new_vm_preserves_ha_plan : __context:Context.t -> API.ref_VM -> unit + +(* Below exposed only for ease of testing *) + +module VMGrpMap : Map.S with type key = API.ref_VM_group + +module HostKey : sig + type t = API.ref_host +end + +module AntiAffEvacPlanHostPsq : Psq.S with type k = HostKey.t + +val compute_spread_evenly_plan : + __context:Context.t + -> AntiAffEvacPlanHostPsq.t VMGrpMap.t + -> (API.ref_VM * int64 * API.ref_VM_group) list + -> (API.ref_VM * API.ref_host) list + +val compute_no_breach_plan : + __context:Context.t + -> (AntiAffEvacPlanHostPsq.t * int) VMGrpMap.t + -> (API.ref_VM * int64 * API.ref_VM_group) list + -> (API.ref_VM * API.ref_host) list * (API.ref_VM * int64) list + +val compute_anti_aff_evac_plan : + __context:Context.t + -> int + -> (API.ref_host * int64) list + -> (API.ref_VM * int64) list + -> (API.ref_VM * API.ref_host) list + +val host_free_memory : __context:Context.t -> host:API.ref_host -> int64 + +val vm_memory : __context:Context.t -> API.vM_t -> int64 + +val vms_partition : + __context:Context.t + -> (API.ref_VM * 'a) list + -> (API.ref_VM * 'a * API.ref_VM_group) list * (API.ref_VM * 'a) list + +val init_spread_evenly_plan_pool_state : + __context:Context.t + -> ('a * 'b * API.ref_VM_group) list + -> (API.ref_host * int64) list + -> AntiAffEvacPlanHostPsq.t VMGrpMap.t + +val init_no_breach_plan_pool_state : + AntiAffEvacPlanHostPsq.t VMGrpMap.t + -> (AntiAffEvacPlanHostPsq.t * int) VMGrpMap.t From 8a9074f6da15402f45af427631379896066bde6c Mon Sep 17 00:00:00 2001 From: Bengang Yuan Date: Mon, 3 Jun 2024 08:24:11 +0100 Subject: [PATCH 19/19] CP-48011: Xapi Support anti-affinity feature flag 1. Rename feature flag VM_group to VM_groups. 2. Add feature check in host evacuation Signed-off-by: Bengang Yuan --- ocaml/xapi-types/features.ml | 4 ++-- ocaml/xapi-types/features.mli | 2 +- ocaml/xapi/xapi_ha_vm_failover.ml | 13 ++++++++++--- ocaml/xapi/xapi_vm.ml | 2 +- ocaml/xapi/xapi_vm_group.ml | 2 +- ocaml/xapi/xapi_vm_group_helpers.ml | 6 +++--- ocaml/xapi/xapi_vm_group_helpers.mli | 2 +- ocaml/xapi/xapi_vm_helpers.ml | 2 +- 8 files changed, 20 insertions(+), 13 deletions(-) diff --git a/ocaml/xapi-types/features.ml b/ocaml/xapi-types/features.ml index 97fc9b7f7f5..6e838f32b83 100644 --- a/ocaml/xapi-types/features.ml +++ b/ocaml/xapi-types/features.ml @@ -64,7 +64,7 @@ type feature = | Updates | Internal_repo_access | VTPM - | VM_group + | VM_groups [@@deriving rpc] type orientation = Positive | Negative @@ -133,7 +133,7 @@ let keys_of_features = , ("restrict_internal_repo_access", Negative, "Internal_repo_access") ) ; (VTPM, ("restrict_vtpm", Negative, "VTPM")) - ; (VM_group, ("restrict_vm_group", Negative, "VM_group")) + ; (VM_groups, ("restrict_vm_groups", Negative, "VM_groups")) ] (* A list of features that must be considered "enabled" by `of_assoc_list` diff --git a/ocaml/xapi-types/features.mli b/ocaml/xapi-types/features.mli index bae1496dd78..bcd1ef4ac66 100644 --- a/ocaml/xapi-types/features.mli +++ b/ocaml/xapi-types/features.mli @@ -72,7 +72,7 @@ type feature = | Internal_repo_access (** Enable restriction on repository access to pool members only *) | VTPM (** Support VTPM device required by Win11 guests *) - | VM_group (** Enable use of VM group *) + | VM_groups (** Enable use of VM groups *) val feature_of_rpc : Rpc.t -> feature (** Convert RPC into {!feature}s *) diff --git a/ocaml/xapi/xapi_ha_vm_failover.ml b/ocaml/xapi/xapi_ha_vm_failover.ml index d52fcc1c641..4aa9ee17128 100644 --- a/ocaml/xapi/xapi_ha_vm_failover.ml +++ b/ocaml/xapi/xapi_ha_vm_failover.ml @@ -548,13 +548,20 @@ let compute_anti_aff_evac_plan ~__context total_hosts hosts vms = ) in - match total_hosts with - | h when h < 3 -> + match + (Pool_features.is_enabled ~__context Features.VM_groups, total_hosts) + with + | _, h when h < 3 -> debug "There are less than 2 available hosts to migrate VMs to, \ anti-affinity evacuation plan is not needed." ; binpack_plan ~__context config vms - | _ -> + | false, _ -> + debug + "VM groups feature is disabled, ignore VM anti-affinity during host \ + evacuation" ; + binpack_plan ~__context config vms + | true, _ -> let anti_aff_vms, non_anti_aff_vms = vms |> vms_partition ~__context in let spread_evenly_plan_pool_state = init_spread_evenly_plan_pool_state ~__context anti_aff_vms hosts diff --git a/ocaml/xapi/xapi_vm.ml b/ocaml/xapi/xapi_vm.ml index c08877c54c7..c7f3f6f230e 100644 --- a/ocaml/xapi/xapi_vm.ml +++ b/ocaml/xapi/xapi_vm.ml @@ -1442,7 +1442,7 @@ let set_appliance ~__context ~self ~value = update_allowed_operations ~__context ~self let set_groups ~__context ~self ~value = - Pool_features.assert_enabled ~__context ~f:Features.VM_group ; + Pool_features.assert_enabled ~__context ~f:Features.VM_groups ; if Db.VM.get_is_control_domain ~__context ~self || Db.VM.get_is_a_template ~__context ~self diff --git a/ocaml/xapi/xapi_vm_group.ml b/ocaml/xapi/xapi_vm_group.ml index f04d73e213a..f2a7497737b 100644 --- a/ocaml/xapi/xapi_vm_group.ml +++ b/ocaml/xapi/xapi_vm_group.ml @@ -15,7 +15,7 @@ module D = Debug.Make (struct let name = "xapi_vm_group" end) let create ~__context ~name_label ~name_description ~placement = - Pool_features.assert_enabled ~__context ~f:Features.VM_group ; + Pool_features.assert_enabled ~__context ~f:Features.VM_groups ; let uuid = Uuidx.make () in let ref = Ref.make () in Db.VM_group.create ~__context ~ref ~uuid:(Uuidx.to_string uuid) ~name_label diff --git a/ocaml/xapi/xapi_vm_group_helpers.ml b/ocaml/xapi/xapi_vm_group_helpers.ml index 0a05f41dd96..87fc15b10b5 100644 --- a/ocaml/xapi/xapi_vm_group_helpers.ml +++ b/ocaml/xapi/xapi_vm_group_helpers.ml @@ -139,7 +139,7 @@ let update_vm_anti_affinity_alert_for_group ~__context ~group ~alerts = () let maybe_update_vm_anti_affinity_alert_for_vm ~__context ~vm = - if Pool_features.is_enabled ~__context Features.VM_group then + if Pool_features.is_enabled ~__context Features.VM_groups then try Db.VM.get_groups ~__context ~self:vm |> List.filter (fun g -> @@ -186,7 +186,7 @@ let update_alert ~__context ~groups ~action = with e -> error "%s" (Printexc.to_string e) let update_vm_anti_affinity_alert ~__context ~groups = - if Pool_features.is_enabled ~__context Features.VM_group then + if Pool_features.is_enabled ~__context Features.VM_groups then update_alert ~__context ~groups ~action:update_vm_anti_affinity_alert_for_group else @@ -200,7 +200,7 @@ let maybe_update_alerts_on_feature_change ~__context ~old_restrictions ~new_restrictions = try let is_enabled restrictions = - List.mem Features.VM_group (Features.of_assoc_list restrictions) + List.mem Features.VM_groups (Features.of_assoc_list restrictions) in let groups = Db.VM_group.get_all ~__context in match (is_enabled old_restrictions, is_enabled new_restrictions) with diff --git a/ocaml/xapi/xapi_vm_group_helpers.mli b/ocaml/xapi/xapi_vm_group_helpers.mli index c7ed83e39e1..e2800ee69db 100644 --- a/ocaml/xapi/xapi_vm_group_helpers.mli +++ b/ocaml/xapi/xapi_vm_group_helpers.mli @@ -29,7 +29,7 @@ val maybe_update_alerts_on_feature_change : -> old_restrictions:(string * string) list -> new_restrictions:(string * string) list -> unit -(** Updates the VM anti-affinity alert only when Features.VM_group changes. +(** Updates the VM anti-affinity alert only when Features.VM_groups changes. @param __context The context information. @param old_restrictions The old feature restrictions represented as an association list. diff --git a/ocaml/xapi/xapi_vm_helpers.ml b/ocaml/xapi/xapi_vm_helpers.ml index cc82f304e07..989686ca2dc 100644 --- a/ocaml/xapi/xapi_vm_helpers.ml +++ b/ocaml/xapi/xapi_vm_helpers.ml @@ -913,7 +913,7 @@ let vm_can_run_on_host ~__context ~vm ~snapshot ~do_memory_check host = with _ -> false let vm_has_anti_affinity ~__context ~vm = - if Pool_features.is_enabled ~__context Features.VM_group then + if Pool_features.is_enabled ~__context Features.VM_groups then List.find_opt (fun g -> Db.VM_group.get_placement ~__context ~self:g = `anti_affinity) (Db.VM.get_groups ~__context ~self:vm)