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