diff --git a/ocaml/idl/datamodel_vm.ml b/ocaml/idl/datamodel_vm.ml index 55e739d860d..fbdb903bbca 100644 --- a/ocaml/idl/datamodel_vm.ml +++ b/ocaml/idl/datamodel_vm.ml @@ -247,9 +247,10 @@ let power_behaviour = ~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=None}; + {param_type=Set(Ref _vdi); param_name="ignore_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 diff --git a/ocaml/quicktest/quicktest.ml b/ocaml/quicktest/quicktest.ml index 58c6d8f421d..b4ca5725dc6 100644 --- a/ocaml/quicktest/quicktest.ml +++ b/ocaml/quicktest/quicktest.ml @@ -29,6 +29,7 @@ let () = ; ("Quicktest_async_calls", Quicktest_async_calls.tests ()) ; ("Quicktest_vm_import_export", Quicktest_vm_import_export.tests ()) ; ("Quicktest_vm_lifecycle", Quicktest_vm_lifecycle.tests ()) + ; ("Quicktest_vm_snapshot", Quicktest_vm_snapshot.tests ()) ; ( "Quicktest_vdi_ops_data_integrity" , Quicktest_vdi_ops_data_integrity.tests () ) diff --git a/ocaml/quicktest/quicktest_vm_snapshot.ml b/ocaml/quicktest/quicktest_vm_snapshot.ml new file mode 100644 index 00000000000..d5c2a4b4502 --- /dev/null +++ b/ocaml/quicktest/quicktest_vm_snapshot.ml @@ -0,0 +1,112 @@ +(** Set up snapshot test: create a small VM with a selection of VBDs *) +let with_setup rpc session_id sr vm_template f = + print_endline "Setting up test VM" ; + let uuid = Client.Client.VM.get_uuid rpc session_id vm_template in + print_endline (Printf.sprintf "Template has uuid: %s%!" uuid) ; + let vdi = + Client.Client.VDI.create rpc session_id "small" __LOC__ sr 4194304L `user + false false [] [] [] [] + in + let vdi2 = + Client.Client.VDI.create rpc session_id "small2" __LOC__ sr 4194304L `user + false false [] [] [] [] + in + Qt.VM.with_new rpc session_id ~template:vm_template (fun vm -> + print_endline (Printf.sprintf "Installed new VM") ; + print_endline + (Printf.sprintf "Using SR: %s" + (Client.Client.SR.get_name_label ~rpc ~session_id ~self:sr) + ) ; + ignore + (Client.Client.VBD.create ~rpc ~session_id ~vM:vm ~vDI:vdi + ~userdevice:"0" ~bootable:false ~mode:`RW ~_type:`Disk + ~unpluggable:true ~empty:false ~other_config:[] + ~qos_algorithm_type:"" ~qos_algorithm_params:[] ~device:"" + ~currently_attached:true + ) ; + ignore + (Client.Client.VBD.create ~rpc ~session_id ~vM:vm ~vDI:vdi2 + ~userdevice:"1" ~bootable:false ~mode:`RW ~_type:`Disk + ~unpluggable:true ~empty:false ~other_config:[] + ~qos_algorithm_type:"" ~qos_algorithm_params:[] ~device:"" + ~currently_attached:true + ) ; + f rpc session_id vm vdi vdi2 ; + Client.Client.VDI.destroy rpc session_id vdi ; + Client.Client.VDI.destroy rpc session_id vdi2 + ) + +let test_snapshot rpc session_id vm vdi vdi2 = + let snapshot = Client.Client.VM.snapshot rpc session_id vm "Snapshot" [] in + let vbds = Client.Client.VM.get_VBDs rpc session_id snapshot in + let snap_vbd = + match + List.find_opt + (fun vbd -> Client.Client.VBD.get_userdevice rpc session_id vbd = "0") + vbds + with + | None -> + Alcotest.fail "Couldn't find VBD on snapshot" + | Some vbd -> + vbd + in + let snap_vbd2 = + match + List.find_opt + (fun vbd -> Client.Client.VBD.get_userdevice rpc session_id vbd = "1") + vbds + with + | None -> + Alcotest.fail "Couldn't find VBD on snapshot" + | Some vbd -> + vbd + in + let snap_vdi = Client.Client.VBD.get_VDI rpc session_id snap_vbd in + let snap_vdi2 = Client.Client.VBD.get_VDI rpc session_id snap_vbd2 in + let orig_vdi = Client.Client.VDI.get_snapshot_of rpc session_id snap_vdi in + let orig_vdi2 = Client.Client.VDI.get_snapshot_of rpc session_id snap_vdi2 in + assert (orig_vdi = vdi) ; + assert (orig_vdi2 = vdi2) + +let test_snapshot_ignore_vdi rpc session_id vm vdi vdi2 = + let snapshot = + Client.Client.VM.snapshot rpc session_id vm "Snapshot" [vdi2] + in + let vbds = Client.Client.VM.get_VBDs rpc session_id snapshot in + let snap_vbd = + match + List.find_opt + (fun vbd -> Client.Client.VBD.get_userdevice rpc session_id vbd = "0") + vbds + with + | None -> + Alcotest.fail "Couldn't find VBD on snapshot" + | Some vbd -> + vbd + in + assert ( + not + (List.exists + (fun vbd -> Client.Client.VBD.get_userdevice rpc session_id vbd = "1") + vbds + ) + ) ; + let snap_vdi = Client.Client.VBD.get_VDI rpc session_id snap_vbd in + let orig_vdi = Client.Client.VDI.get_snapshot_of rpc session_id snap_vdi in + assert (orig_vdi = vdi) + +let test rpc session_id sr_info vm_template () = + let sr = sr_info.Qt.sr in + List.iter + (with_setup rpc session_id sr vm_template) + [test_snapshot; test_snapshot_ignore_vdi] + +let tests () = + let open Qt_filter in + [ + [("VM snapshot tests", `Slow, test)] + |> conn + |> sr SR.(all |> allowed_operations [`vdi_create]) + |> vm_template Qt.VM.Template.other + ] + |> List.concat diff --git a/ocaml/xapi-cli-server/cli_frontend.ml b/ocaml/xapi-cli-server/cli_frontend.ml index bd5b5190203..e4013685c18 100644 --- a/ocaml/xapi-cli-server/cli_frontend.ml +++ b/ocaml/xapi-cli-server/cli_frontend.ml @@ -1310,7 +1310,7 @@ let rec cmdtable_data : (string * cmd_spec) list = ; ( "vm-snapshot" , { reqd= ["new-name-label"] - ; optn= ["new-name-description"] + ; optn= ["new-name-description"; "ignore-vdi-uuids"] ; help= "Snapshot an existing VM, using storage-level fast disk snapshot \ operation where available." diff --git a/ocaml/xapi-cli-server/cli_operations.ml b/ocaml/xapi-cli-server/cli_operations.ml index 5b2396a4cb0..b59032dc544 100644 --- a/ocaml/xapi-cli-server/cli_operations.ml +++ b/ocaml/xapi-cli-server/cli_operations.ml @@ -4079,7 +4079,7 @@ let vm_clone_aux clone_op cloned_string printer include_template_vms rpc do_vm_op printer ~include_template_vms rpc session_id (fun vm -> clone_op ~rpc ~session_id ~vm:(vm.getref ()) ~new_name) params - ["new-name-label"; "new-name-description"] + ["new-name-label"; "new-name-description"; "ignore-vdi-uuids"] in Option.iter (fun desc -> @@ -4093,8 +4093,22 @@ 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 +let vm_snapshot printer rpc session_id params = + let ignore_vdis_uuids = + match List.assoc_opt "ignore-vdi-uuids" params with + | None -> + [] + | Some x -> + String.split_on_char ',' x + in + let ignore_vdis = + List.map + (fun vdi_uuid -> Client.VDI.get_by_uuid rpc session_id vdi_uuid) + ignore_vdis_uuids + in + vm_clone_aux + (Client.VM.snapshot ~ignore_vdis) + "Snapshotted " printer false rpc session_id params let vm_snapshot_with_quiesce printer = vm_clone_aux Client.VM.snapshot_with_quiesce "Snapshotted" printer false diff --git a/ocaml/xapi/message_forwarding.ml b/ocaml/xapi/message_forwarding.ml index c2b7ee979f6..b1fed9b0329 100644 --- a/ocaml/xapi/message_forwarding.ml +++ b/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 ~ignore_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 ~ignore_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 ignore_vdis ) ) in diff --git a/ocaml/xapi/xapi_vm.ml b/ocaml/xapi/xapi_vm.ml index f89088eb34d..e97289259fd 100644 --- a/ocaml/xapi/xapi_vm.ml +++ b/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 ~ignore_vdis = TaskHelper.set_cancellable ~__context ; - Xapi_vm_snapshot.snapshot ~__context ~vm ~new_name + Xapi_vm_snapshot.snapshot ~__context ~vm ~new_name ~ignore_vdis (* 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 *) diff --git a/ocaml/xapi/xapi_vm.mli b/ocaml/xapi/xapi_vm.mli index ae997dab541..aae51f764df 100644 --- a/ocaml/xapi/xapi_vm.mli +++ b/ocaml/xapi/xapi_vm.mli @@ -211,7 +211,11 @@ val clone : __context:Context.t -> vm:API.ref_VM -> new_name:string -> [`VM] Ref.t val snapshot : - __context:Context.t -> vm:API.ref_VM -> new_name:string -> [`VM] Ref.t + __context:Context.t + -> vm:API.ref_VM + -> new_name:string + -> ignore_vdis:[`VDI] API.Ref.t list + -> [`VM] Ref.t val revert : __context:Context.t -> snapshot:[`VM] Ref.t -> unit diff --git a/ocaml/xapi/xapi_vm_clone.ml b/ocaml/xapi/xapi_vm_clone.ml index 85bc84a6838..48a2bffb6f8 100644 --- a/ocaml/xapi/xapi_vm_clone.ml +++ b/ocaml/xapi/xapi_vm_clone.ml @@ -408,7 +408,8 @@ 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 ?(ignore_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 +430,18 @@ 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 + List.filter + (fun x -> + not (List.mem (Db.VBD.get_VDI ~__context ~self:x) ignore_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 diff --git a/ocaml/xapi/xapi_vm_clone.mli b/ocaml/xapi/xapi_vm_clone.mli index df39a09c53e..7105a98106a 100644 --- a/ocaml/xapi/xapi_vm_clone.mli +++ b/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 + -> ?ignore_vdis:[`VDI] API.Ref.t list -> disk_op_t -> __context:Context.t -> vm:[`VM] API.Ref.t diff --git a/ocaml/xapi/xapi_vm_snapshot.ml b/ocaml/xapi/xapi_vm_snapshot.ml index fcff205aa78..b2fa6455f3b 100644 --- a/ocaml/xapi/xapi_vm_snapshot.ml +++ b/ocaml/xapi/xapi_vm_snapshot.ml @@ -25,12 +25,13 @@ open D (*************************************************************************************************) (* Crash-consistant snapshot *) (*************************************************************************************************) -let snapshot ~__context ~vm ~new_name = +let snapshot ~__context ~vm ~new_name ~ignore_vdis = 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 + ~ignore_vdis in debug "Snapshot: end" ; res diff --git a/ocaml/xe-cli/bash-completion b/ocaml/xe-cli/bash-completion index 0948c3e6aaf..ee38438cbf8 100644 --- a/ocaml/xe-cli/bash-completion +++ b/ocaml/xe-cli/bash-completion @@ -373,6 +373,13 @@ _xe() return 0 ;; + ignore-vdi-uuids) # for vm-snapshot + val=$(final_comma_separated_param "$value") + vdis=$(${xe} vdi-list --minimal 2>/dev/null) + IFS=$'\n' + set_completions "$vdis" "$val" + return 0 + ;; *) snd=`echo ${param} | gawk -F- '{print $NF}'` fst=`echo ${param} | gawk -F- '{printf "%s", $1; for (i=2; i