CP-53725 Create SSH-related xe CLI for Dom0 SSH control

Updated `records.ml` to support `host-param-set/get/list` and `pool-param-set/get/list` for SSH-related fields.

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

Author: LunfanZhang

ocaml/xapi-cli-server/records.ml

@@ -20,6 +20,8 @@ let nullref = Ref.string_of Ref.null
 
 let nid = "<not in database>"
 
+let inconsistent = "<inconsistent>"
+
 let unknown_time = "<unknown time>"
 
 let string_of_float f = Printf.sprintf "%.3f" f
@@ -204,6 +206,31 @@ let get_pbds_host rpc session_id pbds =
 let get_sr_host rpc session_id record =
   get_pbds_host rpc session_id record.API.sR_PBDs
 
+(** Get a field from the first host, or return a default value if the field
+    is not the same on all hosts. *)
+let get_consistent_field_or_default ~rpc ~session_id ~getter ~transform ~default
+    =
+  match Client.Host.get_all ~rpc ~session_id with
+  | [] ->
+      default
+  | hosts -> (
+      let result =
+        List.fold_left
+          (fun acc host ->
+            match acc with
+            | `Inconsistent ->
+                `Inconsistent
+            | `NotSet ->
+                `Value (getter ~rpc ~session_id ~self:host |> transform)
+            | `Value v ->
+                let current = getter ~rpc ~session_id ~self:host |> transform in
+                if v = current then `Value v else `Inconsistent
+          )
+          `NotSet hosts
+      in
+      match result with `Value v -> v | _ -> default
+    )
+
 let bond_record rpc session_id bond =
   let _ref = ref bond in
   let empty_record =
@@ -1506,6 +1533,44 @@ let pool_record rpc session_id pool =
           )
           ~get_map:(fun () -> (x ()).API.pool_license_server)
           ()
+      ; make_field ~name:"ssh-enabled"
+          ~get:(fun () ->
+            get_consistent_field_or_default ~rpc ~session_id
+              ~getter:Client.Host.get_ssh_enabled ~transform:string_of_bool
+              ~default:inconsistent
+          )
+          ()
+      ; make_field ~name:"ssh-enabled-timeout"
+          ~get:(fun () ->
+            get_consistent_field_or_default ~rpc ~session_id
+              ~getter:Client.Host.get_ssh_enabled_timeout
+              ~transform:Int64.to_string ~default:inconsistent
+          )
+          ~set:(fun value ->
+            let minutes = safe_i64_of_string "ssh-enabled-timeout" value in
+            let seconds = Int64.mul minutes 60L in
+            Client.Pool.set_ssh_enabled_timeout ~rpc ~session_id ~self:pool
+              ~value:seconds
+          )
+          ()
+      ; make_field ~name:"ssh-expiry"
+          ~get:(fun () ->
+            get_consistent_field_or_default ~rpc ~session_id
+              ~getter:Client.Host.get_ssh_expiry ~transform:Date.to_rfc3339
+              ~default:inconsistent
+          )
+          ()
+      ; make_field ~name:"console-idle-timeout"
+          ~get:(fun () ->
+            get_consistent_field_or_default ~rpc ~session_id
+              ~getter:Client.Host.get_console_idle_timeout
+              ~transform:Int64.to_string ~default:inconsistent
+          )
+          ~set:(fun value ->
+            Client.Pool.set_console_idle_timeout ~rpc ~session_id ~self:pool
+              ~value:(Int64.of_string value)
+          )
+          ()
       ]
   }
 
@@ -3265,6 +3330,28 @@ let host_record rpc session_id host =
       ; make_field ~name:"last-update-hash"
           ~get:(fun () -> (x ()).API.host_last_update_hash)
           ()
+      ; make_field ~name:"ssh-enabled"
+          ~get:(fun () -> string_of_bool (x ()).API.host_ssh_enabled)
+          ()
+      ; make_field ~name:"ssh-enabled-timeout"
+          ~get:(fun () -> Int64.to_string (x ()).API.host_ssh_enabled_timeout)
+          ~set:(fun value ->
+            let minutes = safe_i64_of_string "ssh-enabled-timeout" value in
+            let seconds = Int64.mul minutes 60L in
+            Client.Host.set_ssh_enabled_timeout ~rpc ~session_id ~self:host
+              ~value:seconds
+          )
+          ()
+      ; make_field ~name:"ssh-expiry"
+          ~get:(fun () -> Date.to_rfc3339 (x ()).API.host_ssh_expiry)
+          ()
+      ; make_field ~name:"console-idle-timeout"
+          ~get:(fun () -> Int64.to_string (x ()).API.host_console_idle_timeout)
+          ~set:(fun value ->
+            Client.Host.set_console_idle_timeout ~rpc ~session_id ~self:host
+              ~value:(safe_i64_of_string "console-idle-timeout" value)
+          )
+          ()
       ]
   }