Check that there are no changes during SR.scan

Currently, we are only checking that no VDIs have been removed during the
SR scan performed by the SM plugin. However, there are situations where
a VDI has been added, and if this VDI is not present in the list obtained
from SR.scan, it will be forgotten. The checks only prevent this in the
case where the VDI was added during the scan. There is still a TOCTOU
situation if the issue happens after the scan, and there is room for that.

Signed-off-by: Guillaume <[email protected]>

Author: gthvn1

ocaml/xapi/xapi_sr.ml

@@ -757,6 +757,11 @@ let update_vdis ~__context ~sr db_vdis vdi_infos =
 
 (* Perform a scan of this locally-attached SR *)
 let scan ~__context ~sr =
+  let module RefSet = Set.Make (struct
+    type t = [`VDI] Ref.t
+
+    let compare = Ref.compare
+  end) in
   let open Storage_access in
   let task = Context.get_task_id __context in
   let module C = Storage_interface.StorageAPI (Idl.Exn.GenClient (struct
@@ -778,13 +783,42 @@ let scan ~__context ~sr =
               Db.VDI.get_records_where ~__context
                 ~expr:(Eq (Field "SR", Literal sr'))
             in
+            let string_of_l lst =
+              List.map (fun (_, v) -> v.vDI_uuid) lst |> String.concat ","
+            in
             (* It is sufficient to just compare the refs in two db_vdis, as this
                is what update_vdis uses to determine what to delete *)
             let vdis_ref_equal db_vdi1 db_vdi2 =
-              Listext.List.set_difference (List.map fst db_vdi1)
-                (List.map fst db_vdi2)
-              = []
+              let refs1 = RefSet.of_list (List.map fst db_vdi1) in
+              let refs2 = RefSet.of_list (List.map fst db_vdi2) in
+              if RefSet.equal refs1 refs2 then
+                true
+              else
+                let vdis_removed = RefSet.diff refs1 refs2 in
+                let vdis_added = RefSet.diff refs2 refs1 in
+
+                ( if not (RefSet.is_empty vdis_removed) then
+                    let removed =
+                      List.filter
+                        (fun (r, _) -> RefSet.mem r vdis_removed)
+                        db_vdi1
+                    in
+                    debug "%s VDIs removed during scan: %s" __FUNCTION__
+                      (string_of_l removed)
+                ) ;
+
+                ( if not (RefSet.is_empty vdis_added) then
+                    let added =
+                      List.filter
+                        (fun (r, _) -> RefSet.mem r vdis_added)
+                        db_vdi2
+                    in
+                    debug "%s VDIs added during scan: %s" __FUNCTION__
+                      (string_of_l added)
+                ) ;
+                false
             in
+
             let db_vdis_before = find_vdis () in
             let vs, sr_info =
               C.SR.scan2 (Ref.string_of task)
@@ -793,17 +827,8 @@ let scan ~__context ~sr =
             let db_vdis_after = find_vdis () in
             if limit > 0 && not (vdis_ref_equal db_vdis_before db_vdis_after)
             then (
-              debug
-                "%s detected db change while scanning, before scan vdis %s, \
-                 after scan vdis %s, retry limit left %d"
-                __FUNCTION__
-                (List.map (fun (_, v) -> v.vDI_uuid) db_vdis_before
-                |> String.concat ","
-                )
-                (List.map (fun (_, v) -> v.vDI_uuid) db_vdis_after
-                |> String.concat ","
-                )
-                limit ;
+              debug "%s detected db change while scanning, retry limit left %d"
+                __FUNCTION__ limit ;
               (scan_rec [@tailcall]) (limit - 1)
             ) else if limit = 0 then
               Helpers.internal_error "SR.scan retry limit exceeded"