diff --git a/ocaml/idl/datamodel_common.ml b/ocaml/idl/datamodel_common.ml index e66ab3eff93..45b9d3068e6 100644 --- a/ocaml/idl/datamodel_common.ml +++ b/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 = 781 +let schema_minor_vsn = 782 (* Historical schema versions just in case this is useful later *) let rio_schema_major_vsn = 5 diff --git a/ocaml/idl/datamodel_pool.ml b/ocaml/idl/datamodel_pool.ml index cdc830add08..198c8b5a83a 100644 --- a/ocaml/idl/datamodel_pool.ml +++ b/ocaml/idl/datamodel_pool.ml @@ -1136,6 +1136,40 @@ let set_ext_auth_max_threads = ~params:[(Ref _pool, "self", "The pool"); (Int, "value", "The new maximum")] ~allowed_roles:_R_POOL_OP () +let set_ext_auth_cache_enabled = + call ~name:"set_ext_auth_cache_enabled" ~lifecycle:[] + ~params: + [ + (Ref _pool, "self", "The pool") + ; ( Bool + , "value" + , "Specifies whether caching is enabled for external authentication" + ) + ] + ~hide_from_docs:true ~allowed_roles:_R_POOL_OP () + +let set_ext_auth_cache_size = + call ~name:"set_ext_auth_cache_size" ~lifecycle:[] + ~params: + [ + (Ref _pool, "self", "The pool") + ; (Int, "value", "The capacity of the external authentication cache") + ] + ~hide_from_docs:true ~allowed_roles:_R_POOL_OP () + +let set_ext_auth_cache_expiry = + call ~name:"set_ext_auth_cache_expiry" ~lifecycle:[] + ~params: + [ + (Ref _pool, "self", "The pool") + ; ( Int + , "value" + , "The expiry time of entries in the external authentication cache (in \ + seconds - 300 seconds, i.e. 5 minutes, is the default value)" + ) + ] + ~hide_from_docs:true ~allowed_roles:_R_POOL_OP () + let pool_guest_secureboot_readiness = Enum ( "pool_guest_secureboot_readiness" @@ -1245,6 +1279,9 @@ let t = ; set_update_sync_enabled ; set_local_auth_max_threads ; set_ext_auth_max_threads + ; set_ext_auth_cache_enabled + ; set_ext_auth_cache_size + ; set_ext_auth_cache_expiry ; get_guest_secureboot_readiness ] ~contents: @@ -1488,6 +1525,18 @@ let t = ; field ~qualifier:StaticRO ~ty:Int ~default_value:(Some (VInt 1L)) ~lifecycle:[] "ext_auth_max_threads" "Maximum number of threads to use for external (AD) authentication" + ; field ~qualifier:DynamicRO ~ty:Bool + ~default_value:(Some (VBool false)) ~lifecycle:[] + "ext_auth_cache_enabled" + "Specifies whether external authentication caching is enabled for \ + this pool or not" + ; field ~qualifier:DynamicRO ~ty:Int ~default_value:(Some (VInt 50L)) + ~lifecycle:[] "ext_auth_cache_size" + "Maximum capacity of external authentication cache" + ; field ~qualifier:DynamicRO ~ty:Int ~default_value:(Some (VInt 300L)) + ~lifecycle:[] "ext_auth_cache_expiry" + "Specifies how long external authentication entries should be \ + cached for (seconds)" ; field ~lifecycle:[] ~qualifier:DynamicRO ~ty:(Ref _secret) ~default_value:(Some (VRef null_ref)) "telemetry_uuid" "The UUID of the pool for identification of telemetry data" diff --git a/ocaml/idl/schematest.ml b/ocaml/idl/schematest.ml index 0afe0a10be1..611dc17f605 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 = "60590fa3fa2f8af66d9bf3c50b7bacc2" +let last_known_schema_hash = "5f1637f4ddfaa2a0dfb6cfc318451855" 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 293317518a4..c327914b0f9 100644 --- a/ocaml/tests/common/test_common.ml +++ b/ocaml/tests/common/test_common.ml @@ -316,8 +316,10 @@ let make_pool ~__context ~master ?(name_label = "") ?(name_description = "") ~repository_proxy_url ~repository_proxy_username ~repository_proxy_password ~migration_compression ~coordinator_bias ~telemetry_uuid ~telemetry_frequency ~telemetry_next_collection ~last_update_sync - ~local_auth_max_threads:8L ~ext_auth_max_threads:8L ~update_sync_frequency - ~update_sync_day ~update_sync_enabled ~recommendations ; + ~local_auth_max_threads:8L ~ext_auth_max_threads:8L + ~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 ; pool_ref let default_sm_features = diff --git a/ocaml/tests/test_auth_cache.ml b/ocaml/tests/test_auth_cache.ml index b273248eb41..571a4de0da5 100644 --- a/ocaml/tests/test_auth_cache.ml +++ b/ocaml/tests/test_auth_cache.ml @@ -79,7 +79,7 @@ let credentials = let test_cache_similar_passwords () = let user = "user" in let password = "passwordpasswordpassword" in - let cache = Cache.create ~size:1 in + let cache = Cache.create ~size:1 ~ttl:Mtime.Span.(10 * s) in insert cache (user, password, "session") ; for len = String.length password - 1 downto 0 do let password' = String.sub password 0 len in @@ -92,8 +92,8 @@ let test_cache_similar_passwords () = expiration time. *) let test_cache_expiration () = let expiry_seconds = 2 in - (Xapi_globs.external_authentication_expiry := Mtime.Span.(expiry_seconds * s)) ; - let cache = Cache.create ~size:100 in + let ttl = Mtime.Span.(expiry_seconds * s) in + let cache = Cache.create ~size:100 ~ttl in (* Cache all the credentials. *) CS.iter (insert cache) credentials ; (* Immediately check that all the values are cached. *) @@ -112,17 +112,13 @@ let test_cache_expiration () = of cached entries. *) let test_cache_updates_duplicates () = let expiry_seconds = 1 in - (Xapi_globs.external_authentication_expiry := Mtime.Span.(expiry_seconds * s)) ; + let ttl = Mtime.Span.(expiry_seconds * s) in let count = CS.cardinal credentials in - let cache = Cache.create ~size:count in + let cache = Cache.create ~size:count ~ttl in let credentials = CS.to_seq credentials in Seq.iter (insert cache) credentials ; let is_even i = i mod 2 = 0 in (* Elements occurring at even indices will have their TTLs extended. *) - (Xapi_globs.external_authentication_expiry := - let expiry_seconds' = 30 * expiry_seconds in - Mtime.Span.(expiry_seconds' * s) - ) ; Seq.iteri (fun i c -> if is_even i then insert cache c) credentials ; (* Delay for at least as long as the original TTL. *) Thread.delay (float_of_int expiry_seconds) ; @@ -144,9 +140,9 @@ let test_cache_updates_duplicates () = By the end, the cache must have iteratively evicted each previous entry and should only contain elements of c'_1, c'_2, ..., c'_N. *) let test_cache_eviction () = - (Xapi_globs.external_authentication_expiry := Mtime.Span.(30 * s)) ; + let ttl = Mtime.Span.(30 * s) in let count = CS.cardinal credentials in - let cache = Cache.create ~size:count in + let cache = Cache.create ~size:count ~ttl in CS.iter (insert cache) credentials ; (* Augment each of the credentials *) let change = ( ^ ) "_different_" in diff --git a/ocaml/xapi-cli-server/records.ml b/ocaml/xapi-cli-server/records.ml index 3798280d082..cd7e2f5ae80 100644 --- a/ocaml/xapi-cli-server/records.ml +++ b/ocaml/xapi-cli-server/records.ml @@ -1469,6 +1469,31 @@ let pool_record rpc session_id pool = ~get:(fun () -> get_from_map (x ()).API.pool_recommendations) ~get_map:(fun () -> (x ()).API.pool_recommendations) () + ; make_field ~name:"ext-auth-cache-enabled" ~hidden:true + ~get:(fun () -> + (x ()).API.pool_ext_auth_cache_enabled |> string_of_bool + ) + ~set:(fun v -> + Client.Pool.set_ext_auth_cache_enabled ~rpc ~session_id ~self:pool + ~value:(bool_of_string v) + ) + () + ; make_field ~name:"ext-auth-cache-size" ~hidden:true + ~get:(fun () -> (x ()).API.pool_ext_auth_cache_size |> Int64.to_string) + ~set:(fun v -> + Client.Pool.set_ext_auth_cache_size ~rpc ~session_id ~self:pool + ~value:(Int64.of_string v) + ) + () + ; make_field ~name:"ext-auth-cache-expiry" ~hidden:true + ~get:(fun () -> + (x ()).API.pool_ext_auth_cache_expiry |> Int64.to_string + ) + ~set:(fun v -> + Client.Pool.set_ext_auth_cache_expiry ~rpc ~session_id ~self:pool + ~value:(Int64.of_string v) + ) + () ] } diff --git a/ocaml/xapi/dbsync_master.ml b/ocaml/xapi/dbsync_master.ml index 31f235e7214..aad7434dc02 100644 --- a/ocaml/xapi/dbsync_master.ml +++ b/ocaml/xapi/dbsync_master.ml @@ -54,7 +54,8 @@ let create_pool_record ~__context = ~last_update_sync:Xapi_stdext_date.Date.epoch ~update_sync_frequency:`weekly ~update_sync_day:0L ~update_sync_enabled:false ~local_auth_max_threads:8L - ~ext_auth_max_threads:1L ~recommendations:[] + ~ext_auth_max_threads:1L ~ext_auth_cache_enabled:false + ~ext_auth_cache_size:50L ~ext_auth_cache_expiry:300L ~recommendations:[] let set_master_ip ~__context = let ip = diff --git a/ocaml/xapi/helpers.ml b/ocaml/xapi/helpers.ml index ab39410bb91..0a32a8af1d3 100644 --- a/ocaml/xapi/helpers.ml +++ b/ocaml/xapi/helpers.ml @@ -2262,7 +2262,7 @@ module AuthenticationCache = struct type session - val create : size:int -> t + val create : size:int -> ttl:Mtime.span -> t val cache : t -> user -> password -> session -> unit @@ -2282,13 +2282,25 @@ module AuthenticationCache = struct type session = Secret.secret - type t = {cache: Q.t; mutex: Mutex.t; elapsed: Mtime_clock.counter} + type t = { + cache: Q.t + ; mutex: Mutex.t + ; elapsed: Mtime_clock.counter + (* Counter that can be queried to + find out how much time has elapsed since the cache's + construction. This is used as a reference point when creating and + comparing expiration spans on cache entries. *) + ; ttl: Mtime.span + (* Time-to-live associated with each cached entry. Once + this time elapses, the entry is invalidated.*) + } - let create ~size = + let create ~size ~ttl = { cache= Q.create ~capacity:size ; mutex= Mutex.create () ; elapsed= Mtime_clock.counter () + ; ttl } let with_lock m f = @@ -2304,7 +2316,7 @@ module AuthenticationCache = struct let@ () = with_lock t.mutex in let expires = let elapsed = Mtime_clock.count t.elapsed in - let timeout = !Xapi_globs.external_authentication_expiry in + let timeout = t.ttl in Mtime.Span.add elapsed timeout in let salt = Secret.create_salt () in diff --git a/ocaml/xapi/message_forwarding.ml b/ocaml/xapi/message_forwarding.ml index 83d4ff26e24..cbbbdb1f078 100644 --- a/ocaml/xapi/message_forwarding.ml +++ b/ocaml/xapi/message_forwarding.ml @@ -1166,6 +1166,24 @@ functor value ; Local.Pool.set_ext_auth_max_threads ~__context ~self ~value + let set_ext_auth_cache_enabled ~__context ~self ~value = + info "%s: pool='%s' value='%b'" __FUNCTION__ + (pool_uuid ~__context self) + value ; + Local.Pool.set_ext_auth_cache_enabled ~__context ~self ~value + + let set_ext_auth_cache_size ~__context ~self ~value = + info "%s: pool='%s' value='%Ld'" __FUNCTION__ + (pool_uuid ~__context self) + value ; + Local.Pool.set_ext_auth_cache_size ~__context ~self ~value + + let set_ext_auth_cache_expiry ~__context ~self ~value = + info "%s: pool='%s' value='%Ld'" __FUNCTION__ + (pool_uuid ~__context self) + value ; + Local.Pool.set_ext_auth_cache_expiry ~__context ~self ~value + let get_guest_secureboot_readiness ~__context ~self = info "%s: pool='%s'" __FUNCTION__ (pool_uuid ~__context self) ; Local.Pool.get_guest_secureboot_readiness ~__context ~self diff --git a/ocaml/xapi/xapi_globs.ml b/ocaml/xapi/xapi_globs.ml index cbaa7430e88..d23d7ec4ce6 100644 --- a/ocaml/xapi/xapi_globs.ml +++ b/ocaml/xapi/xapi_globs.ml @@ -1040,12 +1040,6 @@ let cert_thumbprint_header_value_sha1 = ref "sha-1:master" let cert_thumbprint_header_response = ref "x-xenapi-response-host-certificate-thumbprint" -let external_authentication_expiry = ref Mtime.Span.(5 * min) - -let external_authentication_cache_enabled = ref false - -let external_authentication_cache_size = ref 50 - let observer_endpoint_http_enabled = ref false let observer_endpoint_https_enabled = ref false @@ -1149,14 +1143,7 @@ let xapi_globs_spec = ; ("test-open", Int test_open) (* for consistency with xenopsd *) ] -let xapi_globs_spec_with_descriptions = - [ - ( "external-authentication-expiry" - , ShortDurationFromSeconds external_authentication_expiry - , "Specify how long externally authenticated login decisions should be \ - cached (in seconds)" - ) - ] +let xapi_globs_spec_with_descriptions = [] let option_of_xapi_globs_spec ?(description = None) (name, ty) = let spec = @@ -1625,21 +1612,6 @@ let other_options = , (fun () -> string_of_bool !disable_webserver) , "Disable the host webserver" ) - ; ( "enable-external-authentication-cache" - , Arg.Set external_authentication_cache_enabled - , (fun () -> string_of_bool !external_authentication_cache_enabled) - , "Enable caching of external authentication decisions" - ) - ; ( "external-authentication-cache-size" - , Arg.Int (fun sz -> external_authentication_cache_size := sz) - , (fun () -> string_of_int !external_authentication_cache_size) - , "Specify the maximum capacity of the external authentication cache" - ) - ; ( "threshold_last_active" - , Arg.Int (fun t -> threshold_last_active := Ptime.Span.of_int_s t) - , (fun () -> Format.asprintf "%a" Ptime.Span.pp !threshold_last_active) - , "Specify the threshold below which we do not refresh the session" - ) ] (* The options can be set with the variable xapiflags in /etc/sysconfig/xapi. diff --git a/ocaml/xapi/xapi_pool.ml b/ocaml/xapi/xapi_pool.ml index 1b2f4c08a75..39b5dbd447b 100644 --- a/ocaml/xapi/xapi_pool.ml +++ b/ocaml/xapi/xapi_pool.ml @@ -3781,6 +3781,29 @@ let set_local_auth_max_threads ~__context:_ ~self:_ ~value = let set_ext_auth_max_threads ~__context:_ ~self:_ ~value = Xapi_session.set_ext_auth_max_threads value +let set_ext_auth_cache_enabled ~__context ~self ~value:enabled = + Db.Pool.set_ext_auth_cache_enabled ~__context ~self ~value:enabled ; + if not enabled then + Xapi_session.clear_external_auth_cache () + +let set_ext_auth_cache_size ~__context ~self ~value:capacity = + if capacity < 0L then + raise + Api_errors.( + Server_error (invalid_value, ["size"; Int64.to_string capacity]) + ) + else + Db.Pool.set_ext_auth_cache_size ~__context ~self ~value:capacity + +let set_ext_auth_cache_expiry ~__context ~self ~value:expiry_seconds = + if expiry_seconds <= 0L then + raise + Api_errors.( + Server_error (invalid_value, ["expiry"; Int64.to_string expiry_seconds]) + ) + else + Db.Pool.set_ext_auth_cache_expiry ~__context ~self ~value:expiry_seconds + let get_guest_secureboot_readiness ~__context ~self:_ = let auth_files = Sys.readdir !Xapi_globs.varstore_dir in let pk_present = Array.mem "PK.auth" auth_files in diff --git a/ocaml/xapi/xapi_pool.mli b/ocaml/xapi/xapi_pool.mli index 9e74ea3f373..0bd71a22996 100644 --- a/ocaml/xapi/xapi_pool.mli +++ b/ocaml/xapi/xapi_pool.mli @@ -418,6 +418,15 @@ val set_local_auth_max_threads : val set_ext_auth_max_threads : __context:Context.t -> self:API.ref_pool -> value:int64 -> unit +val set_ext_auth_cache_enabled : + __context:Context.t -> self:API.ref_pool -> value:bool -> unit + +val set_ext_auth_cache_size : + __context:Context.t -> self:API.ref_pool -> value:int64 -> unit + +val set_ext_auth_cache_expiry : + __context:Context.t -> self:API.ref_pool -> value:int64 -> unit + val get_guest_secureboot_readiness : __context:Context.t -> self:API.ref_pool diff --git a/ocaml/xapi/xapi_session.ml b/ocaml/xapi/xapi_session.ml index 72a0ff7c705..4def022bfcc 100644 --- a/ocaml/xapi/xapi_session.ml +++ b/ocaml/xapi/xapi_session.ml @@ -788,28 +788,42 @@ module Caching = struct let ( let@ ) = ( @@ ) (* Attain the extant cache or get nothing if caching is - disabled. This function exists to delay the construction of the - cache, as Xapi_globs configuration is not guaranteed to have been - populated before the top-level code of this module is executed. *) - let get_or_init_cache () = - if not !Xapi_globs.external_authentication_cache_enabled then + disabled. *) + let get_or_init_cache ~__context = + let pool = Helpers.get_pool ~__context in + let cache_enabled = + Db.Pool.get_ext_auth_cache_enabled ~__context ~self:pool + in + if not cache_enabled then None else - let capacity = !Xapi_globs.external_authentication_cache_size in let@ () = with_lock lock in match !cache with | Some _ as extant -> extant | _ -> - let auth_cache = AuthenticationCache.create ~size:capacity in + let capacity = + Db.Pool.get_ext_auth_cache_size ~__context ~self:pool + |> Int64.to_int + in + let ttl = + Db.Pool.get_ext_auth_cache_expiry ~__context ~self:pool + |> Int64.unsigned_to_int + |> Option.map (fun sec -> Mtime.Span.(sec * s)) + |> Option.value ~default:Mtime.Span.(5 * min) + in + let span = Format.asprintf "%a" Mtime.Span.pp ttl in + info "Creating authentication cache of capacity %d and TTL of %s" + capacity span ; + let auth_cache = AuthenticationCache.create ~size:capacity ~ttl in let instance = Some auth_cache in cache := instance ; instance (* Try to insert into cache. The cache could have been disabled during query to external authentication plugin. *) - let insert_into_cache username password result = - match get_or_init_cache () with + let insert_into_cache ~__context username password result = + match get_or_init_cache ~__context with | None -> () | Some cache -> @@ -818,13 +832,13 @@ module Caching = struct (* Consult the cache or rely on a provided "slow path". Each time the slow path is invoked, an attempt is made to cache its result. *) - let memoize username password ~slow_path = + let memoize ~__context username password ~slow_path = let slow_path () = let ext_auth_result = slow_path () in - insert_into_cache username password ext_auth_result ; + insert_into_cache ~__context username password ext_auth_result ; ext_auth_result in - match get_or_init_cache () with + match get_or_init_cache ~__context with | None -> slow_path () | Some cache -> ( @@ -840,6 +854,7 @@ module Caching = struct ) let clear_cache () = + info "Clearing authentication cache" ; let@ () = with_lock lock in cache := None end @@ -1206,7 +1221,8 @@ let login_with_password ~__context ~uname ~pwd ~version:_ ~originator = ; subject_name ; rbac_permissions } = - Caching.memoize uname pwd ~slow_path:query_external_auth + Caching.memoize ~__context uname pwd + ~slow_path:query_external_auth in login_no_password_common ~__context ~uname:(Some uname) ~originator