diff --git a/ocaml/idl/datamodel.ml b/ocaml/idl/datamodel.ml index 61a3225edcb..033d65d2604 100644 --- a/ocaml/idl/datamodel.ml +++ b/ocaml/idl/datamodel.ml @@ -4271,6 +4271,7 @@ module SR = struct ; ("vdi_generate_config", "Generating the configuration of the VDI") ; ("vdi_resize_online", "Resizing the VDI online") ; ("vdi_update", "Refreshing the fields on the VDI") + ; ("vdi_revert", "Reverting a VDI to the snapshot") ; ("pbd_create", "Creating a PBD for this SR") ; ("pbd_destroy", "Destroying one of this SR's PBDs") ] @@ -5451,6 +5452,16 @@ module VDI = struct different SR. The destination SR must be visible to the guest." ~allowed_roles:_R_VM_POWER_ADMIN () + let revert = + call ~name:"revert" ~in_oss_since:None ~lifecycle:[] + ~params: + [(Ref _vdi, "snapshot", "The snapshot to which we want to revert")] + ~doc: + "Copy the contents of a snapshot to the VDI it's related to. The \ + original contents of the VDI are lost." + ~errs:[Api_errors.unimplemented_in_sm_backend] + ~allowed_roles:_R_VM_POWER_ADMIN ~doc_tags:[Snapshots] () + let introduce_params first_rel = [ { @@ -5693,6 +5704,8 @@ module VDI = struct ) ; ("set_on_boot", "Setting the on_boot field of the VDI") ; ("blocked", "Operations on this VDI are temporarily blocked") + ; ("revert_to", "Reverting a VDI to a clone of this snapshot") + ; ("revert_from", "Reverting this VDI to a clone of a snapshot") ] ) @@ -6231,6 +6244,7 @@ module VDI = struct ; data_destroy ; list_changed_blocks ; get_nbd_info + ; revert ] ~contents: ([ diff --git a/ocaml/idl/datamodel_common.ml b/ocaml/idl/datamodel_common.ml index 9a2e5496bc0..e6df2d239f2 100644 --- a/ocaml/idl/datamodel_common.ml +++ b/ocaml/idl/datamodel_common.ml @@ -10,7 +10,7 @@ open Datamodel_roles to leave a gap for potential hotfixes needing to increment the schema version.*) let schema_major_vsn = 5 -let schema_minor_vsn = 796 +let schema_minor_vsn = 797 (* Historical schema versions just in case this is useful later *) let rio_schema_major_vsn = 5 diff --git a/ocaml/idl/datamodel_lifecycle.ml b/ocaml/idl/datamodel_lifecycle.ml index a2c14314867..776cbc41036 100644 --- a/ocaml/idl/datamodel_lifecycle.ml +++ b/ocaml/idl/datamodel_lifecycle.ml @@ -140,7 +140,7 @@ let prototyped_of_field = function | "VM_guest_metrics", "netbios_name" -> Some "24.28.0" | "VM", "secureboot_certificates_state" -> - Some "26.1.12-next" + Some "26.1.13" | "VM", "groups" -> Some "24.19.1" | "VM", "pending_guidances_full" -> @@ -241,6 +241,8 @@ let prototyped_of_message = function Some "22.26.0" | "VTPM", "create" -> Some "22.26.0" + | "VDI", "revert" -> + Some "26.1.13-next" | "host", "set_servertime" -> Some "26.0.0" | "host", "get_ntp_synchronized" -> @@ -284,7 +286,7 @@ let prototyped_of_message = function | "VM", "sysprep" -> Some "25.24.0" | "VM", "update_secureboot_certificates_on_boot" -> - Some "26.1.12-next" + Some "26.1.13" | "VM", "get_secureboot_readiness" -> Some "24.17.0" | "VM", "set_uefi_mode" -> diff --git a/ocaml/idl/schematest.ml b/ocaml/idl/schematest.ml index 94477cb5d1d..582a9df0bc3 100644 --- a/ocaml/idl/schematest.ml +++ b/ocaml/idl/schematest.ml @@ -3,7 +3,7 @@ let hash x = Digest.string x |> Digest.to_hex (* BEWARE: if this changes, check that schema has been bumped accordingly in ocaml/idl/datamodel_common.ml, usually schema_minor_vsn *) -let last_known_schema_hash = "e4f116b03de82bd58089044c0df51aee" +let last_known_schema_hash = "247a7b080219583e50e3e1a3c3c85b08" let current_schema_hash : string = let open Datamodel_types in diff --git a/ocaml/quicktest/qt_filter.ml b/ocaml/quicktest/qt_filter.ml index 7ad7e2e8307..c710d611fd8 100644 --- a/ocaml/quicktest/qt_filter.ml +++ b/ocaml/quicktest/qt_filter.ml @@ -1,3 +1,4 @@ +module Listext = Xapi_stdext_std.Listext.List module A = Quicktest_args type 'a test_case = string * Alcotest.speed_level * 'a @@ -280,14 +281,13 @@ module SR = struct ) let allowed_operations ops = - sr_filter (fun i -> - Xapi_stdext_std.Listext.List.subset ops i.Qt.allowed_operations - ) + sr_filter (fun i -> Listext.subset ops i.Qt.allowed_operations) let has_capabilities caps = - sr_filter (fun i -> - Xapi_stdext_std.Listext.List.subset caps i.Qt.capabilities - ) + sr_filter (fun i -> Listext.subset caps i.Qt.capabilities) + + let unavailable_operations ops = + sr_filter (fun i -> not (Listext.subset ops i.Qt.allowed_operations)) (* Helper to filter SRs of specific types *) let has_one_of_types types sr_info = diff --git a/ocaml/quicktest/qt_filter.mli b/ocaml/quicktest/qt_filter.mli index afd271839ef..8601cc24fd7 100644 --- a/ocaml/quicktest/qt_filter.mli +++ b/ocaml/quicktest/qt_filter.mli @@ -60,6 +60,8 @@ module SR : sig val allowed_operations : API.storage_operations_set -> srs -> srs + val unavailable_operations : API.storage_operations_set -> srs -> srs + val has_capabilities : string list -> srs -> srs val has_type : string -> srs -> srs diff --git a/ocaml/quicktest/quicktest_vm_snapshot.ml b/ocaml/quicktest/quicktest_vm_snapshot.ml index eb758fb3548..6463922b751 100644 --- a/ocaml/quicktest/quicktest_vm_snapshot.ml +++ b/ocaml/quicktest/quicktest_vm_snapshot.ml @@ -143,7 +143,7 @@ let test_snapshot_ignore_vdi rpc session_id vm vdi vdi2 = (has_been_snapshot "1") ; check_vdi_snapshot_of rpc session_id vbds ~vdi "0" -let test_revert rpc session_id vm vdi vdi2 = +let test_revert rpc session_id vm vdi vdi2 ~change = let snapshot = take_snapshot rpc session_id vm ~origin:__FUNCTION__ in Client.Client.VM.revert ~rpc ~session_id ~snapshot ; @@ -151,9 +151,14 @@ let test_revert rpc session_id vm vdi vdi2 = let vdi_after = get_vdi_with_user_device rpc session_id vbds "0" in let vdi_after2 = get_vdi_with_user_device rpc session_id vbds "1" in - (* Xapi forces VDI clones, the VDIs' IDs will always change *) - check_vdis_different vdi vdi_after ; - check_vdis_different vdi2 vdi_after2 + let check = + if change then + (* Xapi forces VDI clones, the VDIs' IDs will always change *) + check_vdis_different + else + check_vdis_same + in + check vdi vdi_after ; check vdi2 vdi_after2 let test_revert_cds rpc session_id vm vdi vdi2 = let snapshot = take_snapshot rpc session_id vm ~origin:__FUNCTION__ in @@ -178,13 +183,35 @@ let suite name with_setup tests sr_ops = |> sr SR.(all |> allowed_operations sr_ops) |> vm_template Qt.VM.Template.other +let suite_split_revert name with_setup = + let open Qt_filter in + let needed_ops = [`vdi_create] in + let old_ops = [`vdi_clone] in + let new_ops = [`vdi_revert] in + let sr_candidates = SR.(all |> allowed_operations needed_ops) in + let sr_native = sr_candidates |> SR.allowed_operations new_ops in + let sr_clonables = + sr_candidates + |> SR.unavailable_operations new_ops + |> SR.allowed_operations old_ops + in + let tests (filter_name, sr_filter) tests_f = + let name = Printf.sprintf "%s (%s)" name filter_name in + [(name, `Slow, a_test with_setup tests_f)] + |> conn + |> sr sr_filter + |> vm_template Qt.VM.Template.other + in + tests ("with VDI.revert", sr_native) [test_revert ~change:false] + @ tests ("with cloning method", sr_clonables) [test_revert ~change:true] + let tests () = List.concat [ - suite "VM snapshot tests" with_setup + suite "VM snapshot" with_setup [test_snapshot; test_snapshot_ignore_vdi] [`vdi_create] - ; suite "VM revert tests" with_setup [test_revert] [`vdi_create; `vdi_clone] - ; suite "VM revert with CD tests" with_cd_setup [test_revert_cds] + ; suite_split_revert "VM revert" with_setup + ; suite "VM revert with CD" with_cd_setup [test_revert_cds] [`vdi_create; `vdi_clone] ] diff --git a/ocaml/tests/record_util/old_record_util.ml b/ocaml/tests/record_util/old_record_util.ml index 95fc1c5c4ad..5a32d7b1233 100644 --- a/ocaml/tests/record_util/old_record_util.ml +++ b/ocaml/tests/record_util/old_record_util.ml @@ -299,6 +299,10 @@ let vdi_operation_to_string : API.vdi_operations -> string = function "set_on_boot" | `blocked -> "blocked" + | `revert_to -> + "revert_to" + | `revert_from -> + "revert_from" let sr_operation_to_string : API.storage_operations -> string = function | `scan -> @@ -356,6 +360,8 @@ let sr_operation_to_string : API.storage_operations -> string = function "VDI.resize_online" | `vdi_update -> "VDI.update" + | `vdi_revert -> + "VDI.revert" let vbd_operation_to_string = function | `attach -> diff --git a/ocaml/tests/test_vdi_allowed_operations.ml b/ocaml/tests/test_vdi_allowed_operations.ml index 877b4fa48e5..001774202cf 100644 --- a/ocaml/tests/test_vdi_allowed_operations.ml +++ b/ocaml/tests/test_vdi_allowed_operations.ml @@ -573,6 +573,54 @@ let test_update_allowed_operations () = Alcotest.(check Alcotest_comparators.vdi_operations_set) "update_allowed_operations should be correct" ok_ops allowed_operations +(* Tests for revert operation *) +let test_revert = + let test_can_revert_to_snapshot () = + let __context = Mock.make_context_with_new_db "Mock context" in + + run_assert_equal_with_vdi ~__context + ~vdi_fun:(fun vdi_ref -> + Db.VDI.set_is_a_snapshot ~__context ~self:vdi_ref ~value:true + ) + `revert_to (Ok ()) + in + (* VBDs of checkpoints are marked with currently_attached = true, but we still + need to be able to revert to them. *) + let test_can_revert_to_checkpoint () = + let __context = Mock.make_context_with_new_db "Mock context" in + + run_assert_equal_with_vdi ~__context + ~vdi_fun:(fun vdi_ref -> + Db.VDI.set_is_a_snapshot ~__context ~self:vdi_ref ~value:true ; + make_vbd ~__context ~vDI:vdi_ref ~currently_attached:true ~mode:`RW () + ) + `revert_to (Ok ()) + in + let test_cannot_revert_to_leaf () = + let __context = Mock.make_context_with_new_db "Mock context" in + + run_assert_equal_with_vdi ~__context + ~vdi_fun:(fun _ -> ()) + `revert_to + (Error (Api_errors.only_revert_snapshot, [])) + in + let test_cannot_revert_live () = + let __context = Mock.make_context_with_new_db "Mock context" in + + run_assert_equal_with_vdi ~__context + ~vdi_fun:(fun vdi_ref -> + make_vbd ~__context ~vDI:vdi_ref ~currently_attached:true ~mode:`RW () + ) + `revert_from + (Error (Api_errors.vdi_in_use, [])) + in + [ + ("Revert: Can revert to snapshot", `Quick, test_can_revert_to_snapshot) + ; ("Revert: Can revert to checkpoint", `Quick, test_can_revert_to_checkpoint) + ; ("Revert: Cannot revert to leaf", `Quick, test_cannot_revert_to_leaf) + ; ("Revert: Cannot revert live", `Quick, test_cannot_revert_live) + ] + let test = [ ("test_ca98944", `Quick, test_ca98944) @@ -586,3 +634,4 @@ let test = ("test_null_vm", `Quick, test_null_vm) ; ("test_update_allowed_operations", `Quick, test_update_allowed_operations) ] + @ test_revert diff --git a/ocaml/tests/test_vdi_allowed_operations.mli b/ocaml/tests/test_vdi_allowed_operations.mli new file mode 100644 index 00000000000..dd02dd1f7be --- /dev/null +++ b/ocaml/tests/test_vdi_allowed_operations.mli @@ -0,0 +1 @@ +val test : (string * [> `Quick] * (unit -> unit)) list diff --git a/ocaml/xapi-cli-server/record_util.ml b/ocaml/xapi-cli-server/record_util.ml index a11b30decb3..cf6042eee78 100644 --- a/ocaml/xapi-cli-server/record_util.ml +++ b/ocaml/xapi-cli-server/record_util.ml @@ -175,6 +175,8 @@ let sr_operation_to_string : API.storage_operations -> string = function "VDI.resize_online" | `vdi_update -> "VDI.update" + | `vdi_revert -> + "VDI.revert" | `pbd_create -> "PBD.create" | `pbd_destroy -> diff --git a/ocaml/xapi-idl/storage/storage_interface.ml b/ocaml/xapi-idl/storage/storage_interface.ml index d47123e2b0f..3f897ebfe46 100644 --- a/ocaml/xapi-idl/storage/storage_interface.ml +++ b/ocaml/xapi-idl/storage/storage_interface.ml @@ -1023,6 +1023,15 @@ module StorageAPI (R : RPC) = struct let result_p = Param.mk ~name:"changed_blocks" Types.string in declare "VDI.list_changed_blocks" [] (dbg_p @-> sr_p @-> vdi_from_p @-> vdi_to_p @-> returning result_p err) + + (** [revert dbg sr snapshot_info] creates a new VDI which is a clone of + [snapshot_info] in [sr]. The contents of the VDI in + [snapshot_info.snapshot_of] will be destroyed and replaced with the + contents of [snapshot] *) + let revert = + let snapshot_info_p = Param.mk ~name:"snapshot_info" vdi_info in + declare "VDI.revert" [] + (dbg_p @-> sr_p @-> snapshot_info_p @-> returning unit_p err) end (** [get_by_name task name] returns a vdi with [name] (which may be in any SR) *) @@ -1635,6 +1644,9 @@ module type Server_impl = sig val list_changed_blocks : context -> dbg:debug_info -> sr:sr -> vdi_from:vdi -> vdi_to:vdi -> string + + val revert : + context -> dbg:debug_info -> sr:sr -> snapshot_info:vdi_info -> unit end val get_by_name : context -> dbg:debug_info -> name:string -> sr * vdi_info @@ -1837,6 +1849,9 @@ module Server (Impl : Server_impl) () = struct S.VDI.list_changed_blocks (fun dbg sr vdi_from vdi_to -> Impl.VDI.list_changed_blocks () ~dbg ~sr ~vdi_from ~vdi_to ) ; + S.VDI.revert (fun dbg sr snapshot_info -> + Impl.VDI.revert () ~dbg ~sr ~snapshot_info + ) ; S.get_by_name (fun dbg name -> Impl.get_by_name () ~dbg ~name) ; S.DATA.copy (fun dbg sr vdi vm url dest verify_dest -> Impl.DATA.copy () ~dbg ~sr ~vdi ~vm ~url ~dest ~verify_dest diff --git a/ocaml/xapi-idl/storage/storage_skeleton.ml b/ocaml/xapi-idl/storage/storage_skeleton.ml index a2d2d04ab08..404708f97f4 100644 --- a/ocaml/xapi-idl/storage/storage_skeleton.ml +++ b/ocaml/xapi-idl/storage/storage_skeleton.ml @@ -175,6 +175,9 @@ module VDI = struct let list_changed_blocks ctx ~dbg ~sr ~vdi_from ~vdi_to = Storage_interface.unimplemented __FUNCTION__ + + let revert ctx ~dbg ~sr ~snapshot_info = + Storage_interface.unimplemented __FUNCTION__ end let get_by_name ctx ~dbg ~name = Storage_interface.unimplemented __FUNCTION__ diff --git a/ocaml/xapi-storage-script/main.ml b/ocaml/xapi-storage-script/main.ml index 34372986c72..5f2ec171387 100644 --- a/ocaml/xapi-storage-script/main.ml +++ b/ocaml/xapi-storage-script/main.ml @@ -1352,6 +1352,8 @@ module VDIImpl (M : META) = struct dbg sr vdi ) + let ( let* ) = Lwt_result.bind + let update_keys ~dbg ~sr ~key ~value response = match value with | None -> @@ -1371,6 +1373,11 @@ module VDIImpl (M : META) = struct Volume_client.destroy (volume_rpc ~dbg) dbg sr vdi ) + let revert ~dbg ~sr ~snapshot ~vdi = + return_volume_rpc (fun () -> + Volume_client.revert (volume_rpc ~dbg) dbg sr snapshot vdi + ) + let vdi_attach_common dbg sr vdi domain = Attached_SRs.find sr >>>= fun sr -> (* Discover the URIs using Volume.stat *) @@ -1421,6 +1428,14 @@ module VDIImpl (M : META) = struct ) |> wrap + let revert_impl dbg sr snapshot_info = + wrap + @@ + let snapshot = Storage_interface.(Vdi.string_of snapshot_info.vdi) in + let vdi = Storage_interface.(Vdi.string_of snapshot_info.snapshot_of) in + let* sr = Attached_SRs.find sr in + revert ~dbg ~sr ~snapshot ~vdi + let vdi_snapshot_impl dbg sr vdi_info = Attached_SRs.find sr >>>= (fun sr -> @@ -1659,8 +1674,6 @@ module VDIImpl (M : META) = struct let vdi_set_persistent_impl _dbg _sr _vdi _persistent = return () |> wrap - let ( let* ) = Lwt_result.bind - let vdi_enable_cbt_impl dbg sr vdi = wrap @@ @@ -1946,6 +1959,7 @@ let bind ~volume_script_dir = S.VDI.add_to_sm_config VDI.vdi_add_to_sm_config_impl ; S.VDI.remove_from_sm_config VDI.vdi_remove_from_sm_config_impl ; S.VDI.similar_content VDI.similar_content_impl ; + S.VDI.revert VDI.revert_impl ; let module DP = DPImpl (RuntimeMeta) in S.DP.destroy2 DP.dp_destroy2 ; diff --git a/ocaml/xapi-storage/generator/lib/control.ml b/ocaml/xapi-storage/generator/lib/control.ml index e7f9274c48a..29acd2add84 100644 --- a/ocaml/xapi-storage/generator/lib/control.ml +++ b/ocaml/xapi-storage/generator/lib/control.ml @@ -276,6 +276,27 @@ module Volume (R : RPC) = struct ["[destroy sr volume] removes [volume] from [sr]"] (dbg @-> sr @-> key @-> returning unit errors) + let revert = + let snapshot_p = + Param. + { + key with + name= Some "snapshot" + ; description= + [ + "Read-only volume with the contents that are to be present in \ + the resulting volume" + ] + } + in + R.declare "revert" + [ + "[revert sr snapshot volume] returns a reference to a volume. This " + ; "volume must contain the contents of the read-only [snapshot], and its " + ; "identity must remain the same as [volume]." + ] + (dbg @-> sr @-> snapshot_p @-> key @-> returning unit errors) + let new_name = Param.mk ~name:"new_name" ~description:["New name"] Types.string diff --git a/ocaml/xapi-storage/generator/test/storage_test.ml b/ocaml/xapi-storage/generator/test/storage_test.ml index 3da8be64711..563d5aa9cf4 100644 --- a/ocaml/xapi-storage/generator/test/storage_test.ml +++ b/ocaml/xapi-storage/generator/test/storage_test.ml @@ -189,6 +189,7 @@ let volume_server () = Volume.data_destroy unimplemented ; Volume.list_changed_blocks unimplemented ; Volume.compose unimplemented ; + Volume.revert unimplemented ; Idl.Exn.server Volume.implementation diff --git a/ocaml/xapi/message_forwarding.ml b/ocaml/xapi/message_forwarding.ml index 59e151c86e2..d2b9e28467f 100644 --- a/ocaml/xapi/message_forwarding.ml +++ b/ocaml/xapi/message_forwarding.ml @@ -5553,6 +5553,23 @@ functor forward_vdi_op ~local_fn ~__context ~self:vdi ~remote_fn ) + let revert ~__context ~snapshot = + let ( let@ ) f x = f x in + let doc = "VDI.revert" in + info "%s: snapshot = '%s'" doc (vdi_uuid ~__context snapshot) ; + let local_fn = Local.VDI.revert ~snapshot in + let remote_fn = Client.VDI.revert ~snapshot in + let sr = Db.VDI.get_SR ~__context ~self:snapshot in + let vdi = Db.VDI.get_snapshot_of ~__context ~self:snapshot in + let op () = + forward_vdi_op ~local_fn ~__context ~self:snapshot ~remote_fn + in + let@ () = + with_sr_andor_vdi ~__context ~sr:(sr, `vdi_revert) + ~vdi:(snapshot, `revert_to) ~doc + in + with_sr_andor_vdi ~__context ~vdi:(vdi, `revert_from) ~doc op + let copy ~__context ~vdi ~sr ~base_vdi ~into_vdi = info "VDI.copy: VDI = '%s'; SR = '%s'; base_vdi = '%s'; into_vdi = '%s'" (vdi_uuid ~__context vdi) (sr_uuid ~__context sr) diff --git a/ocaml/xapi/sm.ml b/ocaml/xapi/sm.ml index 1d198cf3f98..d701738657c 100644 --- a/ocaml/xapi/sm.ml +++ b/ocaml/xapi/sm.ml @@ -270,6 +270,18 @@ let vdi_snapshot ~dbg dconf driver driver_params sr vdi = in Sm_exec.parse_vdi_info (Sm_exec.exec_xmlrpc ~dbg (driver_filename driver) call) +let vdi_revert ~dbg dconf driver sr vdi snapshot = + debug "vdi_revert" driver + (sprintf "sr=%s vdi=%s snapshot=%s" (Ref.string_of sr) (Ref.string_of vdi) + (Ref.string_of snapshot) + ) ; + (* NB the SM backends treat the snapshot as the 'target', hence first argument *) + let call = + Sm_exec.make_call ~sr_ref:sr ~vdi_ref:snapshot dconf "vdi_revert" + [Ref.string_of vdi] + in + Sm_exec.parse_unit (Sm_exec.exec_xmlrpc ~dbg (driver_filename driver) call) + let vdi_clone ~dbg dconf driver driver_params sr vdi = with_dbg ~dbg ~name:"vdi_clone" @@ fun di -> let dbg = Debug_info.to_string di in diff --git a/ocaml/xapi/smint.ml b/ocaml/xapi/smint.ml index 1b4e4d45e47..893a0bb72a9 100644 --- a/ocaml/xapi/smint.ml +++ b/ocaml/xapi/smint.ml @@ -60,6 +60,7 @@ module Feature = struct | Large_vdi (** Supports >2TB VDIs *) | Thin_provisioning | Vdi_read_caching + | Vdi_revert type t = capability * int64 @@ -101,6 +102,7 @@ module Feature = struct ; ("LARGE_VDI", Large_vdi) ; ("THIN_PROVISIONING", Thin_provisioning) ; ("VDI_READ_CACHING", Vdi_read_caching) + ; ("VDI_REVERT", Vdi_revert) ] let capability_to_string_table = diff --git a/ocaml/xapi/storage_mux.ml b/ocaml/xapi/storage_mux.ml index c2a0b7f32d2..6b3a0c89add 100644 --- a/ocaml/xapi/storage_mux.ml +++ b/ocaml/xapi/storage_mux.ml @@ -780,6 +780,15 @@ module Mux = struct let rpc = of_sr sr end)) in C.VDI.list_changed_blocks (Debug_info.to_string di) sr vdi_from vdi_to + + let revert () ~dbg ~sr ~snapshot_info = + with_dbg ~name:"VDI.revert" ~dbg @@ fun di -> + info "VDI.revert dbg:%s sr:%s snapshot:%s" dbg (s_of_sr sr) + (string_of_vdi_info snapshot_info) ; + let module C = StorageAPI (Idl.Exn.GenClient (struct + let rpc = of_sr sr + end)) in + C.VDI.revert (Debug_info.to_string di) sr snapshot_info end let get_by_name () ~dbg ~name = diff --git a/ocaml/xapi/storage_smapiv1.ml b/ocaml/xapi/storage_smapiv1.ml index dc1a48e809f..dcafdedea66 100644 --- a/ocaml/xapi/storage_smapiv1.ml +++ b/ocaml/xapi/storage_smapiv1.ml @@ -1124,6 +1124,24 @@ module SMAPIv1 : Server_impl = struct raise (Storage_error (Backend_error (code, params))) | Sm.MasterOnly -> redirect sr + + let call_revert ~__context ~dbg ~sr ~snapshot_info = + let snap = find_vdi ~__context sr snapshot_info.vdi |> fst in + for_vdi ~dbg ~sr ~vdi:snapshot_info.snapshot_of "VDI.revert" + (fun device_config _type sr self -> + Sm.vdi_revert ~dbg device_config _type sr self snap + ) + + let revert _context ~dbg ~sr ~snapshot_info = + with_dbg ~name:"VDI.revert" ~dbg @@ fun di -> + let dbg = Debug_info.to_string di in + try + Server_helpers.exec_with_new_task "VDI.revert" + ~subtask_of:(Ref.of_string dbg) (fun __context -> + call_revert ~__context ~dbg ~sr ~snapshot_info + ) + with Smint.Not_implemented_in_backend -> + raise (Storage_error (Unimplemented "VDI.revert")) end let get_by_name _context ~dbg:_ ~name:_ = assert false diff --git a/ocaml/xapi/storage_smapiv1_wrapper.ml b/ocaml/xapi/storage_smapiv1_wrapper.ml index 71e11367b9f..21e02be8577 100644 --- a/ocaml/xapi/storage_smapiv1_wrapper.ml +++ b/ocaml/xapi/storage_smapiv1_wrapper.ml @@ -843,6 +843,13 @@ functor let data_destroy = destroy_and_data_destroy "VDI.data_destroy" Impl.VDI.data_destroy + let revert context ~dbg ~sr ~snapshot_info = + with_dbg ~name:"VDI.revert" ~dbg @@ fun di -> + info "VDI.revert dbg:%s sr:%s snapshot:%s" di.log (s_of_sr sr) + (string_of_vdi_info snapshot_info) ; + let dbg = Debug_info.to_string di in + Impl.VDI.revert context ~dbg ~sr ~snapshot_info + let stat context ~dbg ~sr ~vdi = with_dbg ~name:"VDI.stat" ~dbg @@ fun di -> info "VDI.stat dbg:%s sr:%s vdi:%s" di.log (s_of_sr sr) (s_of_vdi vdi) ; diff --git a/ocaml/xapi/xapi_sr_operations.ml b/ocaml/xapi/xapi_sr_operations.ml index e74e1986382..f011a7d7f48 100644 --- a/ocaml/xapi/xapi_sr_operations.ml +++ b/ocaml/xapi/xapi_sr_operations.ml @@ -48,6 +48,7 @@ let all_ops : API.storage_operations_set = ; `vdi_list_changed_blocks ; `vdi_set_on_boot ; `vdi_introduce + ; `vdi_revert ; `update ; `pbd_create ; `pbd_destroy @@ -89,6 +90,7 @@ let sm_cap_table : (API.storage_operations * _) list = ; (`vdi_list_changed_blocks, Vdi_configure_cbt) ; (`vdi_set_on_boot, Vdi_reset_on_boot) ; (`update, Sr_update) + ; (`vdi_revert, Vdi_revert) ; (* We fake clone ourselves *) (`vdi_snapshot, Vdi_snapshot) ] diff --git a/ocaml/xapi/xapi_vdi.ml b/ocaml/xapi/xapi_vdi.ml index 7ce251f08c3..004a65b059c 100644 --- a/ocaml/xapi/xapi_vdi.ml +++ b/ocaml/xapi/xapi_vdi.ml @@ -39,7 +39,7 @@ let feature_of_op = Some Vdi_resize_online | `generate_config -> Some Vdi_generate_config - | `clone -> + | `clone | `revert_to | `revert_from -> Some Vdi_clone | `mirror -> Some Vdi_mirror @@ -210,11 +210,16 @@ let check_operation_error ~__context ?sr_records:_ ?(pbd_records = []) (* check to see whether VBDs exist which are using this VDI *) (* If the VBD is currently_attached then some operations can still be - performed ie: VDI.clone (if the VM is suspended we have to have the - 'allow_clone_suspended_vm' flag); VDI.snapshot; VDI.resize_online; - 'blocked' (CP-831); VDI.data_destroy: it is not allowed on VDIs linked - to a VM, but the implementation first waits for the VDI's VBDs to be - unplugged and destroyed, and the checks are performed there. + performed ie: + - VDI.clone (if the VM is suspended we have to have the + 'allow_clone_suspended_vm' flag) + - VDI.snapshot + - VDI.resize_online + - VDI.blocked (CP-831) + - VDI.data_destroy: it is not allowed on VDIs linked to a VM, but the + implementation first waits for the VDI's VBDs to be unplugged and + destroyed, and the checks are performed there + - VDI.revert: is allowed as checkpoints have currently_attached VBDs *) let operation_can_be_performed_live = match op with @@ -222,6 +227,7 @@ let check_operation_error ~__context ?sr_records:_ ?(pbd_records = []) | `resize_online | `blocked | `clone + | `revert_to | `mirror | `enable_cbt | `disable_cbt @@ -305,6 +311,8 @@ let check_operation_error ~__context ?sr_records:_ ?(pbd_records = []) | `resize | `resize_online | `snapshot + | `revert_to + | `revert_from | `set_on_boot -> false | `blocked @@ -347,6 +355,8 @@ let check_operation_error ~__context ?sr_records:_ ?(pbd_records = []) | `resize | `resize_online | `snapshot + | `revert_to + | `revert_from | `update -> true in @@ -387,7 +397,7 @@ let check_operation_error ~__context ?sr_records:_ ?(pbd_records = []) Error (Api_errors.vdi_has_rrds, [_ref]) else Ok () - | `destroy -> + | `destroy | `revert_from -> check_destroy () | `data_destroy -> if not record.Db_actions.vDI_is_a_snapshot then @@ -445,6 +455,11 @@ let check_operation_error ~__context ?sr_records:_ ?(pbd_records = []) Error (Api_errors.vdi_on_boot_mode_incompatible_with_operation, []) else Ok () + | `revert_to -> + if not record.Db_actions.vDI_is_a_snapshot then + Error (Api_errors.only_revert_snapshot, []) + else + Ok () | `mirror | `clone | `generate_config @@ -1103,6 +1118,35 @@ let clone ~__context ~vdi ~driver_params = ) ) +let revert' ~__context ~snapshot = + let module C = Storage_interface.StorageAPI (Idl.Exn.GenClient (struct + let rpc = Storage_access.rpc + end)) in + let sr = Db.VDI.get_SR ~__context ~self:snapshot in + Sm.assert_pbd_is_plugged ~__context ~sr ; + Xapi_vdi_helpers.assert_managed ~__context ~vdi:snapshot ; + let snapshot_rec = Db.VDI.get_record ~__context ~self:snapshot in + + let task = Context.get_task_id __context in + let snapshot_info = + Storage_smapiv1.vdi_info_of_vdi_rec __context snapshot_rec + in + let sr' = + Db.SR.get_uuid ~__context ~self:sr |> Storage_interface.Sr.of_string + in + (* We don't use transform_storage_exn because of the fallback below *) + C.VDI.revert (Ref.string_of task) sr' snapshot_info + +let revert ~__context ~snapshot = + let __FUN = __FUNCTION__ in + Storage_utils.transform_storage_exn @@ fun () -> + try revert' ~__context ~snapshot + with Storage_interface.Storage_error (Unimplemented _) -> + let msg = [Ref.string_of (Db.VDI.get_SR ~__context ~self:snapshot)] in + debug "%s: Backend reported not implemented despite it offering the feature" + __FUN ; + raise Api_errors.(Server_error (unimplemented_in_sm_backend, msg)) + let copy ~__context ~vdi ~sr ~base_vdi ~into_vdi = Xapi_vdi_helpers.assert_managed ~__context ~vdi ; let task_id = Ref.string_of (Context.get_task_id __context) in diff --git a/ocaml/xapi/xapi_vdi.mli b/ocaml/xapi/xapi_vdi.mli index 3d60ad31ff1..68d15e56d0f 100644 --- a/ocaml/xapi/xapi_vdi.mli +++ b/ocaml/xapi/xapi_vdi.mli @@ -258,3 +258,5 @@ val _get_nbd_info : [get_server_certificate] function can be provided to avoid querying the real certificate using the Client module, which is what {!get_nbd_info} does, which would cause the unit test to fail. *) + +val revert : __context:Context.t -> snapshot:[`VDI] Ref.t -> unit diff --git a/ocaml/xapi/xapi_vm_snapshot.ml b/ocaml/xapi/xapi_vm_snapshot.ml index 19c8a55f1c2..95764a6c423 100644 --- a/ocaml/xapi/xapi_vm_snapshot.ml +++ b/ocaml/xapi/xapi_vm_snapshot.ml @@ -23,9 +23,9 @@ module D = Debug.Make (struct let name = "xapi_vm_snapshot" end) module Xs = Ezxenstore_core.Xenstore open D -(*************************************************************************************************) -(* Crash-consistant snapshot *) -(*************************************************************************************************) +(******************************************************************************) +(* Crash-consistant snapshot *) +(******************************************************************************) let snapshot ~__context ~vm ~new_name ~ignore_vdis = debug "Snapshot: begin" ; TaskHelper.set_cancellable ~__context ; @@ -36,9 +36,9 @@ let snapshot ~__context ~vm ~new_name ~ignore_vdis = in debug "Snapshot: end" ; res -(*************************************************************************************************) -(* Quiesced snapshot *) -(*************************************************************************************************) +(******************************************************************************) +(* Quiesced snapshot *) +(******************************************************************************) (* xenstore paths *) let control_path ~xs ~domid x = xs.Xs.getdomainpath domid ^ "/control/" ^ x @@ -48,10 +48,12 @@ let snapshot_path ~xs ~domid x = let snapshot_cleanup_path ~xs ~domid = xs.Xs.getdomainpath domid ^ "/control/snapshot" -(* check if [flag] is set in the control_path of the VM [vm]. This looks like this code is a kind *) -(* of duplicate of the one in {!xal.ml}, {!events.ml} and {!xapi_guest_agent.ml} which are looking *) -(* dynamically if there is a change in this part of the VM's xenstore tree. However, at the moment *) -(* always allowing the operation and checking if it is enabled when it is triggered is sufficient. *) +(* check if [flag] is set in the control_path of the VM [vm]. This looks like + this code is a kind of duplicate of the one in {!xal.ml}, {!events.ml} and + {!xapi_guest_agent.ml} which are looking dynamically if there is a change in + this part of the VM's xenstore tree. However, at the moment always allowing + the operation and checking if it is enabled when it is triggered is + sufficient. *) let is_flag_set ~xs ~flag ~domid ~vm = try xs.Xs.read (control_path ~xs ~domid flag) = "1" with e -> @@ -59,17 +61,17 @@ let is_flag_set ~xs ~flag ~domid ~vm = (Ref.string_of vm) domid (Printexc.to_string e) ; false -(* we want to compare the integer at the end of a common string, ie. strings as x="/local/..../3" *) -(* and y="/local/.../12". The result should be x < y. *) +(* we want to compare the integer at the end of a common string, ie. strings as + x="/local/..../3" and y="/local/.../12". The result should be x < y. *) let compare_snapid_chunks s1 s2 = if String.length s1 <> String.length s2 then String.length s1 - String.length s2 else compare s1 s2 -(*************************************************************************************************) -(* Checkpoint *) -(*************************************************************************************************) +(******************************************************************************) +(* Checkpoint *) +(******************************************************************************) let checkpoint ~__context ~vm ~new_name = Xapi_vmss.show_task_in_xencenter ~__context ~vm ; let power_state = Db.VM.get_power_state ~__context ~self:vm in @@ -120,7 +122,6 @@ let checkpoint ~__context ~vm ~new_name = Xapi_gpumon.update_vgpu_metadata ~__context ~vm ; Xapi_xenops.suspend ~__context ~self:vm with Api_errors.Server_error (_, _) as e -> raise e - (* | _ -> raise (Api_errors.Server_error (Api_errors.vm_checkpoint_suspend_failed, [Ref.string_of vm])) *) ) ; (* snapshot the disks and the suspend VDI *) let snap, err = @@ -210,61 +211,160 @@ let with_vdis_on_error ~vdis f = try f () with e -> Error (e, vdis) let ( let@ ) f x = f x -(* Copy the VBDs and VIFs from a source VM to a dest VM and then delete the old - disks. This operation destroys the data of the dest VM. *) +(* Revert the VBDs of a VM to have the contents of the snapshot and copy the + VIFs from a snapshot VM to the VM. This operation destroys the data of the + dest VM. *) + type cloned = { disks: ([`VBD] Ref.t * API.ref_VDI * bool) list ; cds: ([`VBD] Ref.t * API.ref_VDI * bool) list ; suspend_VDI: [`VDI] Ref.t } +module VDISet = Set.Make (struct + type t = [`VDI] Ref.t + + let compare = Ref.compare +end) + +module VBDSet = Set.Make (struct + type t = [`VBD] Ref.t + + let compare = Ref.compare +end) + let revert_vbds ~__context ~rpc ~session_id ~snapshot ~vm = - let snap_VBDs = Db.VM.get_VBDs ~__context ~self:snapshot in - let snap_VBDs_disk, snap_VBDs_CD = - List.partition - (fun vbd -> Db.VBD.get_type ~__context ~self:vbd = `Disk) - snap_VBDs - in - let snap_disks = - List.map (fun vbd -> Db.VBD.get_VDI ~__context ~self:vbd) snap_VBDs_disk + let get_snapshot_of vdi = Db.VDI.get_snapshot_of ~__context ~self:vdi in + + let disks_of_vbds vbds = + vbds + |> VBDSet.to_seq + |> Seq.map (fun vbd -> Db.VBD.get_VDI ~__context ~self:vbd) + |> VDISet.of_seq in - let snap_disks_snapshot_of = - List.map (fun vdi -> Db.VDI.get_snapshot_of ~__context ~self:vdi) snap_disks + + let snap_VBDs_disk, snap_VBDs_CD = + Db.VM.get_VBDs ~__context ~self:snapshot + |> VBDSet.of_list + |> VBDSet.partition (fun vbd -> Db.VBD.get_type ~__context ~self:vbd = `Disk) in let snap_suspend_VDI = Db.VM.get_suspend_VDI ~__context ~self:snapshot in + let snap_disks_all = disks_of_vbds snap_VBDs_disk in + let snap_disks_snapshot_of = VDISet.map get_snapshot_of snap_disks_all in - let vm_VBDs = Db.VM.get_VBDs ~__context ~self:vm in - (* Filter VBDs to ensure that we don't read empty CDROMs *) + let vm_VBDs_all = Db.VM.get_VBDs ~__context ~self:vm |> VBDSet.of_list in let vm_VBDs_disk = - List.filter + (* Filter VBDs to ensure that we don't read empty CDROMs *) + VBDSet.filter (fun vbd -> Db.VBD.get_type ~__context ~self:vbd = `Disk) - vm_VBDs + vm_VBDs_all + in + let vm_disks_all = disks_of_vbds vm_VBDs_disk in + + let vm_suspend_VDI = + Db.VM.get_suspend_VDI ~__context ~self:vm |> VDISet.singleton in - (* Filter out VM disks for which the snapshot does not have a corresponding - disk - these disks will be left unattached after the revert is complete. *) - let vm_disks = - List.map (fun vbd -> Db.VBD.get_VDI ~__context ~self:vbd) vm_VBDs_disk + + if VDISet.cardinal snap_disks_all <> 0 then + debug "%s: trying to revert VDIs using VDI.revert" __FUNCTION__ ; + + let snap_disks_reverted = + VDISet.filter + (fun snapshot -> + try + Client.VDI.revert ~rpc ~session_id ~snapshot ; + true + with + | Api_errors.(Server_error (e, _)) + when e = Api_errors.sr_operation_not_supported + || e = Api_errors.unimplemented_in_sm_backend + -> + false + ) + snap_disks_all in - let vm_disks_with_snapshot = - List.filter (fun vdi -> List.mem vdi snap_disks_snapshot_of) vm_disks + + let vm_disks_already_reverted = + VDISet.map get_snapshot_of snap_disks_reverted in - let vm_suspend_VDI = Db.VM.get_suspend_VDI ~__context ~self:vm in - debug "Cleaning up the old VBDs and VDIs to have more free space" ; - List.iter (safe_destroy_vbd ~__context ~rpc ~session_id) vm_VBDs ; - List.iter + let vm_disks_to_be_destroyed = + let ( --- ) = VDISet.diff in + let ( +++ ) = VDISet.union in + + (* Disks without snapshot are left unattached after the revert is complete. *) + let vm_disks_without_snapshot = vm_disks_all --- snap_disks_snapshot_of in + + vm_disks_all + --- vm_disks_without_snapshot + --- vm_disks_already_reverted + +++ vm_suspend_VDI + in + + let filter_vbds_from_vdis vbds vdis = + vbds + |> VBDSet.filter (fun vbd -> + VDISet.mem (Db.VBD.get_VDI ~__context ~self:vbd) vdis + ) + in + + let vm_vbds_to_be_destroyed = + filter_vbds_from_vdis vm_VBDs_all vm_disks_to_be_destroyed + in + + let snap_VBDs_reverted = + filter_vbds_from_vdis snap_VBDs_disk snap_disks_reverted + in + + (* + snap VBDs (disk) + - snap VBDs from reverted disks + = snap VBDs to be cloned + *) + let snap_VBDs_to_be_cloned = + let ( --- ) = VBDSet.diff in + snap_VBDs_disk --- snap_VBDs_reverted + in + if + VBDSet.cardinal vm_vbds_to_be_destroyed <> 0 + || VDISet.cardinal vm_disks_to_be_destroyed <> 0 + then + debug "%s: Cleaning up the old VBDs and VDIs to have more free space" + __FUNCTION__ ; + VBDSet.iter + (safe_destroy_vbd ~__context ~rpc ~session_id) + vm_vbds_to_be_destroyed ; + VDISet.iter (safe_destroy_vdi ~__context ~rpc ~session_id) - (vm_suspend_VDI :: vm_disks_with_snapshot) ; + vm_disks_to_be_destroyed ; TaskHelper.set_progress ~__context 0.2 ; - debug "Cloning the snapshotted disks" ; + if VBDSet.cardinal snap_VBDs_to_be_cloned <> 0 then + debug "%s: Cloning the snapshotted disks" __FUNCTION__ ; + let driver_params = Xapi_vm_clone.make_driver_params () in let cloned_disks = - Xapi_vm_clone.safe_clone_disks rpc session_id Xapi_vm_clone.Disk_op_clone - ~__context snap_VBDs_disk driver_params + (* the list of cloned VDIs maintains the order of the VBDs given, use this + to correlate the VDI with the original VDI before the clone *) + let snap_VBDs_to_be_cloned = + snap_VBDs_to_be_cloned |> VBDSet.to_seq |> List.of_seq + in + let snap_disks_previous_snapshot_of = + snap_VBDs_to_be_cloned + |> List.map (fun vbd -> + let vdi = Db.VBD.get_VDI ~__context ~self:vbd in + Db.VDI.get_snapshot_of ~__context ~self:vdi + ) + in + + let cloned = + Xapi_vm_clone.safe_clone_disks rpc session_id Xapi_vm_clone.Disk_op_clone + ~__context snap_VBDs_to_be_cloned driver_params + in + List.combine cloned snap_disks_previous_snapshot_of in let destroy_vdis_on_error = List.filter_map - (fun (_, vdi, on_error_delete) -> + (fun ((_, vdi, on_error_delete), _) -> if on_error_delete then Some vdi else @@ -274,20 +374,22 @@ let revert_vbds ~__context ~rpc ~session_id ~snapshot ~vm = in let@ () = with_vdis_on_error ~vdis:destroy_vdis_on_error in let cloned_CDs = + let snap_VBDs_CD = snap_VBDs_CD |> VBDSet.to_seq |> List.of_seq in Xapi_vm_clone.safe_clone_disks rpc session_id Xapi_vm_clone.Disk_op_clone ~__context snap_VBDs_CD driver_params in TaskHelper.set_progress ~__context 0.5 ; - debug "Updating the snapshot_of fields for relevant VDIs" ; - List.iter2 - (fun snap_disk (_, cloned_disk, _) -> + if cloned_disks <> [] then + debug "%s: Updating the snapshot_of fields for relevant VDIs" __FUNCTION__ ; + + List.iter + (fun ((_, cloned_disk, _), snapshot_of) -> (* For each snapshot disk which was just cloned: 1) Find the value of snapshot_of 2) Find all snapshots with the same snapshot_of 3) Update each of these snapshots so that their snapshot_of points to the new cloned disk. *) let open Xapi_database.Db_filter_types in - let snapshot_of = Db.VDI.get_snapshot_of ~__context ~self:snap_disk in let all_snaps_in_tree = Db.VDI.get_refs_where ~__context ~expr:(Eq (Field "snapshot_of", Literal (Ref.string_of snapshot_of))) @@ -298,7 +400,7 @@ let revert_vbds ~__context ~rpc ~session_id ~snapshot ~vm = ) all_snaps_in_tree ) - snap_disks cloned_disks ; + cloned_disks ; debug "Cloning the suspend VDI if needed" ; let cloned_suspend_VDI = if snap_suspend_VDI = Ref.null then @@ -309,12 +411,13 @@ let revert_vbds ~__context ~rpc ~session_id ~snapshot ~vm = in let destroy_vdis_on_error = cloned_suspend_VDI :: destroy_vdis_on_error in let@ () = with_vdis_on_error ~vdis:destroy_vdis_on_error in + let vbds_to_copy = List.map fst cloned_disks @ cloned_CDs in TaskHelper.set_progress ~__context 0.6 ; - debug "Copying the VBDs" ; + if vbds_to_copy <> [] then debug "%s: Copying the VBDs" __FUNCTION__ ; let (_ : [`VBD] Ref.t list) = List.map (fun (vbd, vdi, _) -> Xapi_vbd_helpers.copy ~__context ~vm ~vdi vbd) - (cloned_disks @ cloned_CDs) + vbds_to_copy in debug "Update the suspend_VDI" ; Db.VM.set_suspend_VDI ~__context ~self:vm ~value:cloned_suspend_VDI ; @@ -347,7 +450,8 @@ let update_vifs_vbds_vgpus_and_vusbs ~__context ~snapshot ~vm = in TaskHelper.set_progress ~__context 0.8 ; debug "Cleaning up the old VUSBs" ; - (* As snapshot is not allowed when vm has VUSBs, so no need to set up new VUSBs.*) + (* As snapshot is not allowed when vm has VUSBs, so no need to set up + new VUSBs.*) List.iter (safe_destroy_vusb ~__context ~rpc ~session_id) vm_VUSBs ; debug "Cleaning up the old VGPUs" ; List.iter (safe_destroy_vgpu ~__context ~rpc ~session_id) vm_VGPUs ;