CP-53477 Update API/CLI to Support Dom0 SSH Control

ocaml/idl/datamodel_common.ml

@@ -10,7 +10,7 @@ open Datamodel_roles
               to leave a gap for potential hotfixes needing to increment the schema version.*)
 let schema_major_vsn = 5
 
-let schema_minor_vsn = 786
+let schema_minor_vsn = 787
 
 (* Historical schema versions just in case this is useful later *)
 let rio_schema_major_vsn = 5

ocaml/idl/datamodel_errors.ml

@@ -2043,6 +2043,9 @@ let _ =
   error Api_errors.host_driver_no_hardware ["driver variant"]
     ~doc:"No hardware present for this host driver variant" () ;
 
+  error Api_errors.set_console_timeout_failed ["timeout"]
+    ~doc:"Failed to set SSH&VNC idle session timeout." () ;
+
   error Api_errors.tls_verification_not_enabled_in_pool []
     ~doc:
       "TLS verification has not been enabled in the pool successfully, please \

ocaml/idl/datamodel_host.ml

@@ -2368,6 +2368,29 @@ let disable_ssh =
     ~params:[(Ref _host, "self", "The host")]
     ~allowed_roles:_R_POOL_ADMIN ()
 
+let set_ssh_enable_timeout =
+  call ~name:"set_ssh_enable_timeout " ~lifecycle:[]
+    ~doc:"Set the SSH service enabled timeout for the host"
+    ~params:
+      [
+        (Ref _host, "self", "The host")
+      ; ( Int
+        , "timeout"
+        , "The SSH enabled timeout in minutes (0 means no timeout, max 2880)"
+        )
+      ]
+    ~allowed_roles:_R_POOL_ADMIN ()
+
+let set_console_timeout =
+  call ~name:"set_console_timeout" ~lifecycle:[]
+    ~doc:"Set the idle SSH/VNC session timeout for the host"
+    ~params:
+      [
+        (Ref _host, "self", "The host")
+      ; (Int, "console_timeout", "The idle console timeout in seconds")
+      ]
+    ~allowed_roles:_R_POOL_ADMIN ()
+
 let latest_synced_updates_applied_state =
   Enum
     ( "latest_synced_updates_applied_state"
@@ -2527,6 +2550,8 @@ let t =
       ; emergency_clear_mandatory_guidance
       ; enable_ssh
       ; disable_ssh
+      ; set_ssh_enable_timeout
+      ; set_console_timeout
       ]
     ~contents:
       ([
@@ -2964,6 +2989,20 @@ let t =
             ~default_value:(Some (VString "")) "last_update_hash"
             "The SHA256 checksum of updateinfo of the most recently applied \
              update on the host"
+        ; field ~qualifier:RW ~lifecycle:[] ~ty:Bool
+            ~default_value:(Some (VBool true)) "ssh_enabled"
+            "True if SSH access is enabled for the host"
+        ; field ~qualifier:RW ~lifecycle:[] ~ty:Int
+            ~default_value:(Some (VInt 0L)) "ssh_enabled_timeout"
+            "The timeout in minutes after which SSH access will be \
+             automatically disabled (0 means never)"
+        ; field ~qualifier:DynamicRO ~lifecycle:[] ~ty:DateTime
+            ~default_value:(Some (VDateTime Date.epoch)) "ssh_expiry"
+            "The time when SSH access will expire"
+        ; field ~qualifier:RW ~lifecycle:[] ~ty:Int
+            ~default_value:(Some (VInt 0L)) "console_idle_timeout"
+            "The timeout in seconds after which idle console will be \
+             automatically terminated (0 means never)"
         ]
       )
     ()

ocaml/idl/datamodel_pool.ml

@@ -1571,6 +1571,33 @@ let disable_ssh =
     ~params:[(Ref _pool, "self", "The pool")]
     ~allowed_roles:_R_POOL_ADMIN ()
 
+let set_ssh_enable_timeout =
+  call ~name:"set_ssh_enable_timeout " ~lifecycle:[]
+    ~doc:"Set the SSH enabled timeout for the hosts in the pool"
+    ~params:
+      [
+        (Ref _pool, "self", "The pool")
+      ; ( Int
+        , "timeout"
+        , "The SSH enabled timeout in minutes. (0 means no timeout, max 2880)"
+        )
+      ]
+    ~allowed_roles:_R_POOL_ADMIN ()
+
+let set_console_timeout =
+  call ~name:"set_console_timeout" ~lifecycle:[]
+    ~doc:"Set the idle SSH/VNC session timeout for the pool"
+    ~params:
+      [
+        (Ref _pool, "self", "The pool")
+      ; ( Int
+        , "console_timeout"
+        , "The idle SSH/VNC session timeout in seconds. A value of 0 means no \
+           timeout."
+        )
+      ]
+    ~allowed_roles:_R_POOL_ADMIN ()
+
 (** A pool class *)
 let t =
   create_obj ~in_db:true
@@ -1667,6 +1694,8 @@ let t =
       ; get_guest_secureboot_readiness
       ; enable_ssh
       ; disable_ssh
+      ; set_ssh_enable_timeout
+      ; set_console_timeout
       ]
     ~contents:
       ([

ocaml/idl/schematest.ml

@@ -3,7 +3,7 @@ let hash x = Digest.string x |> Digest.to_hex
 (* BEWARE: if this changes, check that schema has been bumped accordingly in
    ocaml/idl/datamodel_common.ml, usually schema_minor_vsn *)
 
-let last_known_schema_hash = "ad67a64cd47cdea32085518c1fb38d27"
+let last_known_schema_hash = "42fd0bbdc613092390c32e04e35a24d2"
 
 let current_schema_hash : string =
   let open Datamodel_types in

ocaml/tests/common/test_common.ml

@@ -215,7 +215,8 @@ let make_host2 ~__context ?(ref = Ref.make ()) ?(uuid = make_uuid ())
     ~last_software_update:(Xapi_host.get_servertime ~__context ~host:ref)
     ~recommended_guidances:[] ~latest_synced_updates_applied:`unknown
     ~pending_guidances_recommended:[] ~pending_guidances_full:[]
-    ~last_update_hash:"" ;
+    ~last_update_hash:"" ~ssh_enabled:true ~ssh_enabled_timeout:0L
+    ~ssh_expiry:Date.epoch ~console_idle_timeout:0L ;
   ref
 
 let make_pif ~__context ~network ~host ?(device = "eth0")

ocaml/xapi-cli-server/records.ml

@@ -204,6 +204,20 @@ 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
 
+let get_unified_field ~rpc ~session_id ~getter ~transform ~default =
+  match Client.Host.get_all ~rpc ~session_id with
+  | [] ->
+      default (* No hosts - return default *)
+  | h :: hs ->
+      let first_value = getter ~rpc ~session_id ~self:h |> transform in
+      let all_values =
+        List.map (fun h -> getter ~rpc ~session_id ~self:h |> transform) hs
+      in
+      if List.for_all (( = ) first_value) all_values then
+        first_value
+      else
+        default
+
 let bond_record rpc session_id bond =
   let _ref = ref bond in
   let empty_record =
@@ -1506,6 +1520,42 @@ let pool_record rpc session_id pool =
           )
           ~get_map:(fun () -> (x ()).API.pool_license_server)
           ()
+      ; make_field ~name:"ssh-enabled"
+          ~get:(fun () ->
+            get_unified_field ~rpc ~session_id
+              ~getter:Client.Host.get_ssh_enabled ~transform:string_of_bool
+              ~default:""
+          )
+          ()
+      ; make_field ~name:"ssh-enabled-timeout"
+          ~get:(fun () ->
+            get_unified_field ~rpc ~session_id
+              ~getter:Client.Host.get_ssh_enabled_timeout
+              ~transform:Int64.to_string ~default:""
+          )
+          ~set:(fun value ->
+            Client.Pool.set_ssh_enable_timeout ~rpc ~session_id ~self:pool
+              ~timeout:(Int64.of_string value)
+          )
+          ()
+      ; make_field ~name:"ssh-expiry"
+          ~get:(fun () ->
+            get_unified_field ~rpc ~session_id
+              ~getter:Client.Host.get_ssh_expiry ~transform:Date.to_rfc3339
+              ~default:""
+          )
+          ()
+      ; make_field ~name:"console-idle-timeout"
+          ~get:(fun () ->
+            get_unified_field ~rpc ~session_id
+              ~getter:Client.Host.get_console_idle_timeout
+              ~transform:Int64.to_string ~default:""
+          )
+          ~set:(fun value ->
+            Client.Pool.set_console_timeout ~rpc ~session_id ~self:pool
+              ~console_timeout:(Int64.of_string value)
+          )
+          ()
       ]
   }
 
@@ -3265,6 +3315,26 @@ 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 ->
+            Client.Host.set_ssh_enable_timeout ~rpc ~session_id ~self:host
+              ~timeout:(safe_i64_of_string "ssh-enabled-timeout" value)
+          )
+          ()
+      ; 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_timeout ~rpc ~session_id ~self:host
+              ~console_timeout:(safe_i64_of_string "console-idle-timeout" value)
+          )
+          ()
       ]
   }
 

ocaml/xapi-consts/api_errors.ml

@@ -1424,3 +1424,5 @@ let host_driver_no_hardware = add_error "HOST_DRIVER_NO_HARDWARE"
 
 let tls_verification_not_enabled_in_pool =
   add_error "TLS_VERIFICATION_NOT_ENABLED_IN_POOL"
+
+let set_console_timeout_failed = add_error "SET_CONSOLE_TIMEOUT_FAILED"

ocaml/xapi/message_forwarding.ml

@@ -1185,6 +1185,14 @@ functor
       let disable_ssh ~__context ~self =
         info "%s: pool = '%s'" __FUNCTION__ (pool_uuid ~__context self) ;
         Local.Pool.disable_ssh ~__context ~self
+
+      let set_ssh_enable_timeout ~__context ~self ~timeout =
+        info "%s: pool = '%s'" __FUNCTION__ (pool_uuid ~__context self) ;
+        Local.Pool.set_ssh_enable_timeout ~__context ~self ~timeout
+
+      let set_console_timeout ~__context ~self ~console_timeout =
+        info "%s: pool = '%s'" __FUNCTION__ (pool_uuid ~__context self) ;
+        Local.Pool.set_console_timeout ~__context ~self ~console_timeout
     end
 
     module VM = struct
@@ -4035,6 +4043,22 @@ functor
         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
+
+      let set_ssh_enable_timeout ~__context ~self ~timeout =
+        let uuid = host_uuid ~__context self in
+        info "Host.set_ssh_enable_timeout : host = '%s'" uuid ;
+        let local_fn = Local.Host.set_ssh_enable_timeout ~self ~timeout in
+        let remote_fn = Client.Host.set_ssh_enable_timeout ~self ~timeout in
+        do_op_on ~local_fn ~__context ~host:self ~remote_fn
+
+      let set_console_timeout ~__context ~self ~console_timeout =
+        let uuid = host_uuid ~__context self in
+        info "Host.set_console_timeout: host = '%s'" uuid ;
+        let local_fn = Local.Host.set_console_timeout ~self ~console_timeout in
+        let remote_fn =
+          Client.Host.set_console_timeout ~self ~console_timeout
+        in
+        do_op_on ~local_fn ~__context ~host:self ~remote_fn
     end
 
     module Host_crashdump = struct