From b9d5fa94f9ee29713ed336964edd8bf7c22c7b03 Mon Sep 17 00:00:00 2001
From: Hannes Mehnert <hannes@mehnert.org>
Date: Thu, 22 Mar 2018 00:41:41 +0100
Subject: [PATCH] call waitpid() earlier, separate freebsd kludge (chmod g+rw),
 fixes #9

---
 app/vmmd.ml          |  3 ++-
 src/vmm_commands.ml  | 18 ++++++++++--------
 src/vmm_commands.mli |  2 ++
 3 files changed, 14 insertions(+), 9 deletions(-)

diff --git a/app/vmmd.ml b/app/vmmd.ml
index 3c07261..d5a70ea 100644
--- a/app/vmmd.ml
+++ b/app/vmmd.ml
@@ -58,12 +58,13 @@ let handle ca state t =
        (match cont !state t with
         | Ok (state', outs, vm) ->
           state := state' ;
-          process state outs >>= fun () ->
           Lwt.async (fun () ->
               Vmm_lwt.wait_and_clear vm.Vmm_core.pid vm.Vmm_core.stdout >>= fun r ->
               let state', outs = Vmm_engine.handle_shutdown !state vm r in
               state := state' ;
               process state outs) ;
+          process state outs >>= fun () ->
+          let _ = Vmm_commands.setup_freebsd_kludge vm.Vmm_core.pid in
           Lwt.return_unit
         | Error (`Msg e) ->
           Logs.err (fun m -> m "error while cont %s" e) ;
diff --git a/src/vmm_commands.ml b/src/vmm_commands.ml
index d036c4e..7830e0a 100644
--- a/src/vmm_commands.ml
+++ b/src/vmm_commands.ml
@@ -186,14 +186,6 @@ let exec dir vm tmpfile taps =
     Logs.debug (fun m -> m "creating process");
     let pid = create_process prog line stdout stdout in
     Logs.debug (fun m -> m "created process %d: %a" pid Bos.Cmd.pp cmd) ;
-    (* on FreeBSD we need to chmod g+rw /dev/vmm/ukvm$pid to run
-       bhyvectl --get-stats --vm=ukvm$pid as non-priviliged user *)
-    (Lazy.force (uname ()) >>= fun (sys, _) ->
-     match sys with
-     | x when x = "FreeBSD" ->
-       let dev = "/dev/vmm/ukvm" ^ string_of_int pid in
-       Bos.OS.Cmd.run Bos.Cmd.(v "chmod" % "g+rw" % dev)
-     | _ -> Ok ()) >>= fun () ->
     (* this should get rid of the vmimage from vmmd's memory! *)
     let config = { vm with vmimage = (fst vm.vmimage, Cstruct.create 0) } in
     Ok { config ; cmd ; pid ; taps ; stdout ; tmpfile }
@@ -203,3 +195,13 @@ let exec dir vm tmpfile taps =
     R.error_msgf "cmd %a exits: %a" Bos.Cmd.pp cmd pp_unix_error e
 
 let destroy vm = Unix.kill vm.pid 15 (* 15 is SIGTERM *)
+
+let setup_freebsd_kludge pid =
+  (* on FreeBSD we need to chmod g+rw /dev/vmm/ukvm$pid to run
+     bhyvectl --get-stats --vm=ukvm$pid as non-priviliged user *)
+  Lazy.force (uname ()) >>= fun (sys, _) ->
+  match sys with
+  | x when x = "FreeBSD" ->
+    let dev = "/dev/vmm/ukvm" ^ string_of_int pid in
+    Bos.OS.Cmd.run Bos.Cmd.(v "chmod" % "g+rw" % dev)
+  | _ -> Ok ()
diff --git a/src/vmm_commands.mli b/src/vmm_commands.mli
index ca1c80e..efe885d 100644
--- a/src/vmm_commands.mli
+++ b/src/vmm_commands.mli
@@ -17,3 +17,5 @@ val close_no_err : Unix.file_descr -> unit
 val create_tap : string -> (string, [> R.msg ]) result
 
 val create_bridge : string -> (unit, [> R.msg ]) result
+
+val setup_freebsd_kludge : int -> (unit, [> R.msg ]) result