CP-48011: XAPI Support anti-affinity feature check

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`

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 *)

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

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

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

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")
  ]
 *)

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