CA-413304: Restore VBD.unplug function to keep old functionality (xapi-project#6571)

This is a partial revert of 1a46f33. It retains the deactivate and
detach functions introduced but restores the original unplug function so
that the VBD_unplug atom is completely unchanged when
xenops_vbd_plug_unplug_legacy=true instead of running deactivate
followed by detach.

This will fix the S(Does_not_exist) Xenopsd errors we are seeing in some
VBD_unplug calls, until a fix for the split functions is found (I have
created CA-413304 to track that issue)

Author: BengangY

ocaml/xenopsd/lib/xenops_server.ml

@@ -2097,10 +2097,7 @@ 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.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 () -> 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) ;

ocaml/xenopsd/lib/xenops_server_plugin.ml

@@ -211,6 +211,8 @@ 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

ocaml/xenopsd/lib/xenops_server_simulator.ml

@@ -677,6 +677,8 @@ 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 = ()

ocaml/xenopsd/lib/xenops_server_skeleton.ml

@@ -148,6 +148,8 @@ module VBD = struct
 
   let activate _ _ _ = unimplemented __FUNCTION__
 
+  let unplug _ _ _ _ = unimplemented __FUNCTION__
+
   let deactivate _ _ _ _ = unimplemented __FUNCTION__
 
   let detach _ _ _ = unimplemented __FUNCTION__

ocaml/xenopsd/xc/xenops_server_xen.ml

@@ -3863,6 +3863,127 @@ module VBD = struct
           )
           (fun () -> cleanup_attached_vdis vm (id_of vbd))
 
+  let unplug task vm vbd force =
+    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_device_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_device_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_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_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)
+              | _ ->
+                  ()
+            )
+        with Device_common.Device_error (_, s) ->
+          debug "Caught Device_error: %s" s ;
+          raise (Xenopsd_error (Device_detach_rejected ("VBD", id_of vbd, s)))
+    )
+
   let deactivate task vm vbd force =
     with_xc_and_xs (fun xc xs ->
         try