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 <dave.scott@eu.citrix.com>
Co-authored-by: John Else <john.else@citrix.com>
Signed-off-by: Pau Ruiz Safont <pau.safont@vates.tech>
(cherry picked from commit c368ca8)

Author: 3 people

ocaml/xapi-idl/storage/storage_interface.ml

@@ -1026,6 +1026,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) *)
@@ -1651,6 +1660,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
@@ -1854,6 +1866,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

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__

ocaml/xapi-storage-script/main.ml

@@ -1355,6 +1355,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 ->
@@ -1374,6 +1376,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 *)
@@ -1424,6 +1431,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 ->
@@ -1662,8 +1677,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
     @@
@@ -1953,6 +1966,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 ;

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
 

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
 

ocaml/xapi/sm.ml

@@ -269,6 +269,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

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 =

ocaml/xapi/storage_mux.ml

@@ -782,6 +782,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 =

ocaml/xapi/storage_smapiv1.ml

@@ -1125,6 +1125,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

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) ;