From e58ab236b74e73f3717cb6f997fc59e8af9f44a1 Mon Sep 17 00:00:00 2001
From: Hannes Mehnert <hannes@mehnert.org>
Date: Sun, 20 Jan 2019 22:01:52 +0100
Subject: [PATCH] vmmd: lock self_destruct with a mutex, respect result of
 killall (nothing killed, nothing to do)

---
 app/vmmd.ml      | 17 ++++++++++-------
 src/vmm_vmmd.ml  |  7 ++++---
 src/vmm_vmmd.mli |  2 +-
 3 files changed, 15 insertions(+), 11 deletions(-)

diff --git a/app/vmmd.ml b/app/vmmd.ml
index b756504..ee2d10d 100644
--- a/app/vmmd.ml
+++ b/app/vmmd.ml
@@ -154,14 +154,17 @@ let jump _ =
      (create_mbox `Log >|= function
        | None -> invalid_arg "cannot connect to log socket"
        | Some l -> l) >>= fun (l, l_fd, l_mut) ->
+     let self_destruct_mutex = Lwt_mutex.create () in
      let self_destruct () =
-       Vmm_vmmd.kill !state ;
-       (* not too happy about the sleep here, but cleaning up resources is
-          really important (fifos, vm images, tap devices) - which is done in
-          asynchronous (waiter tasks)
-       *)
-       Lwt_unix.sleep 1. >>= fun () ->
-       Vmm_lwt.safe_close ss
+       Lwt_mutex.with_lock self_destruct_mutex (fun () ->
+           (if Vmm_vmmd.killall !state then
+              (* not too happy about the sleep here, but cleaning up resources
+                 is really important (fifos, vm images, tap devices) - which is
+                 done asynchronously (in the task waitpid() on the pid) *)
+              Lwt_unix.sleep 1.
+            else
+              Lwt.return_unit) >>= fun () ->
+           Vmm_lwt.safe_close ss)
      in
      Sys.(set_signal sigterm (Signal_handle (fun _ -> Lwt.async self_destruct)));
      (create_mbox `Console >|= function
diff --git a/src/vmm_vmmd.ml b/src/vmm_vmmd.ml
index 07c335c..542117e 100644
--- a/src/vmm_vmmd.ml
+++ b/src/vmm_vmmd.ml
@@ -16,9 +16,10 @@ type 'a t = {
   waiters : 'a String.Map.t ;
 }
 
-let kill t =
-  List.iter Vmm_unix.destroy
-    (List.map snd (Vmm_trie.all t.resources.Vmm_resources.unikernels))
+let killall t =
+  match List.map snd (Vmm_trie.all t.resources.Vmm_resources.unikernels) with
+  | [] -> false
+  | vms -> List.iter Vmm_unix.destroy vms ; true
 
 let waiter t id =
   let name = Name.to_string id in
diff --git a/src/vmm_vmmd.mli b/src/vmm_vmmd.mli
index 67b07e9..b5a9cca 100644
--- a/src/vmm_vmmd.mli
+++ b/src/vmm_vmmd.mli
@@ -31,4 +31,4 @@ val handle_command : 'a t -> Vmm_commands.wire ->
                                       [ `Create of 'a t -> ('a t * out list * Name.t * Unikernel.t, [> Rresult.R.msg ]) result
                                       | `End ]) ]
 
-val kill : 'a t -> unit
+val killall : 'a t -> bool