CA-314317: Protect PVS-cache get_or_recreate_vdi by mutex

The function `Pvs_cache_vdi.get_or_recreate_vdi` may be called for multiple
concurrently starting VMs. Without the mutex, this can lead to multiple VDIs
being created, while the should only be one for a given `PVS_cache_storage`
object.

cherry-picked from commit c003bb1

Signed-off-by: Rob Hoes <[email protected]>

ocaml/xapi/pvs_cache_vdi.ml

@@ -64,15 +64,19 @@ let get_vdi ~__context ~self =
     end
   end
 
+let m = Mutex.create ()
+
 let get_or_recreate_vdi ~__context ~self =
-  match get_vdi ~__context ~self with
-  | None ->
-    let sR = Db.PVS_cache_storage.get_SR ~__context ~self in
-    let size = Db.PVS_cache_storage.get_size ~__context ~self in
-    let vdi = create_vdi ~__context ~sR ~size in
-    Db.PVS_cache_storage.set_VDI ~__context ~self ~value:vdi;
-    vdi
-  | Some vdi -> vdi
+  Stdext.Threadext.Mutex.execute m (fun () ->
+    match get_vdi ~__context ~self with
+    | None ->
+      let sR = Db.PVS_cache_storage.get_SR ~__context ~self in
+      let size = Db.PVS_cache_storage.get_size ~__context ~self in
+      let vdi = create_vdi ~__context ~sR ~size in
+      Db.PVS_cache_storage.set_VDI ~__context ~self ~value:vdi;
+      vdi
+    | Some vdi -> vdi
+  )
 
 let destroy_vdi ~__context ~self =
   match get_vdi ~__context ~self with