CP-40388: Add VDI.activate_readonly to the storage interface

This is a new call in the SMAPIv3. The easiest way to use it is to add a
similar call to the SMAPIv2 and switch case in the mux. This is done
only if the SR backend has advertised the new VDI_ACTIVATE_READONLY
feature.

The SMAPIv1 has the rw/ro mode associated with VDI.attach rather than
activate, so activate_readonly simply calls activate in the SMAPIv1
backend.

Signed-off-by: Rob Hoes <[email protected]>

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_mux.ml

@@ -586,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) ;