CA-413587: Checking feature for old FreeBSD driver (#6599)

The FreeBSD driver used by NetScaler supports all power actions.
However, older versions of the FreeBSD driver do not explicitly
advertise these support. As a result, xapi does not attempt to signal
these power actions.
This Free BSD driver issue has been fixed by this commit:
[9dd5105](https://cgit.freebsd.org/src/commit/sys/dev/xen/control/control.c?id=9dd5105f22a2276cf099f0e10e318294fcc4f6a7)
However, there may be many FreeBSD VMs running there which still have
this issue. To address this as a workaround, all power actions should be
permitted for FreeBSD guests.

Additionally, virtual machines with an explicit
`data/cant_suspend_reason` set aren't allowed to suspend, which would
crash Windows and other UEFI VMs.

Author: robhoes

ocaml/xapi/xapi_vm_lifecycle.ml

@@ -173,45 +173,58 @@ let has_definitely_booted_pv ~vmmr =
   )
 
 (** Return an error iff vmr is an HVM guest and lacks a needed feature.
+
+ *  Note: The FreeBSD driver used by NetScaler supports all power actions.
+ *  However, older versions of the FreeBSD driver do not explicitly advertise
+ *  these support. As a result, xapi does not attempt to signal these power
+ *  actions. To address this as a workaround, all power actions should be
+ *  permitted for FreeBSD guests.
+
+ *  Additionally, VMs with an explicit `data/cant_suspend_reason` set aren't
+ *  allowed to suspend, which would crash Windows and other UEFI VMs.
+
  *  The "strict" param should be true for determining the allowed_operations list
  *  (which is advisory only) and false (more permissive) when we are potentially about
  *  to perform an operation. This makes a difference for ops that require the guest to
  *  react helpfully. *)
 let check_op_for_feature ~__context ~vmr:_ ~vmmr ~vmgmr ~power_state ~op ~ref
     ~strict =
-  if
+  let implicit_support =
     power_state <> `Running
     (* PV guests offer support implicitly *)
     || has_definitely_booted_pv ~vmmr
-  then
-    None
-  else
-    let some_err e = Some (e, [Ref.string_of ref]) in
-    let lack_feature feature = not (has_feature ~vmgmr ~feature) in
-    match op with
-    | `clean_shutdown
-      when strict
-           && lack_feature "feature-shutdown"
-           && lack_feature "feature-poweroff" ->
-        some_err Api_errors.vm_lacks_feature
-    | `clean_reboot
-      when strict
-           && lack_feature "feature-shutdown"
-           && lack_feature "feature-reboot" ->
-        some_err Api_errors.vm_lacks_feature
-    | `changing_VCPUs_live when lack_feature "feature-vcpu-hotplug" ->
+    || Xapi_pv_driver_version.(has_pv_drivers (of_guest_metrics vmgmr))
+    (* Full PV drivers imply all features *)
+  in
+  let some_err e = Some (e, [Ref.string_of ref]) in
+  let lack_feature feature = not (has_feature ~vmgmr ~feature) in
+  match op with
+  | `suspend | `checkpoint | `pool_migrate | `migrate_send -> (
+    match get_feature ~vmgmr ~feature:"data-cant-suspend-reason" with
+    | Some reason ->
+        Some (Api_errors.vm_non_suspendable, [Ref.string_of ref; reason])
+    | None
+      when (not implicit_support) && strict && lack_feature "feature-suspend" ->
         some_err Api_errors.vm_lacks_feature
-    | `suspend | `checkpoint | `pool_migrate | `migrate_send -> (
-      match get_feature ~vmgmr ~feature:"data-cant-suspend-reason" with
-      | Some reason ->
-          Some (Api_errors.vm_non_suspendable, [Ref.string_of ref; reason])
-      | None when strict && lack_feature "feature-suspend" ->
-          some_err Api_errors.vm_lacks_feature
-      | None ->
-          None
-    )
-    | _ ->
+    | None ->
         None
+  )
+  | _ when implicit_support ->
+      None
+  | `clean_shutdown
+    when strict
+         && lack_feature "feature-shutdown"
+         && lack_feature "feature-poweroff" ->
+      some_err Api_errors.vm_lacks_feature
+  | `clean_reboot
+    when strict
+         && lack_feature "feature-shutdown"
+         && lack_feature "feature-reboot" ->
+      some_err Api_errors.vm_lacks_feature
+  | `changing_VCPUs_live when lack_feature "feature-vcpu-hotplug" ->
+      some_err Api_errors.vm_lacks_feature
+  | _ ->
+      None
 
 (* N.B. In the pattern matching above, "pat1 | pat2 | pat3" counts as
    	 * one pattern, and the whole thing can be guarded by a "when" clause. *)