From 7f931c11c9ed4d7b0ba73fc9360e32cb653264c7 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Fri, 5 Jun 2026 10:22:35 +0100 Subject: [PATCH 1/7] xapi_vm_snapshot: shorten length of comments Signed-off-by: Pau Ruiz Safont --- ocaml/xapi/xapi_vm_snapshot.ml | 36 ++++++++++++++++++---------------- 1 file changed, 19 insertions(+), 17 deletions(-) diff --git a/ocaml/xapi/xapi_vm_snapshot.ml b/ocaml/xapi/xapi_vm_snapshot.ml index 19c8a55f1c2..3392c34c9e0 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 = @@ -347,7 +348,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 ; From 639bc3d69d5dc5c937f191af2b8e64733a42dd1c Mon Sep 17 00:00:00 2001 From: John Else Date: Tue, 9 Sep 2014 12:31:03 +0100 Subject: [PATCH 2/7] xapi_vdi: Introduce VDI operations needed for revert This is for both the live VDI (revert_from) and the snapshot (revert_to) These correspond to the VM operations `reverting` and `revert`, respectively. Only snapshots backed by an SR that allows clones are allowed to be reverted to. This is because SRs supporting revert is not enough to use vdi revert without clone: having an incorrect snapshot_of field will also cause the use of clone. With this we can ensure that if a bad edge case is met the system has a working fallback. Reverting to "live" snapshot VDIs is allowed, this happens when reverting to a checkpoint. Currently reverting requires the cloning feature because it's not possible to discriminate between backends that support vdi revert and ones that done. This will be possible once all of them do Test that VDIs... * can be reverted to a snapshot. * can be reverted to an attached snapshot. * cannot be reverted to a leaf VDI. * cannot be reverted to an attached leaf. Co-authored-by: John Else Signed-off-by: Pau Ruiz Safont --- ocaml/idl/datamodel.ml | 2 + ocaml/idl/schematest.ml | 2 +- ocaml/tests/record_util/old_record_util.ml | 4 ++ ocaml/tests/test_vdi_allowed_operations.ml | 49 +++++++++++++++++++++ ocaml/tests/test_vdi_allowed_operations.mli | 1 + ocaml/xapi/xapi_vdi.ml | 29 +++++++++--- 6 files changed, 79 insertions(+), 8 deletions(-) create mode 100644 ocaml/tests/test_vdi_allowed_operations.mli diff --git a/ocaml/idl/datamodel.ml b/ocaml/idl/datamodel.ml index 61a3225edcb..7474eeab92d 100644 --- a/ocaml/idl/datamodel.ml +++ b/ocaml/idl/datamodel.ml @@ -5693,6 +5693,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") ] ) diff --git a/ocaml/idl/schematest.ml b/ocaml/idl/schematest.ml index 94477cb5d1d..d33a1f8f352 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 = "f45d29452df691507ce8fc9f539649f1" let current_schema_hash : string = let open Datamodel_types in diff --git a/ocaml/tests/record_util/old_record_util.ml b/ocaml/tests/record_util/old_record_util.ml index 95fc1c5c4ad..b2c6e0d80f1 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 -> 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/xapi_vdi.ml b/ocaml/xapi/xapi_vdi.ml index 7ce251f08c3..a847093bbf2 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 From c368ca80b45a72acfbd6841d8643bbe4a658c895 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Wed, 24 Sep 2025 10:27:37 +0100 Subject: [PATCH 3/7] storage: add VDI.revert This operation allows storage backends to implement VDI revert natively, as well as advertise it. The operation is unused by xapi for the time being. Co-authored-by: David Scott Co-authored-by: John Else Signed-off-by: Pau Ruiz Safont --- ocaml/xapi-idl/storage/storage_interface.ml | 15 +++++++++++++ ocaml/xapi-idl/storage/storage_skeleton.ml | 3 +++ ocaml/xapi-storage-script/main.ml | 18 ++++++++++++++-- ocaml/xapi-storage/generator/lib/control.ml | 21 +++++++++++++++++++ .../generator/test/storage_test.ml | 1 + ocaml/xapi/sm.ml | 12 +++++++++++ ocaml/xapi/smint.ml | 2 ++ ocaml/xapi/storage_mux.ml | 9 ++++++++ ocaml/xapi/storage_smapiv1.ml | 15 +++++++++++++ ocaml/xapi/storage_smapiv1_wrapper.ml | 7 +++++++ 10 files changed, 101 insertions(+), 2 deletions(-) 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/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..3d39cf32027 100644 --- a/ocaml/xapi/storage_smapiv1.ml +++ b/ocaml/xapi/storage_smapiv1.ml @@ -1124,6 +1124,21 @@ 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 + Server_helpers.exec_with_new_task "VDI.revert" + ~subtask_of:(Ref.of_string dbg) (fun __context -> + call_revert ~__context ~dbg ~sr ~snapshot_info + ) 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) ; From 6c95e340f6501a1fd17b049fcb89eca25d601029 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Thu, 2 Oct 2025 17:09:28 +0100 Subject: [PATCH 4/7] CA-143836: Add VDI.revert API call The API function is needed to be able to forward it across the pool and to block other operations on the VDI while it's running. It's unused for the time being. Co-authored-by: John Else Signed-off-by: Pau Ruiz Safont --- ocaml/idl/datamodel.ml | 12 ++++++++++ ocaml/tests/record_util/old_record_util.ml | 2 ++ ocaml/xapi-cli-server/record_util.ml | 2 ++ ocaml/xapi/message_forwarding.ml | 17 ++++++++++++++ ocaml/xapi/xapi_sr_operations.ml | 2 ++ ocaml/xapi/xapi_vdi.ml | 26 ++++++++++++++++++++++ ocaml/xapi/xapi_vdi.mli | 2 ++ 7 files changed, 63 insertions(+) diff --git a/ocaml/idl/datamodel.ml b/ocaml/idl/datamodel.ml index 7474eeab92d..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 = [ { @@ -6233,6 +6244,7 @@ module VDI = struct ; data_destroy ; list_changed_blocks ; get_nbd_info + ; revert ] ~contents: ([ diff --git a/ocaml/tests/record_util/old_record_util.ml b/ocaml/tests/record_util/old_record_util.ml index b2c6e0d80f1..5a32d7b1233 100644 --- a/ocaml/tests/record_util/old_record_util.ml +++ b/ocaml/tests/record_util/old_record_util.ml @@ -360,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/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/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/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 a847093bbf2..7117104e68b 100644 --- a/ocaml/xapi/xapi_vdi.ml +++ b/ocaml/xapi/xapi_vdi.ml @@ -1118,6 +1118,32 @@ 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 = + 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 + 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 From d1ae2a7dd9ad83dc49b79ee1987200eeb0f87d89 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Mon, 6 Oct 2025 11:15:11 +0100 Subject: [PATCH 5/7] xapi_vm_snapshot: change VM.revert to use VDI.revert The code now tries to call VDI.revert on all the disk VDIs, and if that fails, it falls back to the original revert method that destroys VM disks, clones snapshot disks and then fixes up metadata. This means that the successfully reverted disks must be excluded from the original method. This is done by introducing sets of VDIs and VBDs and using set logic on them. The CD disks and the suspend VDI are treated like before: destroy + clone. The code is more convoluted that I would have liked because of existing clone infrastructure mixes VBDs with VDIs, so they need to be converted back and forth to be able to run the previous method correctly, especially for updating the snapshot_of field of the cloned snapshot disks. Quicktests encodes the difference in behaviour from the original method to the native one: now VDI UUIDs are not changed when reverting. Signed-off-by: Pau Ruiz Safont --- ocaml/idl/datamodel_common.ml | 2 +- ocaml/idl/schematest.ml | 2 +- ocaml/quicktest/qt_filter.ml | 12 +- ocaml/quicktest/qt_filter.mli | 2 + ocaml/quicktest/quicktest_vm_snapshot.ml | 41 +++++- ocaml/xapi/xapi_vm_snapshot.ml | 173 ++++++++++++++++++----- 6 files changed, 179 insertions(+), 53 deletions(-) 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/schematest.ml b/ocaml/idl/schematest.ml index d33a1f8f352..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 = "f45d29452df691507ce8fc9f539649f1" +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/xapi/xapi_vm_snapshot.ml b/ocaml/xapi/xapi_vm_snapshot.ml index 3392c34c9e0..0f4324b27f6 100644 --- a/ocaml/xapi/xapi_vm_snapshot.ml +++ b/ocaml/xapi/xapi_vm_snapshot.ml @@ -211,61 +211,155 @@ 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 _ -> 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 @@ -275,20 +369,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))) @@ -299,7 +395,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 @@ -310,12 +406,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 ; From 97823b4f7c015872b108dd4b2ba79a0b68daeadb Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Thu, 11 Jun 2026 10:37:42 +0100 Subject: [PATCH 6/7] datamodel_lifecycle: refresh Signed-off-by: Pau Ruiz Safont --- ocaml/idl/datamodel_lifecycle.ml | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) 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" -> From f887de1b17b39875d2c4301d654544d6247d9758 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Fri, 12 Jun 2026 10:04:35 +0100 Subject: [PATCH 7/7] xapi_vm_snapshot: Fail VM.revert when a VDI.revert actually fails In case where there's an error while reverting on the Storage Backend, the state of the SR might become unstable, and a recovery using the clone method for reverting might introduce bigger issues. Instead stop the revert immediately. The cases where ignoring the errors is acceptable is when either the SR does not advertise support for VDI_REVERT, and when the SR does not implement revert for a particular VDI. for example, if the SR implements the revert for only some of the formats it implements. Signed-off-by: Pau Ruiz Safont --- ocaml/xapi/storage_smapiv1.ml | 11 +++++++---- ocaml/xapi/xapi_vdi.ml | 3 +++ ocaml/xapi/xapi_vm_snapshot.ml | 7 ++++++- 3 files changed, 16 insertions(+), 5 deletions(-) diff --git a/ocaml/xapi/storage_smapiv1.ml b/ocaml/xapi/storage_smapiv1.ml index 3d39cf32027..dcafdedea66 100644 --- a/ocaml/xapi/storage_smapiv1.ml +++ b/ocaml/xapi/storage_smapiv1.ml @@ -1135,10 +1135,13 @@ module SMAPIv1 : Server_impl = struct let revert _context ~dbg ~sr ~snapshot_info = with_dbg ~name:"VDI.revert" ~dbg @@ fun di -> let dbg = Debug_info.to_string di in - Server_helpers.exec_with_new_task "VDI.revert" - ~subtask_of:(Ref.of_string dbg) (fun __context -> - call_revert ~__context ~dbg ~sr ~snapshot_info - ) + 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/xapi_vdi.ml b/ocaml/xapi/xapi_vdi.ml index 7117104e68b..004a65b059c 100644 --- a/ocaml/xapi/xapi_vdi.ml +++ b/ocaml/xapi/xapi_vdi.ml @@ -1138,10 +1138,13 @@ let revert' ~__context ~snapshot = 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 = diff --git a/ocaml/xapi/xapi_vm_snapshot.ml b/ocaml/xapi/xapi_vm_snapshot.ml index 0f4324b27f6..95764a6c423 100644 --- a/ocaml/xapi/xapi_vm_snapshot.ml +++ b/ocaml/xapi/xapi_vm_snapshot.ml @@ -274,7 +274,12 @@ let revert_vbds ~__context ~rpc ~session_id ~snapshot ~vm = try Client.VDI.revert ~rpc ~session_id ~snapshot ; true - with _ -> false + 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