Merge pull request #190 from robur-coop/root-policy

albatross_daemon: discover root policy and insert this

daemon/albatrossd.ml

@@ -168,9 +168,21 @@ let jump _ systemd influx tmpdir dbdir =
   (match Vmm_unix.check_commands () with
    | Error `Msg m -> invalid_arg m
    | Ok () -> ());
+  let root_policy =
+    match Vmm_unix.root_policy () with
+    | Error `Msg m -> invalid_arg m
+    | Ok p ->
+      Logs.app (fun m -> m "root policy: %a" Policy.pp p);
+      p
+  in
   match Vmm_vmmd.restore_state () with
   | Error (`Msg msg) -> Logs.err (fun m -> m "bailing out: %s" msg)
   | Ok (old_unikernels, policies) ->
+    let policies, old_p = Vmm_trie.insert Name.root root_policy policies in
+    Option.iter (fun p ->
+        if not (Policy.equal p root_policy) then
+          Logs.warn (fun m -> m "replacing stored root policy %a with discovered %a"
+                        Policy.pp p Policy.pp root_policy)) old_p;
     match Vmm_vmmd.restore_policies !state policies with
     | Error `Msg msg ->
       Logs.err (fun m -> m "policy restore error: %s" msg)

src/dune

@@ -14,4 +14,8 @@
  (wrapped false)
  (modules vmm_unix vmm_lwt vmm_vmmd)
  (libraries albatross ipaddr.unix bos solo5-elftool lwt lwt.unix ptime.clock.os
-   digestif))
+   digestif)
+ (foreign_stubs
+  (language c)
+  (names vmm_stubs)
+  (flags (:standard))))

src/vmm_stubs.c

@@ -0,0 +1,70 @@
+// (c) 2017, 2018 Hannes Mehnert, all rights reserved
+
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/memory.h>
+#include <caml/fail.h>
+#include <caml/unixsupport.h>
+
+#include <unistd.h>
+#include <errno.h>
+
+CAMLprim value vmm_cpu_count (value unit) {
+  CAMLparam1(unit);
+  int r;
+  r = (int)sysconf(_SC_NPROCESSORS_ONLN);
+  CAMLreturn(Val_int(r));
+}
+
+int to_mb (long a, long b) {
+  int r = 0;
+  if (a % (1024 * 1024) == 0)
+    r = (a / 1024 / 1024) * b;
+  else {
+    if (b % (1024 * 1024) == 0)
+      r = a * (b / 1024 / 1024);
+    else {
+      if (a % 1024 == 0) {
+        if (b % 1024 == 0)
+          r = (a / 1024) * (b / 1024);
+        else
+          r = (a / 1024) * b / 1024;
+      } else {
+        if (b % 1024 == 0)
+          r = a * (b / 1024) / 1024;
+        else
+          r = a * b / 1024 / 1024;
+      }
+    }
+  }
+  return r;
+}
+
+CAMLprim value vmm_memory (value unit) {
+  CAMLparam1(unit);
+  long pages = sysconf(_SC_PHYS_PAGES);
+  long page_size = sysconf(_SC_PAGE_SIZE);
+  CAMLreturn(Val_int(to_mb(pages, page_size)));
+}
+
+#ifdef __linux__
+#include <sys/vfs.h>
+#else
+#include <sys/param.h>
+#include <sys/mount.h>
+#endif
+
+CAMLprim value vmm_disk_space (value path) {
+  CAMLparam1(path);
+  struct statfs s;
+  const char *p = String_val(path);
+  if (statfs(p, &s) < 0)
+    uerror("statfs", Nothing);
+  int r = to_mb(s.f_blocks, s.f_bsize);
+  if (r < 0) {
+    errno = EOVERFLOW;
+    uerror("statfs", Nothing);
+  }
+  CAMLreturn(Val_int(to_mb(s.f_blocks, s.f_bsize)));
+}
+

src/vmm_unix.ml

@@ -488,3 +488,42 @@ let find_block_devices () =
         | Ok size, Ok id ->
           Ok ((id, size) :: acc))
     (Ok []) files
+
+external cpu_count : unit -> int = "vmm_cpu_count"
+
+external disk_space : string -> int = "vmm_disk_space"
+
+external memory : unit -> int = "vmm_memory"
+
+let find_bridges () =
+  match Lazy.force uname with
+  | FreeBSD ->
+    let cmd = Bos.Cmd.(v "ifconfig" % "-g" % "bridge") in
+    let* names = Bos.OS.Cmd.(run_out cmd |> out_lines |> success) in
+    Ok names
+  | Linux ->
+    let* bridges = Bos.(OS.Cmd.(run_out Cmd.(v "ip" % "-o" % "link" % "show" % "type" % "bridge") |> out_lines |> success)) in
+    (* output is <id>: <name>: ... *)
+    Ok (List.fold_left (fun acc s ->
+        match String.split_on_char ':' s with
+        | _id :: name :: _tl -> String.trim name :: acc
+        | _ -> Logs.err (fun m -> m "couldn't find bridge name in %s" s); acc)
+        [] bridges)
+
+let root_policy () =
+  try
+    let cpus = cpu_count () in
+    let disk_space = disk_space (Fpath.to_string (block_dir ())) in
+    let memory = memory () in
+    let* bridges = find_bridges () in
+    let rec gen_cpu acc n =
+      if n = 0 then acc else gen_cpu (Vmm_core.IS.add (pred n) acc) (pred n)
+    in
+    Ok { Vmm_core.Policy.vms = max_int ;
+         cpuids = gen_cpu Vmm_core.IS.empty cpus ;
+         memory ;
+         block = Some disk_space ;
+         bridges = String_set.of_list bridges }
+  with
+  | Unix.Unix_error (e, _, _) ->
+    Error (`Msg (Fmt.str "root policy failed: %a" pp_unix_err e))

src/vmm_unix.mli

@@ -43,3 +43,5 @@ val vm_device : Unikernel.t -> (string, [> `Msg of string ]) result
 val manifest_devices_match : bridges:(string * string option * Macaddr.t option) list ->
   block_devices:(string * string option * int option) list -> string ->
   (unit, [> `Msg of string]) result
+
+val root_policy : unit -> (Policy.t, [> `Msg of string ]) result