CP-48676: Reuse pool sessions on slave logins (#5986)

This PR allows pool sessions to be reused, rather than wasting time
creating new ones each time to talk to the slaves.

The average time spent across 15 slave get_servertime xenapi calls on a
virtual pool was 20.97ms with reuse-pool-sessions = false.

![image](https://github.com/user-attachments/assets/a2cf31cb-5832-4e0d-928e-fc9df95626e6)
Compared to an average of 17.11ms with reuse-pool-sessions = true

![image](https://github.com/user-attachments/assets/186685a4-e763-449a-9f77-73cb29896200)

In particular, the part of the request that has actually been changed,
the login_no_password call has gone from about 2.41ms to 0.008ms, 300x
faster than previously.

One part of why this speedup is possible is because we no longer have to
do a pool.get_all for each session (to force the newly created session's
time to update). If we were to validate the reusable pool session is
valid before use, we would still need to do this pool.get_all. However,
as we are now no longer destroying the db session after use, it should
continue to be valid. As such, to achieve the best speed increase, this
option of validating the reusable pool session
(validate-reusable-pool-session in xapi.conf) is off by default.

ocaml/xapi/xapi_globs.ml

@@ -1053,6 +1053,10 @@ let pool_recommendations_dir = ref "/etc/xapi.pool-recommendations.d"
 
 let disable_webserver = ref false
 
+let reuse_pool_sessions = ref true
+
+let validate_reusable_pool_session = ref false
+
 let test_open = ref 0
 
 let xapi_globs_spec =
@@ -1618,6 +1622,16 @@ let other_options =
     , (fun () -> !Uuidx.make_default = Uuidx.make_uuid_fast |> string_of_bool)
     , "Use PRNG based UUID generator instead of CSPRNG"
     )
+  ; ( "reuse-pool-sessions"
+    , Arg.Set reuse_pool_sessions
+    , (fun () -> string_of_bool !reuse_pool_sessions)
+    , "Enable the reuse of pool sessions"
+    )
+  ; ( "validate-reusable-pool-session"
+    , Arg.Set validate_reusable_pool_session
+    , (fun () -> string_of_bool !validate_reusable_pool_session)
+    , "Enable the reuse of pool sessions"
+    )
   ]
 
 (* The options can be set with the variable xapiflags in /etc/sysconfig/xapi.

ocaml/xapi/xapi_session.ml

@@ -398,19 +398,29 @@ let is_subject_suspended ~__context ~cache subject_identifier =
     debug "Subject identifier %s is suspended" subject_identifier ;
   (is_suspended, subject_name)
 
+let reusable_pool_session = ref Ref.null
+
+let reusable_pool_session_lock = Mutex.create ()
+
 let destroy_db_session ~__context ~self =
   Context.with_tracing ~__context __FUNCTION__ @@ fun __context ->
-  Xapi_event.on_session_deleted self ;
-  (* unregister from the event system *)
-  (* This info line is important for tracking, auditability and client accountability purposes on XenServer *)
-  (* Never print the session id nor uuid: they are secret values that should be known only to the user that *)
-  (* logged in. Instead, we print a non-invertible hash as the tracking id for the session id *)
-  (* see also task creation in context.ml *)
-  (* CP-982: create tracking id in log files to link username to actions *)
-  info "Session.destroy %s" (trackid self) ;
-  Rbac_audit.session_destroy ~__context ~session_id:self ;
-  (try Db.Session.destroy ~__context ~self with _ -> ()) ;
-  Rbac.destroy_session_permissions_tbl ~session_id:self
+  with_lock reusable_pool_session_lock (fun () ->
+      if self <> !reusable_pool_session then (
+        Xapi_event.on_session_deleted self ;
+        (* unregister from the event system *)
+        (* This info line is important for tracking, auditability and client accountability purposes on XenServer *)
+        (* Never print the session id nor uuid: they are secret values that should be known only to the user that *)
+        (* logged in. Instead, we print a non-invertible hash as the tracking id for the session id *)
+        (* see also task creation in context.ml *)
+        (* CP-982: create tracking id in log files to link username to actions *)
+        info "Session.destroy %s" (trackid self) ;
+        Rbac_audit.session_destroy ~__context ~session_id:self ;
+        (try Db.Session.destroy ~__context ~self with _ -> ()) ;
+        Rbac.destroy_session_permissions_tbl ~session_id:self
+      ) else
+        info "Skipping Session.destroy for reusable pool session %s"
+          (trackid self)
+  )
 
 (* CP-703: ensure that activate sessions are invalidated in a bounded time *)
 (* in response to external authentication/directory services updates, such as *)
@@ -610,8 +620,8 @@ let revalidate_all_sessions ~__context =
     debug "Unexpected exception while revalidating external sessions: %s"
       (ExnHelper.string_of_exn e)
 
-let login_no_password_common ~__context ~uname ~originator ~host ~pool
-    ~is_local_superuser ~subject ~auth_user_sid ~auth_user_name
+let login_no_password_common_create_session ~__context ~uname ~originator ~host
+    ~pool ~is_local_superuser ~subject ~auth_user_sid ~auth_user_name
     ~rbac_permissions ~db_ref ~client_certificate =
   Context.with_tracing ~originator ~__context __FUNCTION__ @@ fun __context ->
   let create_session () =
@@ -661,6 +671,49 @@ let login_no_password_common ~__context ~uname ~originator ~host ~pool
   ignore (Client.Pool.get_all ~rpc ~session_id) ;
   session_id
 
+let login_no_password_common ~__context ~uname ~originator ~host ~pool
+    ~is_local_superuser ~subject ~auth_user_sid ~auth_user_name
+    ~rbac_permissions ~db_ref ~client_certificate =
+  Context.with_tracing ~originator ~__context __FUNCTION__ @@ fun __context ->
+  let is_valid_session session_id =
+    try
+      (* Call an API function to check the session is still valid *)
+      let rpc = Helpers.make_rpc ~__context in
+      ignore (Client.Pool.get_all ~rpc ~session_id) ;
+      true
+    with Api_errors.Server_error (err, _) ->
+      info "Invalid session: %s" err ;
+      false
+  in
+  let create_session () =
+    let new_session_id =
+      login_no_password_common_create_session ~__context ~uname ~originator
+        ~host ~pool ~is_local_superuser ~subject ~auth_user_sid ~auth_user_name
+        ~rbac_permissions ~db_ref ~client_certificate
+    in
+    new_session_id
+  in
+  if
+    (originator, pool, is_local_superuser, uname)
+    = (xapi_internal_originator, true, true, None)
+    && !Xapi_globs.reuse_pool_sessions
+  then
+    with_lock reusable_pool_session_lock (fun () ->
+        if
+          !reusable_pool_session <> Ref.null
+          && ((not !Xapi_globs.validate_reusable_pool_session)
+             || is_valid_session !reusable_pool_session
+             )
+        then
+          !reusable_pool_session
+        else
+          let new_session_id = create_session () in
+          reusable_pool_session := new_session_id ;
+          new_session_id
+    )
+  else
+    create_session ()
+
 (* XXX: only used internally by the code which grants the guest access to the API.
    Needs to be protected by a proper access control system *)
 let login_no_password ~__context ~uname ~host ~pool ~is_local_superuser ~subject