CP-53843: reusable session for sm_exec

The session reuse logic in `xapi_session.ml` does work in this usecase,
sm calls are made with `pool=false`. So reimplement the logic so that we
use a single session for `sm_exec` per sr.

This should help with session count inside xapi.

Signed-off-by: Gabriel Buica <danutgabriel.buica@citrix.com>

Author: Gabriel Buica

ocaml/xapi/sm_exec.ml

@@ -317,8 +317,32 @@ let methodResponse xml =
   | xml ->
       XMLRPC.From.methodResponse xml
 
-(****************************************************************************************)
-(* Functions that actually execute the python backends *)
+let reusable_sessions : (string option, API.ref_session) Hashtbl.t =
+  Hashtbl.create 5
+
+let sm_sessions_m = Mutex.create ()
+
+let with_sm_sessions_lock f =
+  Xapi_stdext_threads.Threadext.Mutex.execute sm_sessions_m f
+
+let is_valid_session ~__context session_id =
+  try
+    (* Call an API function to check the session is still valid *)
+    let rpc = Helpers.make_rpc ~__context in
+    ignore (Client.Client.Pool.get_all ~rpc ~session_id) ;
+    true
+  with Api_errors.Server_error (err, _) ->
+    debug "%s: Invalid session: %s" __FUNCTION__ err ;
+    false
+
+let session_access ~__context session sr =
+  (* Give this session access to this particular SR *)
+  Option.iter
+    (fun sr ->
+      Db.Session.add_to_other_config ~__context ~self:session
+        ~key:Xapi_globs._sm_session ~value:(Ref.string_of sr)
+    )
+    sr
 
 let create_session ~__context sr =
   let host = !Xapi_globs.localhost_ref in
@@ -327,25 +351,49 @@ let create_session ~__context sr =
       ~is_local_superuser:true ~subject:Ref.null ~auth_user_sid:""
       ~auth_user_name:sm_username ~rbac_permissions:[]
   in
-  (* Give this session access to this particular SR *)
-  Option.iter
-    (fun sr ->
-      Db.Session.add_to_other_config ~__context ~self:session
-        ~key:Xapi_globs._sm_session ~value:(Ref.string_of sr)
-    )
-    sr ;
+  session_access ~__context session sr ;
   session
 
+let rec get_session ~__context sr =
+  let sr_key = Option.map Ref.string_of sr in
+  let session = Hashtbl.find_opt reusable_sessions sr_key in
+  match session with
+  | Some session ->
+      if is_valid_session ~__context session then
+        session
+      else (
+        with_sm_sessions_lock (fun () -> Hashtbl.remove reusable_sessions sr_key) ;
+        (get_session [@tailcall]) ~__context sr
+      )
+  | None ->
+      let new_session = create_session ~__context sr in
+      with_sm_sessions_lock (fun () ->
+          match Hashtbl.find_opt reusable_sessions sr_key with
+          | None ->
+              Hashtbl.add reusable_sessions sr_key new_session ;
+              new_session
+          | Some session ->
+              Xapi_session.destroy_db_session ~__context ~self:new_session ;
+              session
+      )
+
 let with_session ~traceparent sr f =
   Server_helpers.exec_with_new_task "sm_exec"
     ~origin:(Internal_Traced traceparent) (fun __context ->
-      let session_id = create_session ~__context sr in
-      let destroy_session () =
-        Xapi_session.destroy_db_session ~__context ~self:session_id
-      in
-      finally (fun () -> f session_id) destroy_session
+      if !Xapi_globs.reuse_pool_sessions then
+        let session_id = get_session ~__context sr in
+        f session_id
+      else
+        let session_id = create_session ~__context sr in
+        let destroy_session () =
+          Xapi_session.destroy_db_session ~__context ~self:session_id
+        in
+        finally (fun () -> f session_id) destroy_session
   )
 
+(****************************************************************************************)
+(* Functions that actually execute the python backends *)
+
 let exec_xmlrpc ~dbg ?context:_ ?(needs_session = true) (driver : string)
     (call : call) =
   with_dbg ~name:call.cmd ~dbg @@ fun di ->