CP-53554: Split plug atomic into attach/activate

Signed-off-by: Steven Woods <[email protected]>

Author: snwoods

ocaml/xenopsd/lib/storage.ml

@@ -77,6 +77,26 @@ let attach_and_activate ~task ~_vm ~vmdomid ~dp ~sr ~vdi ~read_write =
     (transform_exception (fun () -> Client.VDI.activate3 dbg dp sr vdi vmdomid)) ;
   result
 
+(* CP-53554: The attach half of attach_and_activate to allow them to be done separately *)
+let attach ~task ~_vm ~vmdomid ~dp ~sr ~vdi ~read_write =
+  let dbg = get_dbg task in
+  let result =
+    Xenops_task.with_subtask task
+      (Printf.sprintf "VDI.attach3 %s" dp)
+      (transform_exception (fun () ->
+           Client.VDI.attach3 dbg dp sr vdi vmdomid read_write
+       )
+      )
+  in
+  result
+
+(* CP-53554: The activate half of attach_and_activate to allow them to be done separately *)
+let activate ~task ~_vm ~vmdomid ~dp ~sr ~vdi =
+  let dbg = get_dbg task in
+  Xenops_task.with_subtask task
+    (Printf.sprintf "VDI.activate3 %s" dp)
+    (transform_exception (fun () -> Client.VDI.activate3 dbg dp sr vdi vmdomid))
+
 let deactivate task dp sr vdi vmdomid =
   debug "Deactivating disk %s %s" (Sr.string_of sr) (Vdi.string_of vdi) ;
   let dbg = get_dbg task in

ocaml/xenopsd/lib/xenops_server.ml

@@ -37,6 +37,8 @@ let finally = Xapi_stdext_pervasives.Pervasiveext.finally
 
 let domain_shutdown_ack_timeout = ref 60.
 
+let xenopsd_vbd_plug_unplug_legacy = ref true
+
 type context = {
     transferred_fd: Unix.file_descr option
         (** some API calls take a file descriptor argument *)
@@ -122,6 +124,8 @@ type atomic =
   | VM_hook_script_stable of (Vm.id * Xenops_hooks.script * string * Vm.id)
   | VM_hook_script of (Vm.id * Xenops_hooks.script * string)
   | VBD_plug of Vbd.id
+  | VBD_attach of Vbd.id
+  | VBD_activate of Vbd.id
   | VBD_epoch_begin of (Vbd.id * disk * bool)
   | VBD_epoch_end of (Vbd.id * disk)
   | VBD_set_qos of Vbd.id
@@ -195,6 +199,10 @@ let rec name_of_atomic = function
       "VM_hook_script"
   | VBD_plug _ ->
       "VBD_plug"
+  | VBD_attach _ ->
+      "VBD_attach"
+  | VBD_activate _ ->
+      "VBD_activate"
   | VBD_epoch_begin _ ->
       "VBD_epoch_begin"
   | VBD_epoch_end _ ->
@@ -1580,6 +1588,27 @@ let parallel_map name ~id lst f = parallel name ~id (List.concat_map f lst)
 
 let map_or_empty f x = Option.value ~default:[] (Option.map f x)
 
+(* Given a non-empty list, returns an Atomic rather than a single item list *)
+let nonempty_serial_unpacked name ~id lst =
+  match serial name ~id lst with
+  | [x] ->
+      x
+  | [] | _ :: _ ->
+      (* this should never happen *)
+      raise
+        (Xenopsd_error
+           (Internal_error
+              "serial with non-empty list should always return a length 1 list"
+           )
+        )
+
+let split_plug_atomic id vbd_id =
+  if !xenopsd_vbd_plug_unplug_legacy then
+    VBD_plug vbd_id
+  else
+    nonempty_serial_unpacked "VBD.attach_and_activate" ~id
+      [VBD_attach vbd_id; VBD_activate vbd_id]
+
 let rec atomics_of_operation = function
   | VM_start (id, force) ->
       let vbds_rw, vbds_ro = VBD_DB.vbds id |> vbd_plug_sets in
@@ -1604,7 +1633,7 @@ let rec atomics_of_operation = function
                     [VBD_epoch_begin (vbd.Vbd.id, x, vbd.Vbd.persistent)]
                   )
                   vbd.Vbd.backend
-              ; [VBD_plug vbd.Vbd.id]
+              ; [split_plug_atomic id vbd.Vbd.id]
               ]
         )
       in
@@ -1692,7 +1721,10 @@ let rec atomics_of_operation = function
         let name_one = pf "VBD.activate_and_plug %s" typ in
         parallel_map name_multi ~id vbds (fun vbd ->
             serial name_one ~id
-              [VBD_set_active (vbd.Vbd.id, true); VBD_plug vbd.Vbd.id]
+              [
+                VBD_set_active (vbd.Vbd.id, true)
+              ; split_plug_atomic id vbd.Vbd.id
+              ]
         )
       in
       [
@@ -1825,7 +1857,7 @@ let rec atomics_of_operation = function
       ]
       |> List.concat
   | VBD_hotplug id ->
-      [VBD_set_active (id, true); VBD_plug id]
+      [VBD_set_active (id, true); split_plug_atomic "VBD_hotplug" id]
   | VBD_hotunplug (id, force) ->
       [VBD_unplug (id, force); VBD_set_active (id, false)]
   | VIF_hotplug id ->
@@ -2019,6 +2051,11 @@ let rec perform_atomic ~progress_callback ?result (op : atomic)
       debug "VBD.plug %s" (VBD_DB.string_of_id id) ;
       B.VBD.plug t (VBD_DB.vm_of id) (VBD_DB.read_exn id) ;
       VBD_DB.signal id
+  | VBD_attach id ->
+      B.VBD.attach t (VBD_DB.vm_of id) (VBD_DB.read_exn id)
+  | VBD_activate id ->
+      B.VBD.activate t (VBD_DB.vm_of id) (VBD_DB.read_exn id) ;
+      VBD_DB.signal id
   | VBD_set_active (id, b) ->
       debug "VBD.set_active %s %b" (VBD_DB.string_of_id id) b ;
       B.VBD.set_active t (VBD_DB.vm_of id) (VBD_DB.read_exn id) b ;
@@ -2445,6 +2482,8 @@ and trigger_cleanup_after_failure_atom op t =
   match op with
   | VBD_eject id
   | VBD_plug id
+  | VBD_attach id
+  | VBD_activate id
   | VBD_set_active (id, _)
   | VBD_epoch_begin (id, _, _)
   | VBD_epoch_end (id, _)

ocaml/xenopsd/lib/xenops_server_plugin.ml

@@ -209,6 +209,10 @@ module type S = sig
 
     val plug : Xenops_task.task_handle -> Vm.id -> Vbd.t -> unit
 
+    val attach : Xenops_task.task_handle -> Vm.id -> Vbd.t -> unit
+
+    val activate : Xenops_task.task_handle -> Vm.id -> Vbd.t -> unit
+
     val unplug : Xenops_task.task_handle -> Vm.id -> Vbd.t -> bool -> unit
 
     val insert : Xenops_task.task_handle -> Vm.id -> Vbd.t -> disk -> unit

ocaml/xenopsd/lib/xenops_server_simulator.ml

@@ -675,6 +675,10 @@ module VBD = struct
 
   let plug _ (vm : Vm.id) (vbd : Vbd.t) = with_lock m (add_vbd vm vbd)
 
+  let attach _ (vm : Vm.id) (vbd : Vbd.t) = with_lock m (add_vbd vm vbd)
+
+  let activate _ (_vm : Vm.id) (_vbd : Vbd.t) = ()
+
   let unplug _ vm vbd _ = with_lock m (remove_vbd vm vbd)
 
   let insert _ _vm _vbd _disk = ()

ocaml/xenopsd/lib/xenops_server_skeleton.ml

@@ -147,6 +147,10 @@ module VBD = struct
 
   let plug _ _ _ = unimplemented "VBD.plug"
 
+  let attach _ _ _ = unimplemented "VBD.attach"
+
+  let activate _ _ _ = unimplemented "VBD.activate"
+
   let unplug _ _ _ _ = unimplemented "VBD.unplug"
 
   let insert _ _ _ _ = unimplemented "VBD.insert"

ocaml/xenopsd/lib/xenopsd.ml

@@ -283,6 +283,11 @@ let options =
     , (fun () -> string_of_int !test_open)
     , "TESTING only: open N file descriptors"
     )
+  ; ( "xenopsd-vbd-plug-unplug-legacy"
+    , Arg.Bool (fun x -> Xenops_server.xenopsd_vbd_plug_unplug_legacy := x)
+    , (fun () -> string_of_bool !Xenops_server.xenopsd_vbd_plug_unplug_legacy)
+    , "False if we want to split the plug atomic into attach/activate"
+    )
   ]
 
 let path () = Filename.concat !sockets_path "xenopsd"