CP-53721 Enable XAPI to configure SSH auto mode (#6442)

This PR introduces support for Dom0 SSH control, providing the
capability to configure the auto mode for a specific host or all hosts
in the pool.

New Host Object Fields and Host/Pool API:
- `ssh_auto_mode`: Indicates whether SSH auto mode is enabled. configure
to true means startup SSH when the XAPI service is down; stop SSH when
the XAPI service is up. configure to false means SSH service status is
independent and not effected by the XAPI service status.
- `set_ssh_auto_mode`: Allows setting auto mode for specific host or all
hosts in the pool.

(Note: Default value for XS8/XS9, pool join/eject operations, and XAPI
startup scenarios will be addressed in the next PR, this PR only include
the change of data_mode/API/cli )

Author: BengangY

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 = 788
+let schema_minor_vsn = 789
 
 (* Historical schema versions just in case this is useful later *)
 let rio_schema_major_vsn = 5

ocaml/idl/datamodel_errors.ml

@@ -2046,6 +2046,9 @@ let _ =
   error Api_errors.set_console_timeout_partially_failed ["hosts"]
     ~doc:"Some hosts failed to set console timeout." () ;
 
+  error Api_errors.set_ssh_auto_mode_partially_failed ["hosts"]
+    ~doc:"Some hosts failed to set SSH auto mode." () ;
+
   error Api_errors.host_driver_no_hardware ["driver variant"]
     ~doc:"No hardware present for this host driver variant" () ;
 

ocaml/idl/datamodel_host.ml

@@ -1335,6 +1335,13 @@ let create_params =
     ; param_release= numbered_release "25.14.0-next"
     ; param_default= Some (VInt Constants.default_console_idle_timeout)
     }
+  ; {
+      param_type= Bool
+    ; param_name= "ssh_auto_mode"
+    ; param_doc= "True if SSH auto mode is enabled for the host"
+    ; param_release= numbered_release "25.14.0-next"
+    ; param_default= Some (VBool Constants.default_ssh_auto_mode)
+    }
   ]
 
 let create =
@@ -1350,8 +1357,8 @@ let create =
       ; ( Changed
         , "25.14.0-next"
         , "Added --ssh_enabled --ssh_enabled_timeout --ssh_expiry \
-           --console_idle_timeout options to allow them to be configured for \
-           new host"
+           --console_idle_timeout --ssh_auto_mode options to allow them to be \
+           configured for new host"
         )
       ]
     ~versioned_params:create_params ~doc:"Create a new host record"
@@ -2440,6 +2447,21 @@ let set_console_idle_timeout =
       ]
     ~allowed_roles:_R_POOL_ADMIN ()
 
+let set_ssh_auto_mode =
+  call ~name:"set_ssh_auto_mode" ~lifecycle:[]
+    ~doc:"Set the SSH auto mode for the host"
+    ~params:
+      [
+        (Ref _host, "self", "The host")
+      ; ( Bool
+        , "value"
+        , "The SSH auto mode for the host，when set to true, SSH to normally be \
+           disabled and SSH to be enabled only in case of emergency e.g., xapi \
+           is down"
+        )
+      ]
+    ~allowed_roles:_R_POOL_ADMIN ()
+
 let latest_synced_updates_applied_state =
   Enum
     ( "latest_synced_updates_applied_state"
@@ -2601,6 +2623,7 @@ let t =
       ; disable_ssh
       ; set_ssh_enabled_timeout
       ; set_console_idle_timeout
+      ; set_ssh_auto_mode
       ]
     ~contents:
       ([
@@ -3056,6 +3079,10 @@ let t =
             "console_idle_timeout"
             "The timeout in seconds after which idle console will be \
              automatically terminated (0 means never)"
+        ; field ~qualifier:DynamicRO ~lifecycle:[] ~ty:Bool
+            ~default_value:(Some (VBool Constants.default_ssh_auto_mode))
+            "ssh_auto_mode"
+            "Reflects whether SSH auto mode is enabled for the host"
         ]
       )
     ()

ocaml/idl/datamodel_pool.ml

@@ -1606,6 +1606,21 @@ let set_console_idle_timeout =
       ]
     ~allowed_roles:_R_POOL_ADMIN ()
 
+let set_ssh_auto_mode =
+  call ~name:"set_ssh_auto_mode" ~lifecycle:[]
+    ~doc:"Set the SSH auto mode for all hosts in the pool"
+    ~params:
+      [
+        (Ref _pool, "self", "The pool")
+      ; ( Bool
+        , "value"
+        , "The SSH auto mode for all hosts in the pool，when set to true, SSH \
+           to normally be disabled and SSH to be enabled only in case of \
+           emergency e.g., xapi is down"
+        )
+      ]
+    ~allowed_roles:_R_POOL_ADMIN ()
+
 (** A pool class *)
 let t =
   create_obj ~in_db:true
@@ -1704,6 +1719,7 @@ let t =
       ; disable_ssh
       ; set_ssh_enabled_timeout
       ; set_console_idle_timeout
+      ; set_ssh_auto_mode
       ]
     ~contents:
       ([

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 = "8bf2b9ab509301baf138820cf34608d3"
+let last_known_schema_hash = "7c52d11789dea3ab3167c5d0e3e7fa89"
 
 let current_schema_hash : string =
   let open Datamodel_types in

ocaml/tests/common/test_common.ml

@@ -172,14 +172,14 @@ let make_host ~__context ?(uuid = make_uuid ()) ?(name_label = "host")
     ?(local_cache_sr = Ref.null) ?(chipset_info = []) ?(ssl_legacy = false)
     ?(last_software_update = Date.epoch) ?(last_update_hash = "")
     ?(ssh_enabled = true) ?(ssh_enabled_timeout = 0L) ?(ssh_expiry = Date.epoch)
-    ?(console_idle_timeout = 0L) () =
+    ?(console_idle_timeout = 0L) ?(ssh_auto_mode = false) () =
   let host =
     Xapi_host.create ~__context ~uuid ~name_label ~name_description ~hostname
       ~address ~external_auth_type ~external_auth_service_name
       ~external_auth_configuration ~license_params ~edition ~license_server
       ~local_cache_sr ~chipset_info ~ssl_legacy ~last_software_update
       ~last_update_hash ~ssh_enabled ~ssh_enabled_timeout ~ssh_expiry
-      ~console_idle_timeout
+      ~console_idle_timeout ~ssh_auto_mode
   in
   Db.Host.set_cpu_info ~__context ~self:host ~value:default_cpu_info ;
   host
@@ -219,7 +219,7 @@ let make_host2 ~__context ?(ref = Ref.make ()) ?(uuid = make_uuid ())
     ~recommended_guidances:[] ~latest_synced_updates_applied:`unknown
     ~pending_guidances_recommended:[] ~pending_guidances_full:[]
     ~last_update_hash:"" ~ssh_enabled:true ~ssh_enabled_timeout:0L
-    ~ssh_expiry:Date.epoch ~console_idle_timeout:0L ;
+    ~ssh_expiry:Date.epoch ~console_idle_timeout:0L ~ssh_auto_mode:false ;
   ref
 
 let make_pif ~__context ~network ~host ?(device = "eth0")

ocaml/tests/test_host.ml

@@ -25,7 +25,7 @@ let add_host __context name =
        ~local_cache_sr:Ref.null ~chipset_info:[] ~ssl_legacy:false
        ~last_software_update:Clock.Date.epoch ~last_update_hash:""
        ~ssh_enabled:true ~ssh_enabled_timeout:0L ~ssh_expiry:Clock.Date.epoch
-       ~console_idle_timeout:0L
+       ~console_idle_timeout:0L ~ssh_auto_mode:false
     )
 
 (* Creates an unlicensed pool with the maximum number of hosts *)

ocaml/xapi-cli-server/records.ml

@@ -1584,6 +1584,17 @@ let pool_record rpc session_id pool =
               ~value:(safe_i64_of_string "console-idle-timeout" value)
           )
           ()
+      ; make_field ~name:"ssh-auto-mode"
+          ~get:(fun () ->
+            get_consistent_field_or_default ~rpc ~session_id
+              ~getter:Client.Host.get_ssh_auto_mode ~transform:string_of_bool
+              ~default:inconsistent
+          )
+          ~set:(fun value ->
+            Client.Pool.set_ssh_auto_mode ~rpc ~session_id ~self:pool
+              ~value:(safe_bool_of_string "ssh-auto-mode" value)
+          )
+          ()
       ]
   }
 
@@ -3375,6 +3386,13 @@ let host_record rpc session_id host =
               ~value:(safe_i64_of_string "console-idle-timeout" value)
           )
           ()
+      ; make_field ~name:"ssh-auto-mode"
+          ~get:(fun () -> string_of_bool (x ()).API.host_ssh_auto_mode)
+          ~set:(fun value ->
+            Client.Host.set_ssh_auto_mode ~rpc ~session_id ~self:host
+              ~value:(safe_bool_of_string "ssh-auto-mode" value)
+          )
+          ()
       ]
   }
 

ocaml/xapi-consts/api_errors.ml

@@ -1426,6 +1426,9 @@ let set_ssh_timeout_partially_failed =
 let set_console_timeout_partially_failed =
   add_error "SET_CONSOLE_TIMEOUT_PARTIALLY_FAILED"
 
+let set_ssh_auto_mode_partially_failed =
+  add_error "SET_SSH_AUTO_MODE_PARTIALLY_FAILED"
+
 let host_driver_no_hardware = add_error "HOST_DRIVER_NO_HARDWARE"
 
 let tls_verification_not_enabled_in_pool =

ocaml/xapi-consts/constants.ml

@@ -428,3 +428,5 @@ let default_ssh_enabled = true
 let default_ssh_enabled_timeout = 0L
 
 let default_console_idle_timeout = 0L
+
+let default_ssh_auto_mode = false

ocaml/xapi/dbsync_slave.ml

@@ -64,6 +64,7 @@ let create_localhost ~__context info =
         ~ssh_enabled_timeout:Constants.default_ssh_enabled_timeout
         ~ssh_expiry:Date.epoch
         ~console_idle_timeout:Constants.default_console_idle_timeout
+        ~ssh_auto_mode:Constants.default_ssh_auto_mode
     in
     ()
 

ocaml/xapi/message_forwarding.ml

@@ -1197,6 +1197,12 @@ functor
           (pool_uuid ~__context self)
           value ;
         Local.Pool.set_console_idle_timeout ~__context ~self ~value
+
+      let set_ssh_auto_mode ~__context ~self ~value =
+        info "Pool.set_ssh_auto_mode: pool='%s' value='%b'"
+          (pool_uuid ~__context self)
+          value ;
+        Local.Pool.set_ssh_auto_mode ~__context ~self ~value
     end
 
     module VM = struct
@@ -4063,6 +4069,14 @@ functor
         let local_fn = Local.Host.set_console_idle_timeout ~self ~value in
         let remote_fn = Client.Host.set_console_idle_timeout ~self ~value in
         do_op_on ~local_fn ~__context ~host:self ~remote_fn
+
+      let set_ssh_auto_mode ~__context ~self ~value =
+        info "Host.set_ssh_auto_mode: host='%s' value='%b'"
+          (host_uuid ~__context self)
+          value ;
+        let local_fn = Local.Host.set_ssh_auto_mode ~self ~value in
+        let remote_fn = Client.Host.set_ssh_auto_mode ~self ~value in
+        do_op_on ~local_fn ~__context ~host:self ~remote_fn
     end
 
     module Host_crashdump = struct

ocaml/xapi/xapi_globs.ml

@@ -1297,6 +1297,8 @@ let job_for_disable_ssh = ref "Disable SSH"
 
 let ssh_service = ref "sshd"
 
+let ssh_monitor_service = ref "xapi-ssh-monitor"
+
 (* Fingerprint of default patch key *)
 let citrix_patch_key =
   "NERDNTUzMDMwRUMwNDFFNDI4N0M4OEVCRUFEMzlGOTJEOEE5REUyNg=="

ocaml/xapi/xapi_host.ml

@@ -979,7 +979,7 @@ let create ~__context ~uuid ~name_label ~name_description:_ ~hostname ~address
     ~external_auth_type ~external_auth_service_name ~external_auth_configuration
     ~license_params ~edition ~license_server ~local_cache_sr ~chipset_info
     ~ssl_legacy:_ ~last_software_update ~last_update_hash ~ssh_enabled
-    ~ssh_enabled_timeout ~ssh_expiry ~console_idle_timeout =
+    ~ssh_enabled_timeout ~ssh_expiry ~console_idle_timeout ~ssh_auto_mode =
   (* fail-safe. We already test this on the joining host, but it's racy, so multiple concurrent
      pool-join might succeed. Note: we do it in this order to avoid a problem checking restrictions during
      the initial setup of the database *)
@@ -1044,7 +1044,7 @@ let create ~__context ~uuid ~name_label ~name_description:_ ~hostname ~address
     ~tls_verification_enabled ~last_software_update ~last_update_hash
     ~recommended_guidances:[] ~latest_synced_updates_applied:`unknown
     ~pending_guidances_recommended:[] ~pending_guidances_full:[] ~ssh_enabled
-    ~ssh_enabled_timeout ~ssh_expiry ~console_idle_timeout ;
+    ~ssh_enabled_timeout ~ssh_expiry ~console_idle_timeout ~ssh_auto_mode ;
   (* If the host we're creating is us, make sure its set to live *)
   Db.Host_metrics.set_last_updated ~__context ~self:metrics ~value:(Date.now ()) ;
   Db.Host_metrics.set_live ~__context ~self:metrics ~value:host_is_us ;
@@ -3112,18 +3112,47 @@ let emergency_clear_mandatory_guidance ~__context =
      ) ;
   Db.Host.set_pending_guidances ~__context ~self ~value:[]
 
+let set_ssh_auto_mode ~__context ~self ~value =
+  debug "Setting SSH auto mode for host %s to %B"
+    (Helpers.get_localhost_uuid ())
+    value ;
+
+  Db.Host.set_ssh_auto_mode ~__context ~self ~value ;
+
+  try
+    (* When enabled, the ssh_monitor_service regularly checks XAPI status to manage SSH availability.
+       During normal operation when XAPI is running properly, SSH is automatically disabled.
+       SSH is only enabled during emergency scenarios
+       (e.g., when XAPI is down) to allow administrative access for troubleshooting. *)
+    if value then (
+      Xapi_systemctl.enable ~wait_until_success:false
+        !Xapi_globs.ssh_monitor_service ;
+      Xapi_systemctl.start ~wait_until_success:false
+        !Xapi_globs.ssh_monitor_service
+    ) else (
+      Xapi_systemctl.stop ~wait_until_success:false
+        !Xapi_globs.ssh_monitor_service ;
+      Xapi_systemctl.disable ~wait_until_success:false
+        !Xapi_globs.ssh_monitor_service
+    )
+  with e ->
+    error "Failed to configure SSH auto mode: %s" (Printexc.to_string e) ;
+    Helpers.internal_error "Failed to configure SSH auto mode: %s"
+      (Printexc.to_string e)
+
 let disable_ssh_internal ~__context ~self =
   try
     debug "Disabling SSH for host %s" (Helpers.get_localhost_uuid ()) ;
-    Xapi_systemctl.disable ~wait_until_success:false !Xapi_globs.ssh_service ;
+    if not (Db.Host.get_ssh_auto_mode ~__context ~self) then
+      Xapi_systemctl.disable ~wait_until_success:false !Xapi_globs.ssh_service ;
     Xapi_systemctl.stop ~wait_until_success:false !Xapi_globs.ssh_service ;
     Db.Host.set_ssh_enabled ~__context ~self ~value:false
   with e ->
     error "Failed to disable SSH for host %s: %s" (Ref.string_of self)
       (Printexc.to_string e) ;
     Helpers.internal_error "Failed to disable SSH: %s" (Printexc.to_string e)
 
-let schedule_disable_ssh_job ~__context ~self ~timeout =
+let schedule_disable_ssh_job ~__context ~self ~timeout ~auto_mode =
   let host_uuid = Helpers.get_localhost_uuid () in
   let expiry_time =
     match
@@ -3152,7 +3181,11 @@ let schedule_disable_ssh_job ~__context ~self ~timeout =
   Xapi_stdext_threads_scheduler.Scheduler.add_to_queue
     !Xapi_globs.job_for_disable_ssh
     Xapi_stdext_threads_scheduler.Scheduler.OneShot (Int64.to_float timeout)
-    (fun () -> disable_ssh_internal ~__context ~self
+    (fun () ->
+      disable_ssh_internal ~__context ~self ;
+      (* re-enable SSH auto mode if it was enabled before calling host.enable_ssh *)
+      if auto_mode then
+        set_ssh_auto_mode ~__context ~self ~value:true
   ) ;
 
   Db.Host.set_ssh_expiry ~__context ~self ~value:expiry_time
@@ -3161,6 +3194,10 @@ let enable_ssh ~__context ~self =
   try
     debug "Enabling SSH for host %s" (Helpers.get_localhost_uuid ()) ;
 
+    let cached_ssh_auto_mode = Db.Host.get_ssh_auto_mode ~__context ~self in
+    (* Disable SSH auto mode when SSH is enabled manually *)
+    set_ssh_auto_mode ~__context ~self ~value:false ;
+
     Xapi_systemctl.enable ~wait_until_success:false !Xapi_globs.ssh_service ;
     Xapi_systemctl.start ~wait_until_success:false !Xapi_globs.ssh_service ;
 
@@ -3171,6 +3208,7 @@ let enable_ssh ~__context ~self =
           !Xapi_globs.job_for_disable_ssh
     | t ->
         schedule_disable_ssh_job ~__context ~self ~timeout:t
+          ~auto_mode:cached_ssh_auto_mode
     ) ;
 
     Db.Host.set_ssh_enabled ~__context ~self ~value:true
@@ -3208,7 +3246,7 @@ let set_ssh_enabled_timeout ~__context ~self ~value =
           !Xapi_globs.job_for_disable_ssh ;
         Db.Host.set_ssh_expiry ~__context ~self ~value:Date.epoch
     | t ->
-        schedule_disable_ssh_job ~__context ~self ~timeout:t
+        schedule_disable_ssh_job ~__context ~self ~timeout:t ~auto_mode:false
 
 let set_console_idle_timeout ~__context ~self ~value =
   let assert_timeout_valid timeout =

ocaml/xapi/xapi_host.mli

@@ -134,6 +134,7 @@ val create :
   -> ssh_enabled_timeout:int64
   -> ssh_expiry:API.datetime
   -> console_idle_timeout:int64
+  -> ssh_auto_mode:bool
   -> [`host] Ref.t
 
 val destroy : __context:Context.t -> self:API.ref_host -> unit
@@ -579,4 +580,11 @@ val set_console_idle_timeout :
   __context:Context.t -> self:API.ref_host -> value:int64 -> unit
 
 val schedule_disable_ssh_job :
-  __context:Context.t -> self:API.ref_host -> timeout:int64 -> unit
+     __context:Context.t
+  -> self:API.ref_host
+  -> timeout:int64
+  -> auto_mode:bool
+  -> unit
+
+val set_ssh_auto_mode :
+  __context:Context.t -> self:API.ref_host -> value:bool -> unit

ocaml/xapi/xapi_periodic_scheduler_init.ml

@@ -90,6 +90,7 @@ let register ~__context =
       if Int64.compare expiry_time current_time > 0 then
         let remaining = Int64.sub expiry_time current_time in
         Xapi_host.schedule_disable_ssh_job ~__context ~self ~timeout:remaining
+          ~auto_mode:true
       (* handle the case where XAPI is not active when the SSH timeout expires *)
       else if Fe_systemctl.is_active ~service:!Xapi_globs.ssh_service then
         Xapi_host.disable_ssh ~__context ~self