CP-53723 Implement Console timeout configure API for Dom0 SSH control

Implemented XAPI APIs:
  - `host.set_console_idle_timeout`
  - `pool.set_console_idle_timeout`

These APIs allow XAPI to configure timeout for idle console sessions.

Signed-off-by: Lunfan Zhang <[email protected]>

Author: LunfanZhang

ocaml/idl/datamodel_errors.ml

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

ocaml/xapi-consts/api_errors.ml

@@ -1420,6 +1420,9 @@ let enable_ssh_partially_failed = add_error "ENABLE_SSH_PARTIALLY_FAILED"
 
 let disable_ssh_partially_failed = add_error "DISABLE_SSH_PARTIALLY_FAILED"
 
+let set_console_timeout_partially_failed =
+  add_error "SET_CONSOLE_TIMEOUT_PARTIALLY_FAILED"
+
 let host_driver_no_hardware = add_error "HOST_DRIVER_NO_HARDWARE"
 
 let tls_verification_not_enabled_in_pool =

ocaml/xapi/xapi_globs.ml

@@ -1287,6 +1287,8 @@ let gpumon_stop_timeout = ref 10.0
 
 let reboot_required_hfxs = ref "/run/reboot-required.hfxs"
 
+let console_timeout_profile_path = ref "/etc/profile.d/xapi-console-timeout.sh"
+
 (* Fingerprint of default patch key *)
 let citrix_patch_key =
   "NERDNTUzMDMwRUMwNDFFNDI4N0M4OEVCRUFEMzlGOTJEOEE5REUyNg=="

ocaml/xapi/xapi_host.ml

@@ -3136,4 +3136,36 @@ let disable_ssh ~__context ~self =
 
 let set_ssh_enabled_timeout ~__context ~self:_ ~value:_ = ()
 
-let set_console_idle_timeout ~__context ~self:_ ~value:_ = ()
+let set_console_idle_timeout ~__context ~self ~value =
+  let assert_timeout_valid timeout =
+    if timeout < 0L then
+      raise
+        (Api_errors.Server_error
+           ( Api_errors.invalid_value
+           , ["console_timeout"; Int64.to_string timeout]
+           )
+        )
+  in
+
+  assert_timeout_valid value ;
+  try
+    let content =
+      match value with
+      | 0L ->
+          "# Console timeout is disabled\n"
+      | timeout ->
+          Printf.sprintf "# Console timeout configuration\nexport TMOUT=%Ld\n"
+            timeout
+    in
+
+    Unixext.atomic_write_to_file !Xapi_globs.console_timeout_profile_path 0o0644
+      (fun fd ->
+        Unix.write fd (Bytes.of_string content) 0 (String.length content)
+        |> ignore
+    ) ;
+
+    Db.Host.set_console_idle_timeout ~__context ~self ~value
+  with e ->
+    error "Failed to configure console timeout: %s" (Printexc.to_string e) ;
+    Helpers.internal_error "Failed to set console timeout: %Ld: %s" value
+      (Printexc.to_string e)

ocaml/xapi/xapi_pool.ml

@@ -4003,6 +4003,13 @@ module Ssh = struct
   let disable ~__context ~self:_ =
     operate ~__context ~action:Client.Host.disable_ssh
       ~error:Api_errors.disable_ssh_partially_failed
+
+  let set_console_timeout ~__context ~self:_ ~value =
+    operate ~__context
+      ~action:(fun ~rpc ~session_id ~self ->
+        Client.Host.set_console_idle_timeout ~rpc ~session_id ~self ~value
+      )
+      ~error:Api_errors.set_console_timeout_partially_failed
 end
 
 let enable_ssh = Ssh.enable
@@ -4011,4 +4018,4 @@ let disable_ssh = Ssh.disable
 
 let set_ssh_enabled_timeout ~__context ~self:_ ~value:_ = ()
 
-let set_console_idle_timeout ~__context ~self:_ ~value:_ = ()
+let set_console_idle_timeout = Ssh.set_console_timeout