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 <bengang.yuan@cloud.com>

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