CP-54026: option to control VM-internal shutdown behaviour under HA (#6412)

Adds a new datamodel field in the pool class:

    bool pool.ha_reboot_vm_on_internal_shutdown

The field is read/write, with the setter restricted to the pool-operator
role. The default of this new field is `true` to reflect the current
behaviour.

This field controls what happens when HA is enabled and a protected VM
is shut down internally (e.g. by pressing the shutdown button in
Windows):

- `true`: the VM is automatically restarted.
- `false`: the VM is not restarted and left halted – consistent with
  the behaviour of shutting the VM down through the API.

CLI:

    xe pool-param-set uuid=... ha-reboot-vm-on-internal-shutdown=false

Whether an HA-protected VM is automatically (re)started depends on the
field `VM.ha_always_run`, which is managed by xapi. This field is set to
`true` when a protected VM is started, and to `false` when it is shut
down through the API, which prevents the HA monitor thread from
restarting it again. Setting the new pool-field to `false` does the
same thing is such a VM is shut down from inside when handling the event
in the xenopsd-events thread.

Author: robhoes

ocaml/idl/datamodel_common.ml

@@ -10,7 +10,7 @@ open Datamodel_roles
               to leave a gap for potential hotfixes needing to increment the schema version.*)
 let schema_major_vsn = 5
 
-let schema_minor_vsn = 787
+let schema_minor_vsn = 788
 
 (* Historical schema versions just in case this is useful later *)
 let rio_schema_major_vsn = 5

ocaml/idl/datamodel_lifecycle.ml

@@ -110,7 +110,7 @@ let prototyped_of_field = function
   | "host", "last_software_update" ->
       Some "22.20.0"
   | "VM_guest_metrics", "services" ->
-      Some "25.14.0-next"
+      Some "25.15.0"
   | "VM_guest_metrics", "netbios_name" ->
       Some "24.28.0"
   | "VM", "groups" ->
@@ -123,6 +123,8 @@ let prototyped_of_field = function
       Some "23.18.0"
   | "VM", "actions__after_softreboot" ->
       Some "23.1.0"
+  | "pool", "ha_reboot_vm_on_internal_shutdown" ->
+      Some "25.15.0-next"
   | "pool", "license_server" ->
       Some "25.6.0"
   | "pool", "recommendations" ->

ocaml/idl/datamodel_pool.ml

@@ -2191,6 +2191,12 @@ let t =
             ~ty:(Map (String, String))
             ~default_value:(Some (VMap [])) "license_server"
             "Licensing data shared within the whole pool"
+        ; field ~writer_roles:_R_POOL_OP ~qualifier:RW ~lifecycle:[] ~ty:Bool
+            ~default_value:(Some (VBool true))
+            "ha_reboot_vm_on_internal_shutdown"
+            "Indicates whether an HA-protected VM that is shut down from \
+             inside (not through the API) should be automatically rebooted \
+             when HA is enabled"
         ]
       )
     ()

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 = "7756b4bea0be3985c1c8f6708f04d442"
+let last_known_schema_hash = "e10b420b0863116ee188eea9e63b1349"
 
 let current_schema_hash : string =
   let open Datamodel_types in

ocaml/tests/common/test_common.ml

@@ -300,7 +300,8 @@ let make_pool ~__context ~master ?(name_label = "") ?(name_description = "")
     ?(telemetry_next_collection = API.Date.epoch)
     ?(last_update_sync = API.Date.epoch) ?(update_sync_frequency = `daily)
     ?(update_sync_day = 0L) ?(update_sync_enabled = false)
-    ?(recommendations = []) ?(license_server = []) () =
+    ?(recommendations = []) ?(license_server = [])
+    ?(ha_reboot_vm_on_internal_shutdown = true) () =
   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
@@ -320,7 +321,8 @@ let make_pool ~__context ~master ?(name_label = "") ?(name_description = "")
     ~local_auth_max_threads:8L ~ext_auth_max_threads:8L
     ~ext_auth_cache_enabled:false ~ext_auth_cache_size:50L
     ~ext_auth_cache_expiry:300L ~update_sync_frequency ~update_sync_day
-    ~update_sync_enabled ~recommendations ~license_server ;
+    ~update_sync_enabled ~recommendations ~license_server
+    ~ha_reboot_vm_on_internal_shutdown ;
   pool_ref
 
 let default_sm_features =

ocaml/xapi-cli-server/records.ml

@@ -1244,6 +1244,15 @@ let pool_record rpc session_id pool =
       ; make_field ~name:"ha-overcommitted"
           ~get:(fun () -> string_of_bool (x ()).API.pool_ha_overcommitted)
           ()
+      ; make_field ~name:"ha-reboot-vm-on-internal-shutdown"
+          ~get:(fun () ->
+            string_of_bool (x ()).API.pool_ha_reboot_vm_on_internal_shutdown
+          )
+          ~set:(fun x ->
+            Client.Pool.set_ha_reboot_vm_on_internal_shutdown ~rpc ~session_id
+              ~self:pool ~value:(bool_of_string x)
+          )
+          ()
       ; make_field ~name:"blobs"
           ~get:(fun () -> get_uuid_map_from_ref_map (x ()).API.pool_blobs)
           ()

ocaml/xapi/dbsync_master.ml

@@ -54,7 +54,7 @@ let create_pool_record ~__context =
       ~update_sync_day:0L ~update_sync_enabled:false ~local_auth_max_threads:8L
       ~ext_auth_max_threads:1L ~ext_auth_cache_enabled:false
       ~ext_auth_cache_size:50L ~ext_auth_cache_expiry:300L ~recommendations:[]
-      ~license_server:[]
+      ~license_server:[] ~ha_reboot_vm_on_internal_shutdown:true
 
 let set_master_ip ~__context =
   let ip =

ocaml/xapi/xapi_xenops.ml

@@ -2033,6 +2033,20 @@ let update_vm ~__context id =
                   "Will update VM.allowed_operations because power_state has \
                    changed." ;
                 should_update_allowed_operations := true ;
+                (* Update ha_always_run before the power_state (if needed), to avoid racing
+                   with the HA monitor thread. *)
+                let pool = Helpers.get_pool ~__context in
+                if
+                  power_state = `Halted
+                  && not
+                       (Db.Pool.get_ha_reboot_vm_on_internal_shutdown ~__context
+                          ~self:pool
+                       )
+                then (
+                  Db.VM.set_ha_always_run ~__context ~self ~value:false ;
+                  debug "Setting ha_always_run on vm=%s as false after shutdown"
+                    (Ref.string_of self)
+                ) ;
                 debug "xenopsd event: Updating VM %s power_state <- %s" id
                   (Record_util.vm_power_state_to_string power_state) ;
                 (* This will mark VBDs, VIFs as detached and clear resident_on