CP-53555: Split unplug atomic into deactivate/detach

Signed-off-by: Steven Woods <steven.woods@cloud.com>

Author: snwoods

ocaml/xenopsd/lib/storage.ml

@@ -104,6 +104,37 @@ let deactivate task dp sr vdi vmdomid =
     (Printf.sprintf "VDI.deactivate %s" dp)
     (transform_exception (fun () -> Client.VDI.deactivate dbg dp sr vdi vmdomid))
 
+let detach task dp =
+  Xenops_task.with_subtask task
+    (* 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 *)
+    (Printf.sprintf "detach (dp_destroy) %s" dp)
+    (transform_exception (fun () ->
+         let dbg = get_dbg task in
+         let waiting_for_plugin = ref true in
+         while !waiting_for_plugin do
+           try
+             Client.DP.destroy dbg dp false ;
+             waiting_for_plugin := false
+           with
+           | Storage_interface.Storage_error (No_storage_plugin_for_sr _sr) as e
+             ->
+               (* Since we have an activated disk in this SR, assume we are
+                  still waiting for xapi to register the SR's plugin. *)
+               debug "Caught %s - waiting for xapi to register storage plugins."
+                 (Printexc.to_string e) ;
+               Thread.delay 5.0
+           | e ->
+               (* Backends aren't supposed to return exceptions on
+                  deactivate/detach, but they frequently do. Log and ignore *)
+               warn "Detach (dp_destroy) returned unexpected exception: %s"
+                 (Printexc.to_string e) ;
+               waiting_for_plugin := false
+         done
+     )
+    )
+
 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 _ ->
@@ -1609,6 +1615,13 @@ let split_plug_atomic id vbd_id =
     nonempty_serial_unpacked "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
+    nonempty_serial_unpacked "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
@@ -1697,7 +1710,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
           ]
@@ -1859,7 +1872,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) ->
@@ -2075,6 +2088,14 @@ let rec perform_atomic ~progress_callback ?result (op : atomic)
       finally
         (fun () -> B.VBD.unplug t (VBD_DB.vm_of id) (VBD_DB.read_exn id) force)
         (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
          re-open a device, useful for when a physical CDROM is inserted into the
@@ -2489,6 +2510,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

@@ -215,6 +215,10 @@ module type S = sig
 
     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
 
     val eject : Xenops_task.task_handle -> Vm.id -> Vbd.t -> unit

ocaml/xenopsd/lib/xenops_server_simulator.ml

@@ -681,6 +681,10 @@ module VBD = struct
 
   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 = ()
 
   let eject _ _vm _vbd = ()

ocaml/xenopsd/lib/xenops_server_skeleton.ml

@@ -153,6 +153,10 @@ module VBD = struct
 
   let unplug _ _ _ _ = unimplemented "VBD.unplug"
 
+  let deactivate _ _ _ _ = unimplemented "VBD.deactivate"
+
+  let detach _ _ _ = unimplemented "VBD.detach"
+
   let insert _ _ _ _ = unimplemented "VBD.insert"
 
   let eject _ _ _ = unimplemented "VBD.eject"

ocaml/xenopsd/xc/xenops_server_xen.ml

@@ -458,6 +458,8 @@ module Storage = struct
 
   let dp_destroy = dp_destroy
 
+  let detach = detach
+
   let get_disk_by_name = get_disk_by_name
 end
 
@@ -3659,6 +3661,8 @@ module VBD = struct
         let vm = fst vbd.id in
         Storage.activate ~xc ~xs task vm dp sr vdi
 
+  (* TODO could split out a _deactivate function here *)
+
   let frontend_domid_of_device device =
     device.Device_common.frontend.Device_common.domid
 
@@ -4227,6 +4231,175 @@ module VBD = struct
           raise (Xenopsd_error (Device_detach_rejected ("VBD", id_of vbd, s)))
     )
 
+  (* CP-53555: The deactivate half of VBD.unplug to allow them to be done separately *)
+  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
+
+              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. *)
+          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. *)
+          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
+          Option.iter
+            (fun dev ->
+              if force && not (Device.can_surprise_remove ~xs dev) then
+                debug
+                  "VM = %s; VBD = %s; Device is not surprise-removable \
+                   (ignoring and removing anyway)"
+                  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_deactivate_clean_shutdown"
+              @@ fun () ->
+              Xenops_task.with_subtask task
+                (Printf.sprintf "Vbd.clean_shutdown %s" (id_of vbd))
+                (fun () ->
+                  (if force then Device.hard_shutdown else Device.clean_shutdown)
+                    task ~xs dev
+                )
+            )
+            dev ;
+          (* We now have a shutdown device but an active DP: we should destroy
+              the DP if the backend is of type VDI *)
+          finally
+            (fun () ->
+              ( with_tracing ~task ~name:"VBD_deactivate_release" @@ fun () ->
+                Option.iter
+                  (fun dev ->
+                    Xenops_task.with_subtask task
+                      (Printf.sprintf "Vbd.release %s" (id_of vbd))
+                      (fun () -> Device.Vbd.release task ~xc ~xs dev)
+                  )
+                  dev
+              ) ;
+              (* If we have a qemu frontend, detach this too. *)
+              with_tracing ~task ~name:"VBD_deactivate_detach_qemu" @@ fun () ->
+              let _ =
+                DB.update vm
+                  (Option.map (fun vm_t ->
+                       let persistent = vm_t.VmExtra.persistent in
+                       if List.mem_assoc vbd.Vbd.id persistent.VmExtra.qemu_vbds
+                       then (
+                         let _, qemu_vbd =
+                           List.assoc vbd.Vbd.id persistent.VmExtra.qemu_vbds
+                         in
+                         (* destroy_vbd_frontend ignores 'refusing to close'
+                            transients' *)
+                         destroy_vbd_frontend ~xc ~xs task qemu_vbd ;
+                         VmExtra.
+                           {
+                             persistent=
+                               {
+                                 persistent with
+                                 qemu_vbds=
+                                   List.remove_assoc vbd.Vbd.id
+                                     persistent.qemu_vbds
+                               }
+                           }
+                       ) else
+                         vm_t
+                   )
+                  )
+              in
+              ()
+            )
+            (fun () ->
+              with_tracing ~task ~name:"VBD_deactivate_deactivate" @@ fun () ->
+              let vmid = Storage.vm_of_domid domid in
+              match (domid, backend) with
+              | 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? *)
+              | _ ->
+                  ()
+            )
+        with Device_common.Device_error (_, s) ->
+          debug "Caught Device_error: %s" s ;
+          raise (Xenopsd_error (Device_detach_rejected ("VBD", id_of vbd, s)))
+    )
+
+  (* CP-53555: The detach half of VBD.unplug to allow them to be done separately *)
+  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.detach 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 ->