CP-48676: Reuse pool sessions on slave logins

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