vdi: enable resize_online command

Signed-off-by: Anthoine Bourgeois <anthoine.bourgeois@vates.tech>

Author: AnthoineB

ocaml/idl/datamodel.ml

@@ -5336,16 +5336,7 @@ module VDI = struct
       ~doc:"Resize the VDI." ~allowed_roles:_R_VM_ADMIN ()
 
   let resize_online =
-    call ~name:"resize_online" ~in_oss_since:None
-      ~lifecycle:
-        [
-          (Published, rel_rio, "")
-        ; (Deprecated, rel_inverness, "Dummy transition")
-        ; ( Removed
-          , rel_inverness
-          , "Online VDI resize is not supported by any of the storage backends."
-          )
-        ]
+    call ~name:"resize_online" ~in_oss_since:None ~lifecycle:[]
       ~params:
         [
           (Ref _vdi, "vdi", "The VDI to resize")

ocaml/tests/test_vdi_allowed_operations.ml

@@ -549,7 +549,7 @@ let test_update_allowed_operations () =
   let allowed_operations =
     Db.VDI.get_allowed_operations ~__context ~self:vdi_ref
   in
-  let ok_ops : API.vdi_operations_set = [`snapshot; `clone; `copy] in
+  let ok_ops : API.vdi_operations_set = [`snapshot; `clone; `copy; `resize_online] in
   Alcotest.(check Alcotest_comparators.vdi_operations_set)
     "update_allowed_operations should be correct" ok_ops allowed_operations ;
   let vbd_ref = Db.VDI.get_VBDs ~__context ~self:vdi_ref |> List.hd in

ocaml/xapi-idl/storage/storage_interface.ml

@@ -813,6 +813,14 @@ module StorageAPI (R : RPC) = struct
       declare "VDI.resize" []
         (dbg_p @-> sr_p @-> vdi_p @-> new_size_p @-> returning new_size_p err)
 
+    (** [resize_online task sr vdi new_size] makes a VDI's virtual_size at least
+        [new_size] bytes. The function returns the new virtual_size which may be
+        bigger (but not less than) requested. *)
+    let resize_online =
+      let new_size_p = Param.mk ~name:"new_size" Types.int64 in
+      declare "VDI.resize_online" []
+        (dbg_p @-> sr_p @-> vdi_p @-> new_size_p @-> returning new_size_p err)
+
     (** [destroy task sr vdi] removes [vdi] from [sr] *)
     let destroy =
       declare "VDI.destroy" []
@@ -1525,6 +1533,9 @@ module type Server_impl = sig
     val resize :
       context -> dbg:debug_info -> sr:sr -> vdi:vdi -> new_size:int64 -> int64
 
+    val resize_online :
+      context -> dbg:debug_info -> sr:sr -> vdi:vdi -> new_size:int64 -> int64
+
     val destroy : context -> dbg:debug_info -> sr:sr -> vdi:vdi -> unit
 
     val stat : context -> dbg:debug_info -> sr:sr -> vdi:vdi -> vdi_info
@@ -1780,6 +1791,9 @@ module Server (Impl : Server_impl) () = struct
     S.VDI.resize (fun dbg sr vdi new_size ->
         Impl.VDI.resize () ~dbg ~sr ~vdi ~new_size
     ) ;
+    S.VDI.resize_online (fun dbg sr vdi new_size ->
+        Impl.VDI.resize_online () ~dbg ~sr ~vdi ~new_size
+    ) ;
     S.VDI.destroy (fun dbg sr vdi -> Impl.VDI.destroy () ~dbg ~sr ~vdi) ;
     S.VDI.stat (fun dbg sr vdi -> Impl.VDI.stat () ~dbg ~sr ~vdi) ;
     S.VDI.introduce (fun dbg sr uuid sm_config location ->

ocaml/xapi-idl/storage/storage_skeleton.ml

@@ -106,6 +106,9 @@ module VDI = struct
   let resize ctx ~dbg ~sr ~vdi ~new_size =
     Storage_interface.unimplemented __FUNCTION__
 
+  let resize_online ctx ~dbg ~sr ~vdi ~new_size =
+    Storage_interface.unimplemented __FUNCTION__
+
   let destroy ctx ~dbg ~sr ~vdi = Storage_interface.unimplemented __FUNCTION__
 
   let stat ctx ~dbg ~sr ~vdi = Storage_interface.unimplemented __FUNCTION__

ocaml/xapi-storage-script/main.ml

@@ -898,6 +898,7 @@ module QueryImpl (M : META) = struct
         ; ("Volume.clone", "VDI_CLONE")
         ; ("Volume.snapshot", "VDI_SNAPSHOT")
         ; ("Volume.resize", "VDI_RESIZE")
+        ; ("Volume.resize_online", "VDI_RESIZE_ONLINE")
         ; ("Volume.destroy", "VDI_DELETE")
         ; ("Volume.stat", "VDI_UPDATE")
         ]
@@ -1504,6 +1505,19 @@ module VDIImpl (M : META) = struct
     )
     |> wrap
 
+  let vdi_resize_online_impl dbg sr vdi' new_size =
+    (let vdi = Storage_interface.Vdi.string_of vdi' in
+     Attached_SRs.find sr >>>= fun sr ->
+     return_volume_rpc (fun () ->
+         Volume_client.resize_online (volume_rpc ~dbg) dbg sr vdi new_size
+     )
+     >>>= fun () ->
+     (* Now call Volume.stat to discover the size *)
+     stat ~dbg ~sr ~vdi >>>= fun response ->
+     return response.Xapi_storage.Control.virtual_size
+    )
+    |> wrap
+
   let vdi_stat_impl dbg sr vdi' =
     (let vdi = Storage_interface.Vdi.string_of vdi' in
      Attached_SRs.find sr >>>= fun sr ->
@@ -1934,6 +1948,7 @@ let bind ~volume_script_dir =
   S.VDI.set_name_label VDI.vdi_set_name_label_impl ;
   S.VDI.set_name_description VDI.vdi_set_name_description_impl ;
   S.VDI.resize VDI.vdi_resize_impl ;
+  S.VDI.resize_online VDI.vdi_resize_online_impl ;
   S.VDI.stat VDI.vdi_stat_impl ;
   S.VDI.introduce VDI.vdi_introduce_impl ;
   S.VDI.attach3 VDI.vdi_attach3_impl ;

ocaml/xapi-storage/generator/lib/control.ml

@@ -330,6 +330,17 @@ module Volume (R : RPC) = struct
       ]
       (dbg @-> sr @-> key @-> new_size @-> returning unit errors)
 
+  let resize_online =
+    let new_size =
+      Param.mk ~name:"new_size" ~description:["New disk size"] Types.int64
+    in
+    R.declare "resize_online"
+      [
+        "[resize_online sr volume new_size] enlarges [volume] to be at least "
+      ; "[new_size]."
+      ]
+      (dbg @-> sr @-> key @-> new_size @-> returning unit errors)
+
   let stat =
     R.declare "stat"
       ["[stat sr volume] returns metadata associated with [volume]."]

ocaml/xapi-storage/generator/test/storage_test.ml

@@ -181,6 +181,7 @@ let volume_server () =
   Volume.set unimplemented ;
   Volume.unset unimplemented ;
   Volume.resize unimplemented ;
+  Volume.resize_online unimplemented ;
   Volume.stat unimplemented ;
   Volume.compare unimplemented ;
   Volume.similar_content unimplemented ;

ocaml/xapi/message_forwarding.ml

@@ -5432,6 +5432,16 @@ functor
             forward_vdi_op ~local_fn ~__context ~self:vdi ~remote_fn
         )
 
+      let resize_online ~__context ~vdi ~size =
+        info "VDI.resize_online: VDI = '%s'; size = %Ld" (vdi_uuid ~__context vdi) size ;
+        let local_fn = Local.VDI.resize_online ~vdi ~size in
+        let remote_fn = Client.VDI.resize_online ~vdi ~size in
+        let sR = Db.VDI.get_SR ~__context ~self:vdi in
+        with_sr_andor_vdi ~__context ~sr:(sR, `vdi_resize) ~vdi:(vdi, `resize_online)
+          ~doc:"VDI.resize_online" (fun () ->
+            forward_vdi_op ~local_fn ~__context ~self:vdi ~remote_fn
+        )
+
       let generate_config ~__context ~host ~vdi =
         info "VDI.generate_config: VDI = '%s'; host = '%s'"
           (vdi_uuid ~__context vdi)

ocaml/xapi/sm.ml

@@ -299,6 +299,20 @@ let vdi_resize ~dbg dconf driver sr vdi newsize =
   in
   Sm_exec.parse_vdi_info (Sm_exec.exec_xmlrpc ~dbg (driver_filename driver) call)
 
+let vdi_resize_online ~dbg dconf driver sr vdi newsize =
+  with_dbg ~dbg ~name:"vdi_resize_online" @@ fun di ->
+  let dbg = Debug_info.to_string di in
+  debug "vdi_resize_online" driver
+    (sprintf "sr=%s vdi=%s newsize=%Ld" (Ref.string_of sr) (Ref.string_of vdi)
+       newsize
+    ) ;
+  srmaster_only dconf ;
+  let call =
+    Sm_exec.make_call ~sr_ref:sr ~vdi_ref:vdi dconf "vdi_resize_online"
+      [sprintf "%Lu" newsize]
+  in
+  Sm_exec.parse_vdi_info (Sm_exec.exec_xmlrpc ~dbg (driver_filename driver) call)
+
 let vdi_generate_config ~dbg dconf driver sr vdi =
   with_dbg ~dbg ~name:"vdi_generate_config" @@ fun di ->
   let dbg = Debug_info.to_string di in

ocaml/xapi/storage_mux.ml

@@ -480,6 +480,15 @@ module Mux = struct
       end)) in
       C.VDI.resize (Debug_info.to_string di) sr vdi new_size
 
+    let resize_online () ~dbg ~sr ~vdi ~new_size =
+      with_dbg ~name:"VDI.resize_online" ~dbg @@ fun di ->
+      info "VDI.resize_online dbg:%s sr:%s vdi:%s new_size:%Ld" dbg (s_of_sr sr)
+        (s_of_vdi vdi) new_size ;
+      let module C = StorageAPI (Idl.Exn.GenClient (struct
+        let rpc = of_sr sr
+      end)) in
+      C.VDI.resize_online (Debug_info.to_string di) sr vdi new_size
+
     let destroy () ~dbg ~sr ~vdi =
       with_dbg ~name:"VDI.destroy" ~dbg @@ fun di ->
       info "VDI.destroy dbg:%s sr:%s vdi:%s" dbg (s_of_sr sr) (s_of_vdi vdi) ;