CP-52074: Add configure-ssh API on pool

Signed-off-by: Bengang Yuan <[email protected]>

ocaml/idl/datamodel_errors.ml

@@ -2013,6 +2013,9 @@ let _ =
   error Api_errors.configure_ssh_failed ["host"]
     ~doc:"Failed to configure sshd service." () ;
 
+  error Api_errors.configure_ssh_partially_failed ["hosts"]
+    ~doc:"Some of hosts failed to configure sshd service." () ;
+
   message
     (fst Api_messages.ha_pool_overcommitted)
     ~doc:

ocaml/idl/datamodel_pool.ml

@@ -61,6 +61,15 @@ let telemetry_frequency =
       ]
     )
 
+let ssh_status =
+  Enum
+    ( "ssh_status"
+    , [
+        ("on", "Start and enable sshd service")
+      ; ("off", "Stop and disable sshd service")
+      ]
+    )
+
 let enable_ha =
   call
     ~lifecycle:[(Published, rel_miami, "Turn on High Availability mode")]
@@ -1539,6 +1548,11 @@ let get_guest_secureboot_readiness =
     ~result:(pool_guest_secureboot_readiness, "The readiness of the pool")
     ~allowed_roles:_R_POOL_OP ()
 
+let configure_ssh =
+  call ~name:"configure_ssh" ~doc:"Configure ssd service" ~lifecycle:[]
+    ~params:[(ssh_status, "status", "Status of ssd service")]
+    ~allowed_roles:_R_POOL_ADMIN ()
+
 (** A pool class *)
 let t =
   create_obj ~in_db:true
@@ -1633,6 +1647,7 @@ let t =
       ; set_ext_auth_cache_size
       ; set_ext_auth_cache_expiry
       ; get_guest_secureboot_readiness
+      ; configure_ssh
       ]
     ~contents:
       ([

ocaml/xapi-cli-server/cli_frontend.ml

@@ -3114,6 +3114,15 @@ let rec cmdtable_data : (string * cmd_spec) list =
       ; flags= []
       }
     )
+  ; ( "pool-configure-ssh"
+    , {
+        reqd= ["status"]
+      ; optn= []
+      ; help= "Configure sshd service"
+      ; implementation= No_fd Cli_operations.pool_configure_ssh
+      ; flags= []
+      }
+    )
   ; ( "host-ha-xapi-healthcheck"
     , {
         reqd= []

ocaml/xapi-cli-server/cli_operations.ml

@@ -6779,6 +6779,10 @@ let pool_sync_bundle fd _printer rpc session_id params =
   | None ->
       failwith "Required parameter not found: filename"
 
+let pool_configure_ssh _printer rpc session_id params =
+  let status = Record_util.ssh_status_of_string (List.assoc "status" params) in
+  Client.Pool.configure_ssh ~rpc ~session_id ~status
+
 let host_restore fd _printer rpc session_id params =
   let filename = List.assoc "file-name" params in
   let op _ host =

ocaml/xapi-consts/api_errors.ml

@@ -1405,3 +1405,5 @@ let illegal_in_fips_mode = add_error "ILLEGAL_IN_FIPS_MODE"
 let too_many_groups = add_error "TOO_MANY_GROUPS"
 
 let configure_ssh_failed = add_error "CONFIGURE_SSH_FAILED"
+
+let configure_ssh_partially_failed = add_error "CONFIGURE_SSH_PARTIALLY_FAILED"

ocaml/xapi/message_forwarding.ml

@@ -1185,6 +1185,11 @@ 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 configure_ssh ~__context ~status =
+        info "%s: status = '%s'" __FUNCTION__
+          (Record_util.ssh_status_to_string status) ;
+        Local.Pool.configure_ssh ~__context ~status
     end
 
     module VM = struct

ocaml/xapi/xapi_pool.ml

@@ -3952,3 +3952,26 @@ let put_bundle_handler (req : Request.t) s _ =
       | None ->
           ()
   )
+
+let configure_ssh ~__context ~status =
+  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
+              Client.Host.configure_ssh ~rpc ~session_id ~self:host ~status ;
+              failed_hosts
+            with _ -> Ref.string_of host :: failed_hosts
+          )
+          [] hosts
+      in
+      match failed_hosts with
+      | [] ->
+          ()
+      | _ ->
+          raise
+            (Api_errors.Server_error
+               (Api_errors.configure_ssh_partially_failed, failed_hosts)
+            )
+  )

ocaml/xapi/xapi_pool.mli

@@ -434,3 +434,5 @@ val get_guest_secureboot_readiness :
   -> API.pool_guest_secureboot_readiness
 
 val put_bundle_handler : Http.Request.t -> Unix.file_descr -> 'a -> unit
+
+val configure_ssh : __context:Context.t -> status:API.ssh_status -> unit