Move external auth cache configuration into the pool object

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

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"

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

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 =

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

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)
+          )
+          ()
       ]
   }
 

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 =

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

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

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.

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

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