Implement VDI.export_changed_blocks XenAPI call

We require both SRs to be attached for the corner case where we ask for
the changed blocks between two VDIs from two different SRs. However,
this is not strictly necessary: in the above case we just return all the
blocks of the second VDI, so we only need the SR of the second VDI to be
attached.

For this operation, even though we could allow the VDI to be attached as
read-only, we require it to be detached, to simplify the implementation
of the storage plugins - now we have one less thing to consider, and
this makes the implementation more flexible.

Signed-off-by: Gabor Igloi <[email protected]>

Author: gaborigloi

ocaml/idl/datamodel.ml

@@ -6008,6 +6008,7 @@ let storage_operations =
           "vdi_enable_cbt", "Enabling changed block tracking for a VDI";
           "vdi_disable_cbt", "Disabling changed block tracking for a VDI";
           "vdi_data_destroy", "Deleting the data of the VDI";
+          "vdi_export_changed_blocks", "Exporting a bitmap that shows the changed blocks between two VDIs";
           "vdi_set_on_boot", "Setting the on_boot field of the VDI";
           "pbd_create", "Creating a PBD for this SR";
           "pbd_destroy", "Destroying one of this SR's PBDs"; ])
@@ -6333,6 +6334,7 @@ let vdi_operations =
           "enable_cbt", "Enabling changed block tracking for a VDI";
           "disable_cbt", "Disabling changed block tracking for a VDI";
           "data_destroy", "Deleting the data of the VDI";
+          "export_changed_blocks", "Exporting a bitmap that shows the changed blocks between two VDIs";
           "set_on_boot", "Setting the on_boot field of the VDI";
           "blocked", "Operations on this VDI are temporarily blocked";
         ])
@@ -6595,6 +6597,26 @@ let vdi_data_destroy = call
     ~allowed_roles:_R_VM_ADMIN
     ()
 
+let vdi_export_changed_blocks = call
+    ~name:"export_changed_blocks"
+    ~in_oss_since:None
+    ~in_product_since:rel_inverness
+    ~params:
+      [ Ref _vdi, "vdi_from", "The first VDI."
+      ; Ref _vdi, "vdi_to", "The second VDI."
+      ]
+    ~errs:
+      [ Api_errors.sr_operation_not_supported
+      ; Api_errors.vdi_missing
+      ; Api_errors.sr_not_attached
+      ; Api_errors.sr_no_pbds
+      ; Api_errors.vdi_in_use
+      ]
+    ~result:(String, "A base64 string-encoding of the bitmap showing which blocks differ in the two VDIs.")
+    ~doc:"Reports which blocks differ in the two VDIs. This operation is not allowed when vdi_to is attached to a VM."
+    ~allowed_roles:_R_VM_OP
+    ()
+
 (** A virtual disk *)
 let vdi =
   create_obj ~in_db:true ~in_product_since:rel_rio ~in_oss_since:oss_since_303 ~internal_deprecated_since:None ~persist:PersistEverything ~gen_constructor_destructor:true ~name:_vdi ~descr:"A virtual disk image"
@@ -6630,6 +6652,7 @@ let vdi =
                vdi_enable_cbt;
                vdi_disable_cbt;
                vdi_data_destroy;
+               vdi_export_changed_blocks;
               ]
     ~contents:
       ([ uid _vdi;

ocaml/xapi/message_forwarding.ml

@@ -3605,6 +3605,16 @@ module Forward = functor(Local: Custom_actions.CUSTOM_ACTIONS) -> struct
            forward_vdi_op ~local_fn ~__context ~self
              (fun session_id rpc -> Client.VDI.data_destroy rpc session_id self))
 
+    let export_changed_blocks ~__context ~vdi_from ~vdi_to =
+      info "VDI.export_changed_blocks: vdi_from  = '%s'; vdi_to = '%s'" (vdi_uuid ~__context vdi_from) (vdi_uuid ~__context vdi_to);
+      let local_fn = Local.VDI.export_changed_blocks ~vdi_from ~vdi_to in
+      let vdi_from_sr = Db.VDI.get_SR ~__context ~self:vdi_from in
+      let vdi_to_sr = Db.VDI.get_SR ~__context ~self:vdi_to in
+      with_sr_andor_vdi ~__context ~sr:(vdi_to_sr, `vdi_export_changed_blocks) ~vdi:(vdi_to, `export_changed_blocks) ~doc:"VDI.export_changed_blocks"
+        (fun () ->
+           SR.forward_sr_multiple_op ~local_fn ~__context ~srs:[vdi_from_sr; vdi_to_sr] ~prefer_slaves:true
+             (fun session_id rpc -> Client.VDI.export_changed_blocks ~rpc ~session_id ~vdi_from ~vdi_to))
+
   end
   module VBD = struct
 

ocaml/xapi/record_util.ml

@@ -112,6 +112,7 @@ let vdi_operation_to_string: API.vdi_operations -> string = function
   | `enable_cbt -> "enable_cbt"
   | `disable_cbt -> "disable_cbt"
   | `data_destroy -> "data_destroy"
+  | `export_changed_blocks -> "export_changed_blocks"
   | `set_on_boot -> "set_on_boot"
   | `blocked -> "blocked"
 
@@ -133,6 +134,7 @@ let sr_operation_to_string: API.storage_operations -> string = function
   | `vdi_disable_cbt -> "VDI.disable_cbt"
   | `vdi_set_on_boot -> "VDI.set_on_boot"
   | `vdi_data_destroy -> "VDI.data_destroy"
+  | `vdi_export_changed_blocks -> "VDI.export_changed_blocks"
   | `pbd_create -> "PBD.create"
   | `pbd_destroy -> "PBD.destroy"
 

ocaml/xapi/xapi_sr_operations.ml

@@ -37,7 +37,7 @@ open Record_util
 
 let all_ops : API.storage_operations_set =
   [ `scan; `destroy; `forget; `plug; `unplug; `vdi_create; `vdi_destroy; `vdi_resize; `vdi_clone; `vdi_snapshot; `vdi_mirror;
-    `vdi_enable_cbt; `vdi_disable_cbt; `vdi_data_destroy; `vdi_set_on_boot; `vdi_introduce; `update; `pbd_create; `pbd_destroy ]
+    `vdi_enable_cbt; `vdi_disable_cbt; `vdi_data_destroy; `vdi_export_changed_blocks; `vdi_set_on_boot; `vdi_introduce; `update; `pbd_create; `pbd_destroy ]
 
 let sm_cap_table : (API.storage_operations * _) list =
   [ `vdi_create, Smint.Vdi_create;
@@ -48,6 +48,7 @@ let sm_cap_table : (API.storage_operations * _) list =
     `vdi_enable_cbt, Smint.Vdi_configure_cbt;
     `vdi_disable_cbt, Smint.Vdi_configure_cbt;
     `vdi_data_destroy, Smint.Vdi_configure_cbt;
+    `vdi_export_changed_blocks, Smint.Vdi_configure_cbt;
     `vdi_set_on_boot, Smint.Vdi_reset_on_boot;
     `update, Smint.Sr_update;
     (* We fake clone ourselves *)

ocaml/xapi/xapi_vdi.ml

@@ -40,7 +40,7 @@ let check_sm_feature_error (op:API.vdi_operations) sm_features sr =
   | `generate_config -> Some Vdi_generate_config
   | `clone -> Some Vdi_clone
   | `mirror -> Some Vdi_mirror
-  | `enable_cbt | `disable_cbt | `data_destroy -> Some Vdi_configure_cbt
+  | `enable_cbt | `disable_cbt | `data_destroy | `export_changed_blocks -> Some Vdi_configure_cbt
   | `set_on_boot -> Some Vdi_reset_on_boot
   ) in
   match required_sm_feature with
@@ -166,13 +166,13 @@ let check_operation_error ~__context ?(sr_records=[]) ?(pbd_records=[]) ?(vbd_re
       else
       let allowed_for_cbt_metadata_vdi = match op with
         | `clone | `copy | `disable_cbt | `enable_cbt | `mirror | `resize | `resize_online | `snapshot | `set_on_boot -> false
-        | `blocked |`data_destroy | `destroy | `force_unlock | `forget | `generate_config | `update -> true in
+        | `blocked | `data_destroy | `destroy | `export_changed_blocks | `force_unlock | `forget | `generate_config | `update -> true in
       if not allowed_for_cbt_metadata_vdi && record.Db_actions.vDI_type = `cbt_metadata
       then Some (Api_errors.vdi_incompatible_type, [ _ref; Record_util.vdi_type_to_string `cbt_metadata ])
       else
       let allowed_when_cbt_enabled = match op with
         | `mirror | `set_on_boot -> false
-        | `blocked | `clone | `copy | `data_destroy | `destroy | `disable_cbt | `enable_cbt | `force_unlock | `forget | `generate_config | `resize | `resize_online | `snapshot | `update -> true in
+        | `blocked | `clone | `copy | `data_destroy | `destroy | `disable_cbt | `enable_cbt | `export_changed_blocks | `force_unlock | `forget | `generate_config | `resize | `resize_online | `snapshot | `update -> true in
       if not allowed_when_cbt_enabled && record.Db_actions.vDI_cbt_enabled
       then Some (Api_errors.vdi_cbt_enabled, [_ref])
       else
@@ -234,10 +234,10 @@ let check_operation_error ~__context ?(sr_records=[]) ?(pbd_records=[]) ?(vbd_re
         then Some (Api_errors.operation_not_allowed, ["VDI is a snapshot: " ^ _ref])
         else if not (List.mem record.Db_actions.vDI_type [ `user; `system ])
         then Some (Api_errors.vdi_incompatible_type, [ _ref; Record_util.vdi_type_to_string record.Db_actions.vDI_type ])
-        else if record.Db_actions.vDI_on_boot = `reset
+        else if reset_on_boot
         then Some (Api_errors.vdi_on_boot_mode_incompatible_with_operation, [])
         else None
-      | `mirror | `clone | `generate_config | `force_unlock | `set_on_boot | `blocked | `update -> None
+      | `mirror | `clone | `generate_config | `force_unlock | `set_on_boot | `export_changed_blocks | `blocked | `update -> None
       end
 
 let assert_operation_valid ~__context ~self ~(op:API.vdi_operations) =
@@ -859,4 +859,17 @@ let change_cbt_status ~__context ~self ~new_cbt_enabled ~caller_name =
 let enable_cbt = change_cbt_status ~new_cbt_enabled:true ~caller_name:"VDI.enable_cbt"
 let disable_cbt = change_cbt_status ~new_cbt_enabled:false ~caller_name:"VDI.disable_cbt"
 
+let export_changed_blocks ~__context ~vdi_from ~vdi_to =
+  let task = Context.get_task_id __context in
+  (* We have to pass the SR of vdi_to to the SMAPIv2 call *)
+  let sr = Db.VDI.get_SR ~__context ~self:vdi_to in
+  let sr = Db.SR.get_uuid ~__context ~self:sr in
+  let vdi_from = Db.VDI.get_location ~__context ~self:vdi_from in
+  let vdi_to = Db.VDI.get_location ~__context ~self:vdi_to in
+  let module C = Storage_interface.Client(struct let rpc = Storage_access.rpc end) in
+  Storage_access.transform_storage_exn
+    (fun () ->
+       C.VDI.export_changed_blocks ~dbg:(Ref.string_of task) ~sr ~vdi_from ~vdi_to
+    );
+
 (* let pool_migrate = "See Xapi_vm_migrate.vdi_pool_migrate!" *)

ocaml/xapi/xapi_vdi.mli

@@ -210,3 +210,5 @@ val enable_cbt :
   __context:Context.t -> self:API.ref_VDI -> unit
 val disable_cbt :
   __context:Context.t -> self:API.ref_VDI -> unit
+val export_changed_blocks :
+  __context:Context.t -> vdi_from:API.ref_VDI -> vdi_to:API.ref_VDI -> string