# HG changeset patch
# User Thomas Gazagnaire <thomas.gazagnaire@xxxxxxxxxx>
CA-36013: Various fixes to the session cache handling.

* invalidate the local session cache when an INVALID_SESSION has been caught and retry the current function at most 5 times;
* also add a maximum life-length for the cached session (of 1h).

Signed-off-by: Thomas Gazagnaire <thomas.gazagnaire@xxxxxxxxxx>

diff -r fedd6ba286b7 ocaml/xapi/helpers.ml
--- a/ocaml/xapi/helpers.ml	Fri Jan 15 18:07:00 2010 +0000
+++ b/ocaml/xapi/helpers.ml	Mon Jan 18 15:29:20 2010 +0000
@@ -99,6 +99,33 @@
     ~port:!Xapi_globs.https_port ~path:"/" xml 
     (* No auth needed over unix domain socket *)
 
+(* Cache an internal session with its timestamp of creation *)
+let internal_session : ([`session] Ref.t * float) option ref = ref None
+
+ (* Cached internal session are refreshed every hour for security reasons *)
+let internal_session_timeout = 60. *. 60.
+
+let internal_session_mutex = Mutex.create ()
+
+(* Reset the internal session cache *)
+let reset_internal_session_cache () =
+	debug "Reseting the internal session cache";
+	Mutex.execute internal_session_mutex (fun () -> internal_session := None)
+
+let rec get_internal_session login_fn =
+	Mutex.execute internal_session_mutex (fun () ->
+		match !internal_session with
+		| None ->
+			let session = login_fn () in
+			internal_session := Some (session, Unix.time ());
+			session
+		| Some (session, timestamp) ->
+			if Unix.time() -. timestamp > internal_session_timeout then begin
+				reset_internal_session_cache ();
+				get_internal_session login_fn;
+			end else
+				session)
+
 let do_internal_login ~__context =
 	let login =
 		if Pool_role.is_master () then
@@ -117,14 +144,19 @@
 				 let session_id = Client.Client.Session.slave_login rpc (get_localhost ~__context) !Xapi_globs.pool_secret in
 				 debug "slave login done";
 				 session_id) in
-	Xapi_globs.get_internal_session login
+	get_internal_session login
 
-let with_cached_session ~__context fn =
+let rec with_cached_session ~__context ?(iter=1) fn =
 	try fn (do_internal_login ~__context)
-	with Api_errors.Server_error (error,_) as e when error = Api_errors.session_authentication_failed ->
-		Xapi_globs.reset_internal_session_cache ();
-		debug "remote client call finished with exception %s; cleaning the session cache" (Printexc.to_string e);
-		raise e
+	with Api_errors.Server_error (error,_) as e when error = Api_errors.session_invalid  ->
+		if iter <= 5 then begin
+			let delay = 0.5 *. exp (float_of_int iter)  in
+			debug "The master does not recognize the cached session anymore; cleaning-up the cache and waiting for %fs before retrying (attempt %d/5)." delay iter;
+			reset_internal_session_cache ();
+			Thread.delay delay;
+			with_cached_session ~__context ~iter:(iter+1) fn
+		end else
+			raise e
 
 (** Log into pool master using the client code, call a function
     passing it the rpc function and session id, logout when finished. *)
diff -r fedd6ba286b7 ocaml/xapi/xapi_globs.ml
--- a/ocaml/xapi/xapi_globs.ml	Fri Jan 15 18:07:00 2010 +0000
+++ b/ocaml/xapi/xapi_globs.ml	Mon Jan 18 15:29:20 2010 +0000
@@ -23,20 +23,6 @@
 
 let pool_secret_path = "/etc/xensource/ptoken"
 let pool_secret = ref ""
-let internal_session : [`session] Ref.t option ref = ref None
-
-let internal_session_mutex = Mutex.create ()
-let get_internal_session login_fn =
-	Mutex.execute internal_session_mutex (fun () ->
-		match !internal_session with
-		| None ->
-			  let session = login_fn () in
-			  internal_session := Some session;
-			  session
-		| Some session -> session)
-let reset_internal_session_cache () =
-	Mutex.execute internal_session_mutex (fun () -> internal_session := None)
-
 let localhost_ref : [`host] Ref.t ref = ref Ref.null
 
 (* xapi version *)