diff --git a/ocaml/idl/datamodel_lifecycle.ml b/ocaml/idl/datamodel_lifecycle.ml index 3a644fba8cd..3a9413fb8c1 100644 --- a/ocaml/idl/datamodel_lifecycle.ml +++ b/ocaml/idl/datamodel_lifecycle.ml @@ -137,6 +137,8 @@ let prototyped_of_field = function Some "23.18.0" | "VM", "actions__after_softreboot" -> Some "23.1.0" + | "pool", "limit_console_sessions" -> + Some "25.30.0-next" | "pool", "ha_reboot_vm_on_internal_shutdown" -> Some "25.16.0" | "pool", "license_server" -> diff --git a/ocaml/idl/datamodel_pool.ml b/ocaml/idl/datamodel_pool.ml index 1874512c14d..fcf1eb20571 100644 --- a/ocaml/idl/datamodel_pool.ml +++ b/ocaml/idl/datamodel_pool.ml @@ -2250,6 +2250,12 @@ let t = "Indicates whether an HA-protected VM that is shut down from \ inside (not through the API) should be automatically rebooted \ when HA is enabled" + ; field ~writer_roles:_R_POOL_OP ~qualifier:RW ~lifecycle:[] ~ty:Bool + ~default_value:(Some (VBool false)) "limit_console_sessions" + "When true, only one console connection per VM/host in the pool is \ + accepted. Otherwise every connection for a VM/host's console is \ + accepted. Note: when true, connection attempts via websocket will \ + be rejected." ] ) () diff --git a/ocaml/idl/schematest.ml b/ocaml/idl/schematest.ml index 963231d7d69..9620c6b4869 100644 --- a/ocaml/idl/schematest.ml +++ b/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 = "7586cb039918e573594fc358e90b0f04" +let last_known_schema_hash = "cf1c1e26b4288dd53cf6da5a4d6ad13c" let current_schema_hash : string = let open Datamodel_types in diff --git a/ocaml/tests/common/test_common.ml b/ocaml/tests/common/test_common.ml index ec058006851..7c33b085693 100644 --- a/ocaml/tests/common/test_common.ml +++ b/ocaml/tests/common/test_common.ml @@ -305,7 +305,8 @@ let make_pool ~__context ~master ?(name_label = "") ?(name_description = "") ?(last_update_sync = API.Date.epoch) ?(update_sync_frequency = `daily) ?(update_sync_day = 0L) ?(update_sync_enabled = false) ?(recommendations = []) ?(license_server = []) - ?(ha_reboot_vm_on_internal_shutdown = true) () = + ?(ha_reboot_vm_on_internal_shutdown = true) + ?(limit_console_sessions = false) () = let pool_ref = Ref.make () in Db.Pool.create ~__context ~ref:pool_ref ~uuid:(make_uuid ()) ~name_label ~name_description ~master ~default_SR ~suspend_image_SR ~crash_dump_SR @@ -326,7 +327,7 @@ let make_pool ~__context ~master ?(name_label = "") ?(name_description = "") ~ext_auth_cache_enabled:false ~ext_auth_cache_size:50L ~ext_auth_cache_expiry:300L ~update_sync_frequency ~update_sync_day ~update_sync_enabled ~recommendations ~license_server - ~ha_reboot_vm_on_internal_shutdown ; + ~ha_reboot_vm_on_internal_shutdown ~limit_console_sessions ; pool_ref let default_sm_features = diff --git a/ocaml/xapi-cli-server/records.ml b/ocaml/xapi-cli-server/records.ml index 06e9b5e6e47..aadf3711de9 100644 --- a/ocaml/xapi-cli-server/records.ml +++ b/ocaml/xapi-cli-server/records.ml @@ -1595,6 +1595,13 @@ let pool_record rpc session_id pool = ~value:(safe_bool_of_string "ssh-auto-mode" value) ) () + ; make_field ~name:"limit-console-sessions" + ~get:(fun () -> string_of_bool (x ()).API.pool_limit_console_sessions) + ~set:(fun x -> + Client.Pool.set_limit_console_sessions ~rpc ~session_id ~self:pool + ~value:(safe_bool_of_string "limit-console-sessions" x) + ) + () ] } diff --git a/ocaml/xapi/console.ml b/ocaml/xapi/console.ml index b812cf65c76..56069c2aa3e 100644 --- a/ocaml/xapi/console.ml +++ b/ocaml/xapi/console.ml @@ -34,6 +34,48 @@ type address = (* console is listening on a Unix domain socket *) +(* This module limits VNC console sessions to at most one per VM/host. + Depending on configuration, either unlimited connections are allowed, + or only a single active connection per VM/host is allowed. *) +module Connection_limit = struct + module VMMap = Map.Make (String) + + let active_connections : int VMMap.t ref = ref VMMap.empty + + let mutex = Mutex.create () + + let with_lock = Xapi_stdext_threads.Threadext.Mutex.execute + + let drop vm_id = + with_lock mutex (fun () -> + match VMMap.find_opt vm_id !active_connections with + | Some n when n > 1 -> + active_connections := VMMap.add vm_id (n - 1) !active_connections + | Some _ | None -> + active_connections := VMMap.remove vm_id !active_connections + ) + + (* When the limit is disabled (false), we must still track the connection count for each vm_id. + This ensures that if the limit is later enabled (set to true), any existing connections are accounted for, + and the limit can be correctly enforced for subsequent connection attempts. *) + let try_add vm_id is_limit_enabled = + with_lock mutex (fun () -> + let count = + VMMap.find_opt vm_id !active_connections |> Option.value ~default:0 + in + if is_limit_enabled && count > 0 then ( + debug + "limit_console_sessions is true. Console connection is rejected \ + for VM %s, active connections: %d" + vm_id count ; + false + ) else ( + active_connections := VMMap.add vm_id (count + 1) !active_connections ; + true + ) + ) +end + let string_of_address = function | Port x -> "localhost:" ^ string_of_int x @@ -84,7 +126,7 @@ let address_of_console __context console : address option = ) ; address_option -let real_proxy __context _ _ vnc_port s = +let real_proxy' vnc_port s = try Http_svr.headers s (Http.http_200_ok ()) ; let vnc_sock = @@ -103,7 +145,28 @@ let real_proxy __context _ _ vnc_port s = debug "Proxy exited" with exn -> debug "error: %s" (ExnHelper.string_of_exn exn) -let ws_proxy __context req protocol address s = +let real_proxy __context vm _ _ vnc_port s = + let vm_id = Ref.string_of vm in + let pool = Helpers.get_pool ~__context in + let is_limit_enabled = + Db.Pool.get_limit_console_sessions ~__context ~self:pool + in + if Connection_limit.try_add vm_id is_limit_enabled then + finally (* Ensure we drop the vm connection count if exceptions occur *) + (fun () -> real_proxy' vnc_port s) + (fun () -> Connection_limit.drop vm_id) + else + Http_svr.headers s (Http.http_503_service_unavailable ()) + +let go_if_no_limit __context s f = + let pool = Helpers.get_pool ~__context in + if Db.Pool.get_limit_console_sessions ~__context ~self:pool then + Http_svr.headers s (Http.http_503_service_unavailable ()) + else + f () + +let ws_proxy __context _ req protocol address s = + go_if_no_limit __context s @@ fun () -> let addr = match address with Port p -> string_of_int p | Path p -> p in let protocol = match protocol with `rfb -> "rfb" | `vt100 -> "vt100" | `rdp -> "rdp" @@ -240,6 +303,7 @@ let handler proxy_fn (req : Request.t) s _ = (* only sessions with 'http/connect_console/host_console' permission *) let protocol = Db.Console.get_protocol ~__context ~self:console in (* can access dom0 host consoles *) + let vm = Db.Console.get_VM ~__context ~self:console in rbac_check_for_control_domain __context req console Rbac_static.permission_http_connect_console_host_console .Db_actions.role_name_label ; @@ -247,7 +311,7 @@ let handler proxy_fn (req : Request.t) s _ = check_vm_is_running_here __context console ; match address_of_console __context console with | Some vnc_port -> - proxy_fn __context req protocol vnc_port s + proxy_fn __context vm req protocol vnc_port s | None -> Http_svr.headers s (Http.http_404_missing ()) ) diff --git a/ocaml/xapi/dbsync_master.ml b/ocaml/xapi/dbsync_master.ml index f8316b81993..5988067176d 100644 --- a/ocaml/xapi/dbsync_master.ml +++ b/ocaml/xapi/dbsync_master.ml @@ -55,6 +55,7 @@ let create_pool_record ~__context = ~ext_auth_max_threads:1L ~ext_auth_cache_enabled:false ~ext_auth_cache_size:50L ~ext_auth_cache_expiry:300L ~recommendations:[] ~license_server:[] ~ha_reboot_vm_on_internal_shutdown:true + ~limit_console_sessions:false let set_master_ip ~__context = let ip =