CP-53555: Split unplug atomic into deactivate/detach

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

Author: snwoods

ocaml/xenopsd/lib/storage.ml

@@ -84,6 +84,9 @@ let deactivate task dp sr vdi vmdomid =
     (Printf.sprintf "VDI.deactivate %s" dp)
     (transform_exception (fun () -> Client.VDI.deactivate dbg dp sr vdi vmdomid))
 
+(* TODO replace DP.destroy with something that just detaches? *)
+(* This should work for now as, based on current usage of deactivate above during migrate,
+    DP.destroy must have an idempotent deactivate, so can be safely used just for its detach *)
 let dp_destroy task dp =
   Xenops_task.with_subtask task
     (Printf.sprintf "DP.destroy %s" dp)

ocaml/xenopsd/lib/xenops_server.ml

@@ -130,6 +130,8 @@ type atomic =
   | VBD_epoch_end of (Vbd.id * disk)
   | VBD_set_qos of Vbd.id
   | VBD_unplug of Vbd.id * bool
+  | VBD_deactivate of Vbd.id * bool
+  | VBD_detach of Vbd.id
   | VBD_insert of Vbd.id * disk
   | VBD_set_active of Vbd.id * bool
   | VM_remove of Vm.id
@@ -211,6 +213,10 @@ let rec name_of_atomic = function
       "VBD_set_qos"
   | VBD_unplug _ ->
       "VBD_unplug"
+  | VBD_deactivate _ ->
+      "VBD_deactivate"
+  | VBD_detach _ ->
+      "VBD_detach"
   | VBD_insert _ ->
       "VBD_insert"
   | VBD_set_active _ ->
@@ -1600,6 +1606,14 @@ let split_plug_atomic id vbd_id =
     serial_of "VBD.attach_and_activate" ~id (VBD_attach vbd_id)
       (VBD_activate vbd_id) []
 
+let split_unplug_atomic id vbd_id force =
+  if !xenopsd_vbd_plug_unplug_legacy then
+    VBD_unplug (vbd_id, force)
+  else
+    serial_of "VBD.deactivate_and_detach" ~id
+      (VBD_deactivate (vbd_id, force))
+      (VBD_detach 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
@@ -1688,7 +1702,7 @@ let rec atomics_of_operation = function
         ]
       ; parallel_concat "Devices.unplug" ~id
           [
-            List.map (fun vbd -> VBD_unplug (vbd.Vbd.id, true)) vbds
+            List.map (fun vbd -> split_unplug_atomic id vbd.Vbd.id true) vbds
           ; List.map (fun vif -> VIF_unplug (vif.Vif.id, true)) vifs
           ; List.map (fun pci -> PCI_unplug pci.Pci.id) pcis
           ]
@@ -1850,7 +1864,7 @@ let rec atomics_of_operation = function
   | VBD_hotplug 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)]
+      [split_unplug_atomic "VBD_hotunplug" id force; VBD_set_active (id, false)]
   | VIF_hotplug id ->
       [VIF_set_active (id, true); VIF_plug id]
   | VIF_hotunplug (id, force) ->
@@ -2065,7 +2079,18 @@ let rec perform_atomic ~progress_callback ?result (op : atomic)
   | VBD_unplug (id, force) ->
       debug "VBD.unplug %s" (VBD_DB.string_of_id id) ;
       finally
-        (fun () -> B.VBD.unplug t (VBD_DB.vm_of id) (VBD_DB.read_exn id) force)
+        (fun () ->
+          B.VBD.deactivate t (VBD_DB.vm_of id) (VBD_DB.read_exn id) force ;
+          B.VBD.detach t (VBD_DB.vm_of id) (VBD_DB.read_exn id)
+        )
+        (fun () -> VBD_DB.signal id)
+  | VBD_deactivate (id, force) ->
+      debug "VBD.deactivate %s" (VBD_DB.string_of_id id) ;
+      B.VBD.deactivate t (VBD_DB.vm_of id) (VBD_DB.read_exn id) force
+  | VBD_detach id ->
+      debug "VBD.detach %s" (VBD_DB.string_of_id id) ;
+      finally
+        (fun () -> B.VBD.detach t (VBD_DB.vm_of id) (VBD_DB.read_exn id))
         (fun () -> VBD_DB.signal id)
   | VBD_insert (id, disk) -> (
       (* NB this is also used to "refresh" ie signal a qemu that it should
@@ -2481,6 +2506,8 @@ and trigger_cleanup_after_failure_atom op t =
   | VBD_epoch_end (id, _)
   | VBD_set_qos id
   | VBD_unplug (id, _)
+  | VBD_deactivate (id, _)
+  | VBD_detach id
   | VBD_insert (id, _) ->
       immediate_operation dbg (fst id) (VBD_check_state id)
   | VIF_plug id

ocaml/xenopsd/lib/xenops_server_plugin.ml

@@ -211,7 +211,9 @@ module type S = sig
 
     val activate : Xenops_task.task_handle -> Vm.id -> Vbd.t -> unit
 
-    val unplug : Xenops_task.task_handle -> Vm.id -> Vbd.t -> bool -> unit
+    val deactivate : Xenops_task.task_handle -> Vm.id -> Vbd.t -> bool -> unit
+
+    val detach : Xenops_task.task_handle -> Vm.id -> Vbd.t -> unit
 
     val insert : Xenops_task.task_handle -> Vm.id -> Vbd.t -> disk -> unit
 

ocaml/xenopsd/lib/xenops_server_simulator.ml

@@ -677,7 +677,9 @@ module VBD = struct
 
   let activate _ (_vm : Vm.id) (_vbd : Vbd.t) = ()
 
-  let unplug _ vm vbd _ = with_lock m (remove_vbd vm vbd)
+  let deactivate _ vm vbd _ = with_lock m (remove_vbd vm vbd)
+
+  let detach _ _vm _vbd = ()
 
   let insert _ _vm _vbd _disk = ()
 

ocaml/xenopsd/lib/xenops_server_skeleton.ml

@@ -149,7 +149,9 @@ module VBD = struct
 
   let activate _ _ _ = unimplemented "VBD.activate"
 
-  let unplug _ _ _ _ = unimplemented "VBD.unplug"
+  let deactivate _ _ _ _ = unimplemented "VBD.deactivate"
+
+  let detach _ _ _ = unimplemented "VBD.detach"
 
   let insert _ _ _ _ = unimplemented "VBD.insert"
 

ocaml/xenopsd/xc/xenops_server_xen.ml

@@ -3889,23 +3889,23 @@ module VBD = struct
           )
           (fun () -> cleanup_attached_vdis vm vbd.id)
 
-  let unplug task vm vbd force =
-    with_tracing ~task ~name:"VBD_unplug" @@ fun () ->
+  let deactivate task vm vbd force =
+    with_tracing ~task ~name:"VBD_deactivate" @@ fun () ->
     with_xc_and_xs (fun xc xs ->
         try
           (* On destroying the datapath
 
-             1. if the device has already been shutdown and deactivated (as in
-             suspend) we must call DP.destroy here to avoid leaks
+              1. if the device has already been shutdown and deactivated (as in
+              suspend) we must call DP.destroy here to avoid leaks
 
-             2. if the device is successfully shutdown here then we must call
-             DP.destroy because no-one else will
+              2. if the device is successfully shutdown here then we must call
+              DP.destroy because no-one else will
 
-             3. if the device shutdown is rejected then we should leave the DP
-             alone and rely on the event thread calling us again later. *)
+              3. if the device shutdown is rejected then we should leave the DP
+              alone and rely on the event thread calling us again later. *)
           let domid = domid_of_uuid ~xs (uuid_of_string vm) in
           (* If the device is gone then we don't need to shut it down but we do
-             need to free any storage resources. *)
+              need to free any storage resources. *)
           let dev =
             try
               Some (device_by_id xc xs vm (device_kind_of ~xs vbd) (id_of vbd))
@@ -3943,8 +3943,9 @@ module VBD = struct
                   vm (id_of vbd) ;
               (* this happens on normal shutdown too *)
               (* Case (1): success; Case (2): success; Case (3): an exception is
-                 thrown *)
-              with_tracing ~task ~name:"VBD_device_shutdown" @@ fun () ->
+                  thrown *)
+              with_tracing ~task ~name:"VBD_deactivate_clean_shutdown"
+              @@ fun () ->
               Xenops_task.with_subtask task
                 (Printf.sprintf "Vbd.clean_shutdown %s" (id_of vbd))
                 (fun () ->
@@ -3954,10 +3955,10 @@ module VBD = struct
             )
             dev ;
           (* We now have a shutdown device but an active DP: we should destroy
-             the DP if the backend is of type VDI *)
+              the DP if the backend is of type VDI *)
           finally
             (fun () ->
-              ( with_tracing ~task ~name:"VBD_device_release" @@ fun () ->
+              ( with_tracing ~task ~name:"VBD_deactivate_release" @@ fun () ->
                 Option.iter
                   (fun dev ->
                     Xenops_task.with_subtask task
@@ -3967,7 +3968,7 @@ module VBD = struct
                   dev
               ) ;
               (* If we have a qemu frontend, detach this too. *)
-              with_tracing ~task ~name:"VBD_detach_qemu" @@ fun () ->
+              with_tracing ~task ~name:"VBD_deactivate_detach_qemu" @@ fun () ->
               let _ =
                 DB.update vm
                   (Option.map (fun vm_t ->
@@ -3998,11 +3999,14 @@ module VBD = struct
               ()
             )
             (fun () ->
-              with_tracing ~task ~name:"VBD_dp_destroy" @@ fun () ->
+              with_tracing ~task ~name:"VBD_deactivate_deactivate" @@ fun () ->
+              let vmid = Storage.vm_of_domid domid in
               match (domid, backend) with
-              | Some x, None | Some x, Some (VDI _) ->
-                  Storage.dp_destroy task
-                    (Storage.id_of (string_of_int x) vbd.Vbd.id)
+              | Some x, Some (VDI path) ->
+                  let sr, vdi = Storage.get_disk_by_name task path in
+                  let dp = Storage.id_of (string_of_int x) vbd.id in
+                  Storage.deactivate task dp sr vdi vmid
+              (* TODO Do we only need to deactivate VDIs, not Local or CD? *)
               | _ ->
                   ()
             )
@@ -4011,6 +4015,47 @@ module VBD = struct
           raise (Xenopsd_error (Device_detach_rejected ("VBD", id_of vbd, s)))
     )
 
+  let detach task vm vbd =
+    with_tracing ~task ~name:"VBD_detach" @@ fun () ->
+    with_xc_and_xs (fun xc xs ->
+        let domid = domid_of_uuid ~xs (uuid_of_string vm) in
+        let dev =
+          try
+            Some (device_by_id xc xs vm (device_kind_of ~xs vbd) (id_of vbd))
+          with
+          | Xenopsd_error (Does_not_exist (_, _)) ->
+              debug "VM = %s; VBD = %s; Ignoring missing domain" vm (id_of vbd) ;
+              None
+          | Xenopsd_error Device_not_connected ->
+              debug "VM = %s; VBD = %s; Ignoring missing device" vm (id_of vbd) ;
+              None
+        in
+        let backend =
+          match dev with
+          | None ->
+              None
+          | Some dv -> (
+            match
+              Rpcmarshal.unmarshal typ_of_backend
+                (Device.Generic.get_private_key ~xs dv _vdi_id
+                |> Jsonrpc.of_string
+                )
+            with
+            | Ok x ->
+                x
+            | Error (`Msg m) ->
+                internal_error "Failed to unmarshal VBD backend: %s" m
+          )
+        in
+        with_tracing ~task ~name:"VBD_detach_dp_destroy" @@ fun () ->
+        match (domid, backend) with
+        | Some x, None | Some x, Some (VDI _) ->
+            Storage.dp_destroy task (Storage.id_of (string_of_int x) vbd.Vbd.id)
+        | _ ->
+            ()
+    ) ;
+    cleanup_attached_vdis vm vbd.id
+
   let insert task vm vbd d =
     on_frontend
       (fun xc xs frontend_domid domain_type ->