Merge feature/configure-ssh to master (#6361)

1. Merge `feature/configure-ssh` to `master`.
2. Update `datamodel_lifecycle.ml` to `25.12.0-next`.

Author: BengangY

ocaml/forkexecd/lib/fe_systemctl.ml

@@ -121,15 +121,19 @@ let stop ~service =
   Xapi_stdext_unix.Unixext.unlink_safe destination ;
   status
 
-let is_active ~service =
+let status ~command ~service =
   let status =
     Forkhelpers.safe_close_and_exec None None None [] systemctl
-      ["is-active"; "--quiet"; service]
+      [command; "--quiet"; service]
     |> Forkhelpers.waitpid
     |> snd
   in
   Unix.WEXITED 0 = status
 
+let is_active ~service = status ~command:"is-active" ~service
+
+let is_enabled ~service = status ~command:"is-enabled" ~service
+
 (** path to service file *)
 let path service = Filename.concat run_path (service ^ ".service")
 

ocaml/forkexecd/lib/fe_systemctl.mli

@@ -45,6 +45,9 @@ val start_transient :
 val is_active : service:string -> bool
 (** [is_active ~service] checks whether the [service] is still running *)
 
+val is_enabled : service:string -> bool
+(** [is_enabled ~service] checks whether the [service] is enabled *)
+
 val show : service:string -> status
 (** [shows ~service] retrieves the exitcodes and PIDs of the specified [service] *)
 

ocaml/idl/datamodel_errors.ml

@@ -2028,6 +2028,18 @@ let _ =
 
   error Api_errors.too_many_groups [] ~doc:"VM can only belong to one group." () ;
 
+  error Api_errors.enable_ssh_failed ["host"]
+    ~doc:"Failed to enable SSH access." () ;
+
+  error Api_errors.disable_ssh_failed ["host"]
+    ~doc:"Failed to disable SSH access." () ;
+
+  error Api_errors.enable_ssh_partially_failed ["hosts"]
+    ~doc:"Some of hosts failed to enable SSH access." () ;
+
+  error Api_errors.disable_ssh_partially_failed ["hosts"]
+    ~doc:"Some of hosts failed to disable SSH access." () ;
+
   error Api_errors.host_driver_no_hardware ["driver variant"]
     ~doc:"No hardware present for this host driver variant" () ;
 

ocaml/idl/datamodel_host.ml

@@ -2346,6 +2346,28 @@ let emergency_clear_mandatory_guidance =
     ~doc:"Clear the pending mandatory guidance on this host"
     ~allowed_roles:_R_LOCAL_ROOT_ONLY ()
 
+let enable_ssh =
+  call ~name:"enable_ssh"
+    ~doc:
+      "Enable SSH access on the host. It will start the service sshd only if \
+       it is not running. It will also enable the service sshd only if it is \
+       not enabled. A newly joined host in the pool or an ejected host from \
+       the pool would keep the original status."
+    ~lifecycle:[]
+    ~params:[(Ref _host, "self", "The host")]
+    ~allowed_roles:_R_POOL_ADMIN ()
+
+let disable_ssh =
+  call ~name:"disable_ssh"
+    ~doc:
+      "Disable SSH access on the host. It will stop the service sshd only if \
+       it is running. It will also disable the service sshd only if it is \
+       enabled. A newly joined host in the pool or an ejected host from the \
+       pool would keep the original status."
+    ~lifecycle:[]
+    ~params:[(Ref _host, "self", "The host")]
+    ~allowed_roles:_R_POOL_ADMIN ()
+
 let latest_synced_updates_applied_state =
   Enum
     ( "latest_synced_updates_applied_state"
@@ -2503,6 +2525,8 @@ let t =
       ; set_https_only
       ; apply_recommended_guidances
       ; emergency_clear_mandatory_guidance
+      ; enable_ssh
+      ; disable_ssh
       ]
     ~contents:
       ([

ocaml/idl/datamodel_lifecycle.ml

@@ -205,6 +205,10 @@ let prototyped_of_message = function
       Some "22.26.0"
   | "VTPM", "create" ->
       Some "22.26.0"
+  | "host", "disable_ssh" ->
+      Some "25.12.0-next"
+  | "host", "enable_ssh" ->
+      Some "25.12.0-next"
   | "host", "emergency_clear_mandatory_guidance" ->
       Some "24.10.0"
   | "host", "apply_recommended_guidances" ->
@@ -223,6 +227,10 @@ let prototyped_of_message = function
       Some "23.30.0"
   | "VM", "set_groups" ->
       Some "24.19.1"
+  | "pool", "disable_ssh" ->
+      Some "25.12.0-next"
+  | "pool", "enable_ssh" ->
+      Some "25.12.0-next"
   | "pool", "get_guest_secureboot_readiness" ->
       Some "24.17.0"
   | "pool", "set_ext_auth_cache_expiry" ->

ocaml/idl/datamodel_pool.ml

@@ -1553,6 +1553,24 @@ let get_guest_secureboot_readiness =
     ~result:(pool_guest_secureboot_readiness, "The readiness of the pool")
     ~allowed_roles:_R_POOL_OP ()
 
+let enable_ssh =
+  call ~name:"enable_ssh"
+    ~doc:
+      "Enable SSH access on all hosts in the pool. It's a helper which calls \
+       host.enable_ssh for all the hosts in the pool."
+    ~lifecycle:[]
+    ~params:[(Ref _pool, "self", "The pool")]
+    ~allowed_roles:_R_POOL_ADMIN ()
+
+let disable_ssh =
+  call ~name:"disable_ssh"
+    ~doc:
+      "Disable SSH access on all hosts in the pool. It's a helper which calls \
+       host.disable_ssh for all the hosts in the pool."
+    ~lifecycle:[]
+    ~params:[(Ref _pool, "self", "The pool")]
+    ~allowed_roles:_R_POOL_ADMIN ()
+
 (** A pool class *)
 let t =
   create_obj ~in_db:true
@@ -1647,6 +1665,8 @@ let t =
       ; set_ext_auth_cache_size
       ; set_ext_auth_cache_expiry
       ; get_guest_secureboot_readiness
+      ; enable_ssh
+      ; disable_ssh
       ]
     ~contents:
       ([

ocaml/sdk-gen/go/gen_go_helper.ml

@@ -38,6 +38,7 @@ let acronyms =
   ; "db"
   ; "xml"
   ; "eof"
+  ; "ssh"
   ]
   |> StringSet.of_list
 

ocaml/xapi-cli-server/cli_frontend.ml

@@ -1050,6 +1050,32 @@ let rec cmdtable_data : (string * cmd_spec) list =
       ; flags= [Host_selectors]
       }
     )
+  ; ( "host-enable-ssh"
+    , {
+        reqd= []
+      ; optn= []
+      ; help=
+          "Enable SSH access on the host. It will start the service sshd only \
+           if it is not running. It will also enable the service sshd only if \
+           it is not enabled. A newly joined host in the pool or an ejected \
+           host from the pool would keep the original status."
+      ; implementation= No_fd Cli_operations.host_enable_ssh
+      ; flags= [Host_selectors]
+      }
+    )
+  ; ( "host-disable-ssh"
+    , {
+        reqd= []
+      ; optn= []
+      ; help=
+          "Disable SSH access on the host. It will stop the service sshd only \
+           if it is running. It will also disable the service sshd only if it \
+           is enabled. A newly joined host in the pool or an ejected host from \
+           the pool would keep the original status."
+      ; implementation= No_fd Cli_operations.host_disable_ssh
+      ; flags= [Host_selectors]
+      }
+    )
   ; ( "host-emergency-clear-mandatory-guidance"
     , {
         reqd= []
@@ -3107,6 +3133,28 @@ let rec cmdtable_data : (string * cmd_spec) list =
       ; flags= []
       }
     )
+  ; ( "pool-enable-ssh"
+    , {
+        reqd= []
+      ; optn= []
+      ; help=
+          "Enable SSH access on all hosts in the pool. It's a helper which \
+           calls host.enable_ssh for all the hosts in the pool."
+      ; implementation= No_fd Cli_operations.pool_enable_ssh
+      ; flags= []
+      }
+    )
+  ; ( "pool-disable-ssh"
+    , {
+        reqd= []
+      ; optn= []
+      ; help=
+          "Disable SSH access on all hosts in the pool. It's a helper which \
+           calls host.disable_ssh for all the hosts in the pool."
+      ; implementation= No_fd Cli_operations.pool_disable_ssh
+      ; flags= []
+      }
+    )
   ; ( "host-ha-xapi-healthcheck"
     , {
         reqd= []

ocaml/xapi-cli-server/cli_operations.ml

@@ -6828,6 +6828,14 @@ let pool_sync_bundle fd _printer rpc session_id params =
   | None ->
       failwith "Required parameter not found: filename"
 
+let pool_enable_ssh _printer rpc session_id params =
+  let pool = get_pool_with_default rpc session_id params "uuid" in
+  Client.Pool.enable_ssh ~rpc ~session_id ~self:pool
+
+let pool_disable_ssh _printer rpc session_id params =
+  let pool = get_pool_with_default rpc session_id params "uuid" in
+  Client.Pool.disable_ssh ~rpc ~session_id ~self:pool
+
 let host_restore fd _printer rpc session_id params =
   let filename = List.assoc "file-name" params in
   let op _ host =
@@ -7778,6 +7786,26 @@ let host_apply_updates _printer rpc session_id params =
        params ["hash"]
     )
 
+let host_enable_ssh _printer rpc session_id params =
+  ignore
+    (do_host_op rpc session_id
+       (fun _ host ->
+         let host = host.getref () in
+         Client.Host.enable_ssh ~rpc ~session_id ~self:host
+       )
+       params []
+    )
+
+let host_disable_ssh _printer rpc session_id params =
+  ignore
+    (do_host_op rpc session_id
+       (fun _ host ->
+         let host = host.getref () in
+         Client.Host.disable_ssh ~rpc ~session_id ~self:host
+       )
+       params []
+    )
+
 module SDN_controller = struct
   let introduce printer rpc session_id params =
     let port =

ocaml/xapi-consts/api_errors.ml

@@ -1412,6 +1412,14 @@ let illegal_in_fips_mode = add_error "ILLEGAL_IN_FIPS_MODE"
 
 let too_many_groups = add_error "TOO_MANY_GROUPS"
 
+let enable_ssh_failed = add_error "ENABLE_SSH_FAILED"
+
+let disable_ssh_failed = add_error "DISABLE_SSH_FAILED"
+
+let enable_ssh_partially_failed = add_error "ENABLE_SSH_PARTIALLY_FAILED"
+
+let disable_ssh_partially_failed = add_error "DISABLE_SSH_PARTIALLY_FAILED"
+
 let host_driver_no_hardware = add_error "HOST_DRIVER_NO_HARDWARE"
 
 let tls_verification_not_enabled_in_pool =

ocaml/xapi/message_forwarding.ml

@@ -1177,6 +1177,14 @@ functor
       let get_guest_secureboot_readiness ~__context ~self =
         info "%s: pool='%s'" __FUNCTION__ (pool_uuid ~__context self) ;
         Local.Pool.get_guest_secureboot_readiness ~__context ~self
+
+      let enable_ssh ~__context ~self =
+        info "%s: pool = '%s'" __FUNCTION__ (pool_uuid ~__context self) ;
+        Local.Pool.enable_ssh ~__context ~self
+
+      let disable_ssh ~__context ~self =
+        info "%s: pool = '%s'" __FUNCTION__ (pool_uuid ~__context self) ;
+        Local.Pool.disable_ssh ~__context ~self
     end
 
     module VM = struct
@@ -4015,6 +4023,18 @@ functor
       let emergency_clear_mandatory_guidance ~__context =
         info "Host.emergency_clear_mandatory_guidance" ;
         Local.Host.emergency_clear_mandatory_guidance ~__context
+
+      let enable_ssh ~__context ~self =
+        info "%s: host = '%s'" __FUNCTION__ (host_uuid ~__context self) ;
+        let local_fn = Local.Host.enable_ssh ~self in
+        let remote_fn = Client.Host.enable_ssh ~self in
+        do_op_on ~local_fn ~__context ~host:self ~remote_fn
+
+      let disable_ssh ~__context ~self =
+        info "%s: host = '%s'" __FUNCTION__ (host_uuid ~__context self) ;
+        let local_fn = Local.Host.disable_ssh ~self in
+        let remote_fn = Client.Host.disable_ssh ~self in
+        do_op_on ~local_fn ~__context ~host:self ~remote_fn
     end
 
     module Host_crashdump = struct

ocaml/xapi/xapi_host.ml

@@ -3111,3 +3111,23 @@ let emergency_clear_mandatory_guidance ~__context =
          info "%s: %s is cleared" __FUNCTION__ s
      ) ;
   Db.Host.set_pending_guidances ~__context ~self ~value:[]
+
+let enable_ssh ~__context ~self =
+  try
+    Xapi_systemctl.enable ~wait_until_success:false "sshd" ;
+    Xapi_systemctl.start ~wait_until_success:false "sshd"
+  with _ ->
+    raise
+      (Api_errors.Server_error
+         (Api_errors.enable_ssh_failed, [Ref.string_of self])
+      )
+
+let disable_ssh ~__context ~self =
+  try
+    Xapi_systemctl.disable ~wait_until_success:false "sshd" ;
+    Xapi_systemctl.stop ~wait_until_success:false "sshd"
+  with _ ->
+    raise
+      (Api_errors.Server_error
+         (Api_errors.disable_ssh_failed, [Ref.string_of self])
+      )

ocaml/xapi/xapi_host.mli

@@ -563,3 +563,7 @@ val set_https_only :
   __context:Context.t -> self:API.ref_host -> value:bool -> unit
 
 val emergency_clear_mandatory_guidance : __context:Context.t -> unit
+
+val enable_ssh : __context:Context.t -> self:API.ref_host -> unit
+
+val disable_ssh : __context:Context.t -> self:API.ref_host -> unit

ocaml/xapi/xapi_pool.ml

@@ -3974,3 +3974,37 @@ let put_bundle_handler (req : Request.t) s _ =
       | None ->
           ()
   )
+
+module Ssh = struct
+  let operate ~__context ~action ~error =
+    let hosts = Db.Host.get_all ~__context in
+    Helpers.call_api_functions ~__context (fun rpc session_id ->
+        let failed_hosts =
+          List.fold_left
+            (fun failed_hosts host ->
+              try
+                action ~rpc ~session_id ~self:host ;
+                failed_hosts
+              with _ -> Ref.string_of host :: failed_hosts
+            )
+            [] hosts
+        in
+        match failed_hosts with
+        | [] ->
+            ()
+        | _ ->
+            raise (Api_errors.Server_error (error, failed_hosts))
+    )
+
+  let enable ~__context ~self:_ =
+    operate ~__context ~action:Client.Host.enable_ssh
+      ~error:Api_errors.enable_ssh_partially_failed
+
+  let disable ~__context ~self:_ =
+    operate ~__context ~action:Client.Host.disable_ssh
+      ~error:Api_errors.disable_ssh_partially_failed
+end
+
+let enable_ssh = Ssh.enable
+
+let disable_ssh = Ssh.disable

ocaml/xapi/xapi_pool.mli

@@ -433,3 +433,7 @@ val get_guest_secureboot_readiness :
   -> API.pool_guest_secureboot_readiness
 
 val put_bundle_handler : Http.Request.t -> Unix.file_descr -> 'a -> unit
+
+val enable_ssh : __context:Context.t -> self:API.ref_pool -> unit
+
+val disable_ssh : __context:Context.t -> self:API.ref_pool -> unit