CP-43755: Datamodel_pool: introduce local_auth_max_threads and ext_au…

…th_max_threads

These can be changed at runtime.

Although changing the AD max threads is still experimental as we haven't checked whether it is thread safe.
PAM itself is thread safe in the way we currently use it (each thread gets its own PAM context).

Signed-off-by: Edwin Török <[email protected]>

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 = 766
+let schema_minor_vsn = 767
 
 (* Historical schema versions just in case this is useful later *)
 let rio_schema_major_vsn = 5

ocaml/idl/datamodel_pool.ml

@@ -1103,6 +1103,16 @@ let set_update_sync_enabled =
       ]
     ~allowed_roles:_R_POOL_OP ()
 
+let set_local_auth_max_threads =
+  call ~flags:[`Session] ~name:"set_local_auth_max_threads" ~lifecycle:[]
+    ~params:[(Ref _pool, "self", "The pool"); (Int, "value", "The new maximum")]
+    ~allowed_roles:_R_POOL_OP ()
+
+let set_ext_auth_max_threads =
+  call ~flags:[`Session] ~name:"set_ext_auth_max_threads" ~lifecycle:[]
+    ~params:[(Ref _pool, "self", "The pool"); (Int, "value", "The new maximum")]
+    ~allowed_roles:_R_POOL_OP ()
+
 (** A pool class *)
 let t =
   create_obj ~in_db:true ~in_product_since:rel_rio ~in_oss_since:None
@@ -1189,6 +1199,8 @@ let t =
       ; reset_telemetry_uuid
       ; configure_update_sync
       ; set_update_sync_enabled
+      ; set_local_auth_max_threads
+      ; set_ext_auth_max_threads
       ]
     ~contents:
       ([uid ~in_oss_since:None _pool]
@@ -1419,6 +1431,12 @@ let t =
             "coordinator_bias"
             "true if bias against pool master when scheduling vms is enabled, \
              false otherwise"
+        ; field ~qualifier:StaticRO ~ty:Int ~default_value:(Some (VInt 1L))
+            ~lifecycle:[] "local_auth_max_threads"
+            "Maximum number of threads to use for PAM authentication"
+        ; 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 ~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

@@ -2,7 +2,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 = "f4d0ee4f27d7fc0377add334197f6cd8"
+let last_known_schema_hash = "95077aed35b715c362c7cf98902de578"
 
 let current_schema_hash : string =
   let open Datamodel_types in

ocaml/tests/common/test_common.ml

@@ -312,7 +312,8 @@ 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
-    ~update_sync_frequency ~update_sync_day ~update_sync_enabled ;
+    ~local_auth_max_threads:8L ~ext_auth_max_threads:8L ~update_sync_frequency
+    ~update_sync_day ~update_sync_enabled ;
   pool_ref
 
 let default_sm_features =

ocaml/xapi/dbsync_master.ml

@@ -52,7 +52,8 @@ let create_pool_record ~__context =
       ~telemetry_next_collection:Xapi_stdext_date.Date.epoch
       ~last_update_sync:Xapi_stdext_date.Date.epoch
       ~update_sync_frequency:`weekly ~update_sync_day:0L
-      ~update_sync_enabled:false
+      ~update_sync_enabled:false ~local_auth_max_threads:1L
+      ~ext_auth_max_threads:1L
 
 let set_master_ip ~__context =
   let ip =

ocaml/xapi/message_forwarding.ml

@@ -1130,6 +1130,18 @@ functor
           (pool_uuid ~__context self)
           value ;
         Local.Pool.set_update_sync_enabled ~__context ~self ~value
+
+      let set_local_auth_max_threads ~__context ~self ~value =
+        info "%s: pool='%s' value='%Ld'" __FUNCTION__
+          (pool_uuid ~__context self)
+          value ;
+        Local.Pool.set_local_auth_max_threads ~__context ~self ~value
+
+      let set_ext_auth_max_threads ~__context ~self ~value =
+        info "%s: pool='%s' value='%Ld'" __FUNCTION__
+          (pool_uuid ~__context self)
+          value ;
+        Local.Pool.set_ext_auth_max_threads ~__context ~self ~value
     end
 
     module VM = struct

ocaml/xapi/xapi.ml

@@ -886,7 +886,16 @@ let server_init () =
      has just started up we want to wait forever for the master to appear. (See CA-25481) *)
   let initial_connection_timeout = !Master_connection.connection_timeout in
   Master_connection.connection_timeout := -1. ;
+
   (* never timeout *)
+  let initialize_auth_semaphores ~__context =
+    let pool = Helpers.get_pool ~__context in
+    Xapi_session.set_local_auth_max_threads
+      (Db.Pool.get_local_auth_max_threads ~__context ~self:pool) ;
+    Xapi_session.set_ext_auth_max_threads
+      (Db.Pool.get_ext_auth_max_threads ~__context ~self:pool)
+  in
+
   let call_extauth_hook_script_after_xapi_initialize ~__context =
     (* CP-709 *)
     (* in each initialization of xapi, extauth_hook script must be called in case this host was *)
@@ -1390,6 +1399,10 @@ let server_init () =
             , []
             , fun () -> Storage_migrate.killall ~dbg:"xapi init"
             )
+          ; ( "Initialize threaded authentication"
+            , [Startup.NoExnRaising]
+            , fun () -> initialize_auth_semaphores ~__context
+            )
           ; (* Start the external authentification plugin *)
             ( "Calling extauth_hook_script_before_xapi_initialize"
             , [Startup.NoExnRaising]

ocaml/xapi/xapi_pool.ml

@@ -3669,3 +3669,9 @@ let configure_update_sync ~__context ~self ~update_sync_frequency
 let set_update_sync_enabled ~__context ~self ~value =
   Pool_periodic_update_sync.set_enabled ~__context ~value ;
   Db.Pool.set_update_sync_enabled ~__context ~self ~value
+
+let set_local_auth_max_threads ~__context:_ ~self:_ ~value =
+  Xapi_session.set_local_auth_max_threads value
+
+let set_ext_auth_max_threads ~__context:_ ~self:_ ~value =
+  Xapi_session.set_ext_auth_max_threads value

ocaml/xapi/xapi_pool.mli

@@ -408,3 +408,9 @@ val configure_update_sync :
 
 val set_update_sync_enabled :
   __context:Context.t -> self:API.ref_pool -> value:bool -> unit
+
+val set_local_auth_max_threads :
+  __context:Context.t -> self:API.ref_pool -> value:int64 -> unit
+
+val set_ext_auth_max_threads :
+  __context:Context.t -> self:API.ref_pool -> value:int64 -> unit

ocaml/xapi/xapi_session.ml

@@ -261,6 +261,12 @@ let throttle_auth_external = Locking_helpers.Semaphore.create "External auth"
 
 let with_throttle = Locking_helpers.Semaphore.execute
 
+let set_local_auth_max_threads n =
+  Locking_helpers.Semaphore.set_max throttle_auth_internal @@ Int64.to_int n
+
+let set_ext_auth_max_threads n =
+  Locking_helpers.Semaphore.set_max throttle_auth_external @@ Int64.to_int n
+
 let wipe_string_contents str =
   for i = 0 to Bytes.length str - 1 do
     Bytes.set str i '\000'

ocaml/xapi/xapi_session.mli

@@ -106,3 +106,7 @@ val get_failed_login_stats : unit -> string option
 
 val get_total_sessions : unit -> Int64.t
 (** Retrieves the amount of sessions opened since the last time xapi was started *)
+
+val set_local_auth_max_threads : int64 -> unit
+
+val set_ext_auth_max_threads : int64 -> unit