CP-52074: Add API for start/stop systemd service sshd

ocaml/forkexecd/lib/fe_systemctl.ml

@@ -130,6 +130,15 @@ let is_active ~service =
   in
   Unix.WEXITED 0 = status
 
+let is_enabled ~service =
+  let status =
+    Forkhelpers.safe_close_and_exec None None None [] systemctl
+      ["is-enabled"; "--quiet"; service]
+    |> Forkhelpers.waitpid
+    |> snd
+  in
+  Unix.WEXITED 0 = status
+
 (** 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

@@ -2010,6 +2010,12 @@ let _ =
 
   error Api_errors.too_many_groups [] ~doc:"VM can only belong to one group." () ;
 
+  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_host.ml

@@ -4,6 +4,15 @@ open Datamodel_common
 open Datamodel_roles
 open Datamodel_types
 
+let ssh_status =
+  Enum
+    ( "ssh_status"
+    , [
+        ("on", "Start and enable sshd service")
+      ; ("off", "Stop and disable sshd service")
+      ]
+    )
+
 let host_memory =
   let field = field ~ty:Int in
   [
@@ -2338,6 +2347,15 @@ let emergency_clear_mandatory_guidance =
     ~doc:"Clear the pending mandatory guidance on this host"
     ~allowed_roles:_R_LOCAL_ROOT_ONLY ()
 
+let configure_ssh =
+  call ~name:"configure_ssh" ~doc:"Configure sshd service" ~lifecycle:[]
+    ~params:
+      [
+        (Ref _host, "self", "The host")
+      ; (ssh_status, "status", "Status of sshd service")
+      ]
+    ~allowed_roles:_R_POOL_ADMIN ()
+
 let latest_synced_updates_applied_state =
   Enum
     ( "latest_synced_updates_applied_state"
@@ -2494,6 +2512,7 @@ let t =
       ; set_https_only
       ; apply_recommended_guidances
       ; emergency_clear_mandatory_guidance
+      ; configure_ssh
       ]
     ~contents:
       ([

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/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

@@ -1048,6 +1048,15 @@ let rec cmdtable_data : (string * cmd_spec) list =
       ; flags= [Host_selectors]
       }
     )
+  ; ( "host-configure-ssh"
+    , {
+        reqd= ["status"]
+      ; optn= []
+      ; help= "Configure sshd service"
+      ; implementation= No_fd Cli_operations.host_configure_ssh
+      ; flags= [Host_selectors]
+      }
+    )
   ; ( "host-emergency-clear-mandatory-guidance"
     , {
         reqd= []
@@ -3105,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 =
@@ -7729,6 +7733,17 @@ let host_apply_updates _printer rpc session_id params =
        params ["hash"]
     )
 
+let host_configure_ssh _printer rpc session_id params =
+  let status = Record_util.ssh_status_of_string (List.assoc "status" params) in
+  ignore
+    (do_host_op rpc session_id
+       (fun _ host ->
+         let host = host.getref () in
+         Client.Host.configure_ssh ~rpc ~session_id ~self:host ~status
+       )
+       params ["status"]
+    )
+
 module SDN_controller = struct
   let introduce printer rpc session_id params =
     let port =

ocaml/xapi-consts/api_errors.ml

@@ -1403,3 +1403,7 @@ let telemetry_next_collection_too_late =
 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
@@ -4154,6 +4159,15 @@ functor
       let emergency_clear_mandatory_guidance ~__context =
         info "Host.emergency_clear_mandatory_guidance" ;
         Local.Host.emergency_clear_mandatory_guidance ~__context
+
+      let configure_ssh ~__context ~self ~status =
+        info "%s: host = '%s' ; status = '%s'" __FUNCTION__
+          (host_uuid ~__context self)
+          (Record_util.ssh_status_to_string status) ;
+        let local_fn = Local.Host.configure_ssh ~self ~status in
+        do_op_on ~local_fn ~__context ~host:self (fun session_id rpc ->
+            Client.Host.configure_ssh ~rpc ~session_id ~self ~status
+        )
     end
 
     module Host_crashdump = struct

ocaml/xapi/xapi_host.ml

@@ -3127,3 +3127,18 @@ let emergency_clear_mandatory_guidance ~__context =
          info "%s: %s is cleared" __FUNCTION__ s
      ) ;
   Db.Host.set_pending_guidances ~__context ~self ~value:[]
+
+let configure_ssh ~__context ~self ~status =
+  try
+    match status with
+    | `on ->
+        Xapi_systemctl.start ~wait_until_success:false "sshd" ;
+        Xapi_systemctl.enable ~wait_until_success:false "sshd"
+    | `off ->
+        Xapi_systemctl.stop ~wait_until_success:false "sshd" ;
+        Xapi_systemctl.disable ~wait_until_success:false "sshd"
+  with _ ->
+    raise
+      (Api_errors.Server_error
+         (Api_errors.configure_ssh_failed, [Ref.string_of self])
+      )

ocaml/xapi/xapi_host.mli

@@ -561,3 +561,6 @@ val set_https_only :
   __context:Context.t -> self:API.ref_host -> value:bool -> unit
 
 val emergency_clear_mandatory_guidance : __context:Context.t -> unit
+
+val configure_ssh :
+  __context:Context.t -> self:API.ref_host -> status:API.ssh_status -> unit

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

ocaml/xapi/xapi_systemctl.ml

@@ -19,7 +19,7 @@ module D = Debug.Make (struct let name = "xapi_systemctl" end)
 
 open D
 
-type t = Start | Stop | Restart
+type t = Start | Stop | Restart | Enable | Disable
 
 exception Systemctl_fail of string
 
@@ -30,6 +30,10 @@ let to_string = function
       "stop"
   | Restart ->
       "restart"
+  | Enable ->
+      "enable"
+  | Disable ->
+      "disable"
 
 let perform ~wait_until_success ~service ~timeout op =
   let op_str = op |> to_string in
@@ -42,8 +46,17 @@ let perform ~wait_until_success ~service ~timeout op =
     if wait_until_success then (
       if op = Restart then Thread.delay 0.1 ;
       let is_active = Fe_systemctl.is_active ~service in
+      let is_enabled = Fe_systemctl.is_enabled ~service in
       let success_cond () =
-        match op with Start | Restart -> is_active | Stop -> is_active |> not
+        match op with
+        | Start | Restart ->
+            is_active
+        | Stop ->
+            is_active |> not
+        | Enable ->
+            is_enabled
+        | Disable ->
+            is_enabled |> not
       in
       try
         Helpers.retry_until_timeout ~timeout
@@ -66,3 +79,9 @@ let stop ?(timeout = 5.) ~wait_until_success service =
 
 let start ?(timeout = 5.) ~wait_until_success service =
   perform ~wait_until_success ~service ~timeout Start
+
+let disable ?(timeout = 5.) ~wait_until_success service =
+  perform ~wait_until_success ~service ~timeout Disable
+
+let enable ?(timeout = 5.) ~wait_until_success service =
+  perform ~wait_until_success ~service ~timeout Enable

ocaml/xapi/xapi_systemctl.mli

@@ -15,6 +15,10 @@
 (* Exception about systemctl operation like start/stop failed *)
 exception Systemctl_fail of string
 
+type t = Start | Stop | Restart | Enable | Disable
+
+val to_string : t -> string
+
 (* start a service with systemctl *)
 val start : ?timeout:float -> wait_until_success:bool -> string -> unit
 
@@ -23,3 +27,9 @@ val stop : ?timeout:float -> wait_until_success:bool -> string -> unit
 
 (* restart a service with systemctl *)
 val restart : ?timeout:float -> wait_until_success:bool -> string -> unit
+
+(* enable a service with systemctl *)
+val enable : ?timeout:float -> wait_until_success:bool -> string -> unit
+
+(* disable a service with systemctl *)
+val disable : ?timeout:float -> wait_until_success:bool -> string -> unit