Move external auth cache configuration into the pool object (#5983)

These simple changes move configuration options into the `pool` object.

---

I suspect there are better approaches (naming and convention wise) than
what is done here, and I'm happy to rebase those changes in. This
feature has been tested manually and works. XenRT tests that exercise
this code path properly are still in progress.

---

In future, I wonder if there are less invasive ways we could consider
for providing feature configuration (rather than adding more fields to
extant objects, whose database records are already overly large from the
content they store). Perhaps we could introduce a variant datatype to
the datamodel (akin to DBus' `Variant`) such that fields similar to
`other_config : (string -> string) map` could be more adequately typed
(`config : (string -> variant) map`). This adds a kind of dynamic -
transient - nature to the configuration that we may not want, though.

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