Merge pull request #4922 from robhoes/master

CP-40388: Call VDI.activate_readonly in SMAPIv3 when supported and appropriate

Author: robhoes

ocaml/xapi-idl/storage/storage_interface.ml

@@ -883,6 +883,12 @@ module StorageAPI (R : RPC) = struct
       declare "VDI.activate3" []
         (dbg_p @-> dp_p @-> sr_p @-> vdi_p @-> vm_p @-> returning unit_p err)
 
+    (** [activate_readonly task dp sr vdi] signals the desire to immediately use [vdi].
+        This client must have called [attach] on the [vdi] first. *)
+    let activate_readonly =
+      declare "VDI.activate_readonly" []
+        (dbg_p @-> dp_p @-> sr_p @-> vdi_p @-> vm_p @-> returning unit_p err)
+
     (** [deactivate task dp sr vdi] signals that this client has stopped reading
         (and writing) [vdi]. *)
     let deactivate =
@@ -1309,6 +1315,9 @@ module type Server_impl = sig
     val activate3 :
       context -> dbg:debug_info -> dp:dp -> sr:sr -> vdi:vdi -> vm:vm -> unit
 
+    val activate_readonly :
+      context -> dbg:debug_info -> dp:dp -> sr:sr -> vdi:vdi -> vm:vm -> unit
+
     val deactivate :
       context -> dbg:debug_info -> dp:dp -> sr:sr -> vdi:vdi -> vm:vm -> unit
 
@@ -1530,6 +1539,9 @@ module Server (Impl : Server_impl) () = struct
     S.VDI.activate3 (fun dbg dp sr vdi vm ->
         Impl.VDI.activate3 () ~dbg ~dp ~sr ~vdi ~vm
     ) ;
+    S.VDI.activate_readonly (fun dbg dp sr vdi vm ->
+        Impl.VDI.activate_readonly () ~dbg ~dp ~sr ~vdi ~vm
+    ) ;
     S.VDI.deactivate (fun dbg dp sr vdi vm ->
         Impl.VDI.deactivate () ~dbg ~dp ~sr ~vdi ~vm
     ) ;

ocaml/xapi-idl/storage/storage_skeleton.ml

@@ -114,6 +114,8 @@ module VDI = struct
 
   let activate3 ctx ~dbg ~dp ~sr ~vdi ~vm = u "VDI.activate3"
 
+  let activate_readonly ctx ~dbg ~dp ~sr ~vdi ~vm = u "VDI.activate_readonly"
+
   let deactivate ctx ~dbg ~dp ~sr ~vdi ~vm = u "VDI.deactivate"
 
   let detach ctx ~dbg ~dp ~sr ~vdi ~vm = u "VDI.detach"

ocaml/xapi-storage-script/main.ml

@@ -1311,7 +1311,7 @@ let bind ~volume_script_dir =
     |> wrap
   in
   S.VDI.attach3 vdi_attach3_impl ;
-  let vdi_activate3_impl dbg _dp sr vdi' vm' =
+  let vdi_activate_common dbg sr vdi' vm' readonly =
     (let vdi = Storage_interface.Vdi.string_of vdi' in
      let domain = Storage_interface.Vm.string_of vm' in
      Attached_SRs.find sr >>>= fun sr ->
@@ -1329,11 +1329,23 @@ let bind ~volume_script_dir =
      )
      >>>= fun response ->
      choose_datapath domain response >>>= fun (rpc, _datapath, uri, domain) ->
-     return_data_rpc (fun () -> Datapath_client.activate rpc dbg uri domain)
+     return_data_rpc (fun () ->
+         if readonly then
+           Datapath_client.activate_readonly rpc dbg uri domain
+         else
+           Datapath_client.activate rpc dbg uri domain
+     )
     )
     |> wrap
   in
+  let vdi_activate3_impl dbg _dp sr vdi' vm' =
+    vdi_activate_common dbg sr vdi' vm' false
+  in
   S.VDI.activate3 vdi_activate3_impl ;
+  let vdi_activate_readonly_impl dbg _dp sr vdi' vm' =
+    vdi_activate_common dbg sr vdi' vm' true
+  in
+  S.VDI.activate_readonly vdi_activate_readonly_impl ;
   let vdi_deactivate_impl dbg _dp sr vdi' vm' =
     (let vdi = Storage_interface.Vdi.string_of vdi' in
      let domain = Storage_interface.Vm.string_of vm' in

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

@@ -124,7 +124,7 @@ module Datapath (R : RPC) = struct
       ; "activated readonly multiple times, including on multiple independent "
       ; "hosts. It is not permitted for a volume to be activated both readonly "
       ; "and read-write concurrently. Implementations shall declare the "
-      ; "VDI_ATTACH_READONLY feature for this method to be supported. Once a "
+      ; "VDI_ACTIVATE_READONLY feature for this method to be supported. Once a "
       ; "volume is activated readonly it is required that all readonly "
       ; "activations are deactivated before any read-write activation is "
       ; "attempted. This function is idempotent and in all other respects "

ocaml/xapi/smint.ml

@@ -44,6 +44,7 @@ type capability =
   | Vdi_snapshot
   | Vdi_resize
   | Vdi_activate
+  | Vdi_activate_readonly
   | Vdi_deactivate
   | Vdi_update
   | Vdi_introduce
@@ -82,6 +83,7 @@ let string_to_capability_table =
   ; ("VDI_CLONE", Vdi_clone)
   ; ("VDI_SNAPSHOT", Vdi_snapshot)
   ; ("VDI_ACTIVATE", Vdi_activate)
+  ; ("VDI_ACTIVATE_READONLY", Vdi_activate_readonly)
   ; ("VDI_DEACTIVATE", Vdi_deactivate)
   ; ("VDI_UPDATE", Vdi_update)
   ; ("VDI_INTRODUCE", Vdi_introduce)

ocaml/xapi/storage_mux.ml

@@ -34,6 +34,7 @@ type plugin = {
     processor: processor
   ; backend_domain: string
   ; query_result: query_result
+  ; features: Smint.feature list
 }
 
 let plugins : (sr, plugin) Hashtbl.t = Hashtbl.create 10
@@ -48,8 +49,16 @@ let debug_printer rpc call =
 
 let register sr rpc d info =
   with_lock m (fun () ->
+      let features =
+        Smint.parse_capability_int64_features info.Storage_interface.features
+      in
       Hashtbl.replace plugins sr
-        {processor= debug_printer rpc; backend_domain= d; query_result= info} ;
+        {
+          processor= debug_printer rpc
+        ; backend_domain= d
+        ; query_result= info
+        ; features
+        } ;
       debug "register SR %s (currently-registered = [ %s ])" (s_of_sr sr)
         (String.concat ", "
            (Hashtbl.fold (fun sr _ acc -> s_of_sr sr :: acc) plugins [])
@@ -69,6 +78,13 @@ let query_result_of_sr sr =
   try with_lock m (fun () -> Some (Hashtbl.find plugins sr).query_result)
   with _ -> None
 
+let sr_has_capability sr capability =
+  try
+    with_lock m (fun () ->
+        Smint.has_capability capability (Hashtbl.find plugins sr).features
+    )
+  with _ -> false
+
 (* This is the policy: *)
 let of_sr sr =
   with_lock m (fun () ->
@@ -156,7 +172,8 @@ module Mux = struct
   end
 
   module DP_info = struct
-    type t = {sr: Sr.t; vdi: Vdi.t; vm: Vm.t} [@@deriving rpcty]
+    type t = {sr: Sr.t; vdi: Vdi.t; vm: Vm.t; read_write: bool [@default true]}
+    [@@deriving rpcty]
 
     let storage_dp_path = "/var/run/nonpersistent/xapi/storage-dps"
 
@@ -496,7 +513,7 @@ module Mux = struct
         let rpc = of_sr sr
       end)) in
       let vm = Vm.of_string "0" in
-      DP_info.write dp DP_info.{sr; vdi; vm} ;
+      DP_info.write dp DP_info.{sr; vdi; vm; read_write} ;
       let backend = C.VDI.attach3 dbg dp sr vdi vm read_write in
       (* VDI.attach2 should be used instead, VDI.attach is only kept for
          backwards-compatibility, because older xapis call Remote.VDI.attach during SXM.
@@ -543,7 +560,7 @@ module Mux = struct
         let rpc = of_sr sr
       end)) in
       let vm = Vm.of_string "0" in
-      DP_info.write dp DP_info.{sr; vdi; vm} ;
+      DP_info.write dp DP_info.{sr; vdi; vm; read_write} ;
       C.VDI.attach3 dbg dp sr vdi vm read_write
 
     let attach3 () ~dbg ~dp ~sr ~vdi ~vm ~read_write =
@@ -552,7 +569,7 @@ module Mux = struct
       let module C = StorageAPI (Idl.Exn.GenClient (struct
         let rpc = of_sr sr
       end)) in
-      DP_info.write dp DP_info.{sr; vdi; vm} ;
+      DP_info.write dp DP_info.{sr; vdi; vm; read_write} ;
       C.VDI.attach3 dbg dp sr vdi vm read_write
 
     let activate () ~dbg ~dp ~sr ~vdi =
@@ -569,7 +586,30 @@ module Mux = struct
       let module C = StorageAPI (Idl.Exn.GenClient (struct
         let rpc = of_sr sr
       end)) in
-      C.VDI.activate3 dbg dp sr vdi vm
+      let read_write =
+        let open DP_info in
+        match read dp with
+        | Some x ->
+            x.read_write
+        | None ->
+            failwith "DP not found"
+      in
+      if (not read_write) && sr_has_capability sr Smint.Vdi_activate_readonly
+      then (
+        info "The VDI was attached read-only: calling activate_readonly" ;
+        C.VDI.activate_readonly dbg dp sr vdi vm
+      ) else (
+        info "The VDI was attached read/write: calling activate3" ;
+        C.VDI.activate3 dbg dp sr vdi vm
+      )
+
+    let activate_readonly () ~dbg ~dp ~sr ~vdi ~vm =
+      info "VDI.activate_readonly dbg:%s dp:%s sr:%s vdi:%s vm:%s" dbg dp
+        (s_of_sr sr) (s_of_vdi vdi) (s_of_vm vm) ;
+      let module C = StorageAPI (Idl.Exn.GenClient (struct
+        let rpc = of_sr sr
+      end)) in
+      C.VDI.activate_readonly dbg dp sr vdi vm
 
     let deactivate () ~dbg ~dp ~sr ~vdi ~vm =
       info "VDI.deactivate dbg:%s dp:%s sr:%s vdi:%s vm:%s" dbg dp (s_of_sr sr)

ocaml/xapi/storage_smapiv1.ml

@@ -587,6 +587,8 @@ module SMAPIv1 : Server_impl = struct
     let activate3 context ~dbg ~dp ~sr ~vdi ~vm:_ =
       activate context ~dbg ~dp ~sr ~vdi
 
+    let activate_readonly = activate3
+
     let deactivate _context ~dbg ~dp ~sr ~vdi ~vm:_ =
       try
         for_vdi ~dbg ~sr ~vdi "VDI.deactivate"

ocaml/xapi/storage_smapiv1_wrapper.ml

@@ -674,6 +674,8 @@ functor
             )
         )
 
+      let activate_readonly = activate3
+
       let activate context ~dbg ~dp ~sr ~vdi =
         info "VDI.activate dbg:%s dp:%s sr:%s vdi:%s " dbg dp (s_of_sr sr)
           (s_of_vdi vdi) ;