xenvmd/xenvm: Return the pid on shutdown API call

This allows xenvm to wait for the shutdown to complete.

Signed-off-by: Jon Ludlam <[email protected]>

Author: jonludlam

idl/xenvm_interface.ml

@@ -32,7 +32,10 @@ external flush : name:string -> unit = ""
 (** [flush lv] processes all pending allocations for this LV, such that
     future calls to [get_lv] will return accurate metadata. *)
 
-external shutdown : unit -> unit = ""
+(** [shutdown ()] will cause xenvmd to exit shortly after returning.
+    The returned value is the pid of the process to enable the caller
+    to wait until the process has actually exitted. *)
+external shutdown : unit -> int = ""
 
 type queue = {
   lv: string;

xenvm/xenvm.ml

@@ -124,10 +124,19 @@ let host_list copts (vg_name,_) =
   Lwt_main.run t
 
 let shutdown copts (vg_name,_) =
+  let is_alive pid =
+    try Unix.kill pid 0; true with _ -> false
+  in
+  let lwt_while guard body =
+    let rec inner () =
+      if guard () then body () >>= inner else Lwt.return ()
+    in inner ()
+  in
   let t =
     get_vg_info_t copts vg_name >>= fun info ->
     set_uri copts info;
-    Client.shutdown ()
+    Client.shutdown () >>= fun pid ->
+    lwt_while (fun () -> is_alive pid) (fun () -> Lwt_unix.sleep 1.0)
   in Lwt_main.run t
 
 let benchmark copts (vg_name,_) =

xenvmd/xenvmd.ml

@@ -661,7 +661,7 @@ module Impl = struct
       Lwt_unix.sleep 1.
       >>= fun () ->
       exit 0 in
-    return ()
+    return (Unix.getpid ())
 
   module Host = struct
     let create context ~name = VolumeManager.Host.create name