Add ignored_vdis to VM.snapshot method

This allow to snapshot a VM and ignore some VDIs during the snapshot
This can lead to a gain of time & space ignoring non essential data

See: #4551

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

ocaml/idl/datamodel_vm.ml

@@ -244,12 +244,14 @@ let power_behaviour =
 
   let snapshot = call
       ~name:"snapshot"
+      ~lifecycle:[ Published, rel_orlando, ""; Changed, rel_next, "Add `ignored_vdis` params to ignore some VDIs during a snapshot" ]
       ~in_product_since: rel_orlando
       ~doc:"Snapshots the specified VM, making a new VM. Snapshot automatically exploits the capabilities of the underlying storage repository in which the VM's disk images are stored (e.g. Copy on Write)."
       ~result: (Ref _vm, "The reference of the newly created VM.")
-      ~params:[
-        Ref _vm, "vm", "The VM to be snapshotted";
-        String, "new_name", "The name of the snapshotted VM"
+      ~versioned_params:
+      [{param_type=Ref _vm; param_name="vm"; param_doc="The VM to be snapshotted"; param_release=orlando_release; param_default=None};
+       {param_type=String; param_name="new_name"; param_doc="The name of the snapshotted VM"; param_release=orlando_release; param_default=Some (VString "")};
+       {param_type=Set(Ref _vdi); param_name="ignored_vdis"; param_doc="A list of VDIs to ignore for the snapshot"; param_release=next_release; param_default=Some (VSet [])};
       ]
       ~errs:[Api_errors.vm_bad_power_state; Api_errors.sr_full; Api_errors.operation_not_allowed]
       ~allowed_roles:_R_VM_POWER_ADMIN

ocaml/xapi-cli-server/cli_operations.ml

@@ -4094,7 +4094,7 @@ let vm_clone_aux clone_op cloned_string printer include_template_vms rpc
 let vm_clone printer = vm_clone_aux Client.VM.clone "Cloned " printer true
 
 let vm_snapshot printer =
-  vm_clone_aux Client.VM.snapshot "Snapshotted " printer false
+  vm_clone_aux Client.VM.snapshot "Snapshotted " printer false []
 
 let vm_snapshot_with_quiesce printer =
   vm_clone_aux Client.VM.snapshot_with_quiesce "Snapshotted" printer false

ocaml/xapi/message_forwarding.ml

@@ -1577,10 +1577,10 @@ functor
           ~value:transportable_snapshot_id
 
       (* almost a copy of the clone function *)
-      let snapshot ~__context ~vm ~new_name =
+      let snapshot ~__context ~vm ~new_name ~ignored_vdis =
         info "VM.snapshot: VM = '%s'; new_name = '%s'" (vm_uuid ~__context vm)
           new_name ;
-        let local_fn = Local.VM.snapshot ~vm ~new_name in
+        let local_fn = Local.VM.snapshot ~vm ~new_name ~ignored_vdis in
         (* We mark the VM as snapshoting. We don't mark the disks; the implementation of the snapshot uses the API   *)
         (* to snapshot and lock the individual VDIs. We don't give any atomicity guarantees here but we do prevent   *)
         (* disk corruption.                                                                                          *)
@@ -1589,7 +1589,7 @@ functor
             (fun () ->
               forward_to_access_srs ~local_fn ~__context ~vm
                 (fun session_id rpc ->
-                  Client.VM.snapshot rpc session_id vm new_name
+                  Client.VM.snapshot rpc session_id vm new_name ignored_vdis
               )
           )
         in

ocaml/xapi/xapi_vm.ml

@@ -757,9 +757,9 @@ let clone ~__context ~vm ~new_name =
 
 (* We do call wait_in_line for snapshot and snapshot_with_quiesce because the locks are taken at *)
 (* the VBD level (with pause/unpause mechanism                                                   *)
-let snapshot ~__context ~vm ~new_name =
+let snapshot ~__context ~vm ~new_name ~ignored_vdis =
   TaskHelper.set_cancellable ~__context ;
-  Xapi_vm_snapshot.snapshot ~__context ~vm ~new_name
+  Xapi_vm_snapshot.snapshot ?ignored_vdis ~__context ~vm ~new_name
 
 (* As we will destroy the domain ourself, we grab the vm_lock here in order to tell the event thread to *)
 (* do not look at this domain. The message forwarding layer already checked that the VM reference we    *)

ocaml/xapi/xapi_vm_clone.ml

@@ -408,7 +408,7 @@ let make_driver_params () =
   [(Constants._sm_epoch_hint, Uuid.to_string (Uuid.make_uuid ()))]
 
 (* NB this function may be called when the VM is suspended for copy/clone operations. Snapshot can be done in live.*)
-let clone ?snapshot_info_record disk_op ~__context ~vm ~new_name =
+let clone ?snapshot_info_record ?ignored_vdis disk_op ~__context ~vm ~new_name =
   Helpers.call_api_functions ~__context (fun rpc session_id ->
       let task_id = Ref.string_of (Context.get_task_id __context) in
       let vbds = Db.VM.get_VBDs ~__context ~self:vm in
@@ -429,6 +429,20 @@ let clone ?snapshot_info_record disk_op ~__context ~vm ~new_name =
       let is_a_snapshot =
         disk_op = Disk_op_snapshot || disk_op = Disk_op_checkpoint
       in
+
+      let vbds =
+        if is_a_snapshot then
+          match ignored_vdis with
+          | None ->
+              vbds
+          | Some vdis ->
+              List.filter
+                (fun x -> List.mem (Db.VBD.get_VDI ~__context ~self:x) vdis)
+                vbds
+        else
+          vbds
+      in
+
       (* Check licence permission before copying disks, since the copy can take a long time.
          		 * We always allow snapshotting a VM, but check before clone/copy of an existing snapshot or template. *)
       if Db.VM.get_has_vendor_device ~__context ~self:vm && not is_a_snapshot

ocaml/xapi/xapi_vm_clone.mli

@@ -57,6 +57,7 @@ val clone_single_vdi :
 (* NB this function may be called when the VM is suspended for copy/clone operations. Snapshot can be done in live.*)
 val clone :
      ?snapshot_info_record:(string * string) list
+  -> ?ignored_vdis:[`VDI] API.Ref.t list
   -> disk_op_t
   -> __context:Context.t
   -> vm:[`VM] API.Ref.t

ocaml/xapi/xapi_vm_snapshot.ml

@@ -25,12 +25,13 @@ open D
 (*************************************************************************************************)
 (* Crash-consistant snapshot                                                                     *)
 (*************************************************************************************************)
-let snapshot ~__context ~vm ~new_name =
+let snapshot ?ignored_vdis ~__context ~vm ~new_name =
   debug "Snapshot: begin" ;
   TaskHelper.set_cancellable ~__context ;
   Xapi_vmss.show_task_in_xencenter ~__context ~vm ;
   let res =
-    Xapi_vm_clone.clone Xapi_vm_clone.Disk_op_snapshot ~__context ~vm ~new_name
+    Xapi_vm_clone.clone ?ignored_vdis Xapi_vm_clone.Disk_op_snapshot ~__context
+      ~vm ~new_name
   in
   debug "Snapshot: end" ; res