From 89a1d30154bc8887bd183184a335d535294c07e6 Mon Sep 17 00:00:00 2001
From: Hannes Mehnert <hannes@mehnert.org>
Date: Sun, 11 Nov 2018 02:33:00 +0100
Subject: [PATCH] cleanups in respect to directories and scope

---
 app/vmmd_console.ml |  4 ++--
 src/vmm_core.ml     | 16 +++++-----------
 src/vmm_core.mli    |  5 -----
 src/vmm_unix.ml     | 13 ++++++++++---
 4 files changed, 17 insertions(+), 21 deletions(-)

diff --git a/app/vmmd_console.ml b/app/vmmd_console.ml
index 5fa4252..5962289 100644
--- a/app/vmmd_console.ml
+++ b/app/vmmd_console.ml
@@ -51,7 +51,7 @@ let read_console id name ring channel () =
        Lwt_io.close channel)
 
 let open_fifo name =
-  let fifo = Fpath.(Vmm_core.tmpdir / "fifo" / name) in
+  let fifo = Vmm_core.Name.fifo_file name in
   Lwt.catch (fun () ->
       Logs.debug (fun m -> m "opening %a for reading" Fpath.pp fifo) ;
       Lwt_io.open_file ~mode:Lwt_io.Input (Fpath.to_string fifo) >>= fun channel ->
@@ -68,7 +68,7 @@ let t = ref String.Map.empty
 
 let add_fifo id =
   let name = Vmm_core.Name.to_string id in
-  open_fifo name >|= function
+  open_fifo id >|= function
   | Some f ->
     let ring = Vmm_ring.create "" () in
     Logs.debug (fun m -> m "inserting fifo %s" name) ;
diff --git a/src/vmm_core.ml b/src/vmm_core.ml
index 58331d5..9002d2a 100644
--- a/src/vmm_core.ml
+++ b/src/vmm_core.ml
@@ -5,18 +5,16 @@ open Astring
 open Rresult.R.Infix
 
 let tmpdir = Fpath.(v "/var" / "run" / "albatross")
-let dbdir = Fpath.(v "/var" / "db" / "albatross")
-let blockdir = Fpath.(dbdir / "block")
+let sockdir = Fpath.(tmpdir / "util")
 
 type service = [ `Console | `Log | `Stats | `Vmmd ]
 
 let socket_path t =
-  let path name = Fpath.(tmpdir / "util" / name + "sock") in
   let path = match t with
-    | `Console -> path "console"
+    | `Console -> Fpath.(sockdir / "console" + "sock")
     | `Vmmd -> Fpath.(tmpdir / "vmmd" + "sock")
-    | `Stats -> path "stat"
-    | `Log -> path "log"
+    | `Stats -> Fpath.(sockdir / "stat" + "sock")
+    | `Log -> Fpath.(sockdir / "log" + "sock")
   in
   Fpath.to_string path
 
@@ -90,10 +88,6 @@ module Name = struct
     let file = to_string name in
     Fpath.(tmpdir / "fifo" / file)
 
-  let block_file name =
-    let file = to_string name in
-    Fpath.(blockdir / file)
-
   let block_name vm_name dev =
     List.rev (dev :: List.rev (domain vm_name))
 
@@ -122,7 +116,7 @@ module Name = struct
     match drop_super ~super ~sub with None -> false | Some _ -> true
 
   let pp ppf ids =
-    Fmt.(pf ppf "(%d)%a" (List.length ids) (list ~sep:(unit ".") string) ids)
+    Fmt.(pf ppf "[name %a]" (list ~sep:(unit ".") string) ids)
 end
 
 let pp_is ppf is = Fmt.pf ppf "%a" Fmt.(list ~sep:(unit ",") int) (IS.elements is)
diff --git a/src/vmm_core.mli b/src/vmm_core.mli
index f3fb057..1b5b72c 100644
--- a/src/vmm_core.mli
+++ b/src/vmm_core.mli
@@ -1,9 +1,5 @@
 (* (c) 2018 Hannes Mehnert, all rights reserved *)
 
-val tmpdir : Fpath.t
-val dbdir : Fpath.t
-val blockdir : Fpath.t
-
 type service = [ `Console | `Log | `Stats | `Vmmd ]
 
 val socket_path : service -> string
@@ -27,7 +23,6 @@ module Name : sig
 
   val image_file : t -> Fpath.t
   val fifo_file : t -> Fpath.t
-  val block_file : t -> Fpath.t
 
   val of_list : string list -> (t, [> `Msg of string ]) result
   val to_list : t -> string list
diff --git a/src/vmm_unix.ml b/src/vmm_unix.ml
index 754fcbc..f1edc79 100644
--- a/src/vmm_unix.ml
+++ b/src/vmm_unix.ml
@@ -53,6 +53,13 @@ let close_no_err fd = try close fd with _ -> ()
 
 open Vmm_core
 
+let dbdir = Fpath.(v "/var" / "db" / "albatross")
+let blockdir = Fpath.(dbdir / "block")
+
+let block_file name =
+  let file = Name.to_string name in
+  Fpath.(blockdir / file)
+
 let rec mkfifo name =
   try Unix.mkfifo (Fpath.to_string name) 0o640 with
   | Unix.Unix_error (Unix.EINTR, _, _) -> mkfifo name
@@ -149,7 +156,7 @@ let exec name vm taps block =
    | [_], Some _ -> Ok "block-net"
    | _, _ -> Error (`Msg "cannot handle multiple network interfaces")) >>= fun bin ->
   let net = List.map (fun t -> "--net=" ^ t) taps
-  and block = match block with None -> [] | Some dev -> [ "--disk=" ^ Fpath.to_string (Name.block_file dev) ]
+  and block = match block with None -> [] | Some dev -> [ "--disk=" ^ Fpath.to_string (block_file dev) ]
   and argv = match vm.argv with None -> [] | Some xs -> xs
   and mem = "--mem=" ^ string_of_int vm.requested_memory
   in
@@ -188,7 +195,7 @@ let bytes_of_mb size =
     Error (`Msg "overflow while computing bytes")
 
 let create_block name size =
-  let block_name = Name.block_file name in
+  let block_name = block_file name in
   Bos.OS.File.exists block_name >>= function
   | true -> Error (`Msg "file already exists")
   | false ->
@@ -196,7 +203,7 @@ let create_block name size =
     Bos.OS.File.truncate block_name size'
 
 let destroy_block name =
-  Bos.OS.File.delete (Name.block_file name)
+  Bos.OS.File.delete (block_file name)
 
 let mb_of_bytes size =
   if size = 0 || size land 0xFFFFF <> 0 then