CA-383867: Allow xapi-guard to disable the disk cache

This is done through the fist point.

Xapi_fist is not used directly because it needs to a new opam package, creating
a lot of churn which is currently unwanted.

Signed-off-by: Pau Ruiz Safont <[email protected]>

Author: psafont

ocaml/xapi-guard/lib/disk_cache.ml

@@ -25,6 +25,13 @@ type t = Uuidm.t * Mtime.t * Types.Tpm.key
 
 let cache_of service = runtime_data // Types.Service.to_string service
 
+let fistpoint () =
+  let name = "/tmp/fist_disable_xapi_guard_cache" in
+  try
+    let* () = Lwt_unix.access name [Unix.F_OK] in
+    Lwt.return true
+  with _ -> Lwt.return false
+
 let files_in dir ~otherwise =
   Lwt.catch
     (fun () ->
@@ -292,7 +299,8 @@ end = struct
           let* () = persist () in
           Lwt_result.return ()
     in
-    let on_exception = engage_and_persist in
+    let* cache_disabled = fistpoint () in
+    let on_exception = if cache_disabled then fail else engage_and_persist in
     let lock_and_push () =
       with_lock queue.lock (read_state_and_push on_exception)
     in

ocaml/xapi/xapi_fist.ml

@@ -160,3 +160,5 @@ let int_seed name : int option =
 let exchange_certificates_in_pool () : int option =
   let name = "exchange_certificates_in_pool" in
   int_seed name
+
+let disable_xapi_guard_cache () = fistpoint "disable_xapi_guard_cache"