Reword bridge detection error message

ip tuntap show lists all tuntap devices and ignores the rest of the
arguments, annoyingly. It will always return with exit code 0.

We do not detect if the interface is a bridge.

.cirrus.yml

@@ -5,7 +5,9 @@ freebsd_task:
   env:
     matrix:
       - OCAML_VERSION: 4.08.1
-      - OCAML_VERSION: 4.09.0
+      - OCAML_VERSION: 4.09.1
+      - OCAML_VERSION: 4.10.1
+      - OCAML_VERSION: 4.11.1
   pkg_install_script: pkg install -y ocaml-opam gmp gmake pkgconf bash
   ocaml_script: opam init -a --comp=$OCAML_VERSION
   dependencies_script: eval `opam env` && opam install -y --deps-only .

.travis.yml

@@ -7,11 +7,12 @@ services:
 env:
   global:
     - PACKAGE="albatross"
-    - DISTRO=ubuntu
+    - DISTRO=ubuntu-lts
     - TESTS=false
   matrix:
     - OCAML_VERSION=4.08
     - OCAML_VERSION=4.09
     - OCAML_VERSION=4.10
+    - OCAML_VERSION=4.11
 notifications:
   email: false

albatross.opam

@@ -9,6 +9,8 @@ license: "ISC"
 depends: [
   "ocaml" {>= "4.08.0"}
   "dune"
+  "dune-configurator"
+  "conf-pkg-config" {build}
   "lwt" {>= "3.0.0"}
   "ipaddr" {>= "4.0.0"}
   "hex"
@@ -37,4 +39,8 @@ build: [
   ["dune" "subst"] {pinned}
   ["dune" "build" "-p" name "-j" jobs]
 ]
+depexts: [
+  ["libnl-3-dev" "libnl-route-3-dev"] {os-family = "debian"}
+  ["libnl3" "libnl3-devel"] {os-family = "centos"}
+]
 synopsis: "Albatross - orchestrate and manage MirageOS unikernels with Solo5"

command-line/albatross_cli.ml

@@ -102,7 +102,9 @@ let setup_log style_renderer level =
 
 let create_vm force image cpuid memory argv block_devices bridges compression restart_on_fail exit_codes =
   let open Rresult.R.Infix in
-  Bos.OS.File.read (Fpath.v image) >>| fun image ->
+  let img_file = Fpath.v image in
+  Bos.OS.File.read img_file >>= fun image ->
+  Vmm_unix.manifest_devices_match ~bridges ~block_devices img_file >>| fun () ->
   let image, compressed = match compression with
     | 0 -> Cstruct.of_string image, false
     | level ->
@@ -345,6 +347,13 @@ let retry_connections =
   let doc = "Number of retries when connecting to other daemons (log, console, stats etc). 0 aborts after one failure, -1 is unlimited retries." in
   Arg.(value & opt int 0 & info [ "retry-connections" ] ~doc)
 
+let systemd_socket_activation =
+  match Lazy.force Vmm_unix.uname with
+  | FreeBSD -> Term.const false
+  | Linux ->
+    let doc = "Pass this flag when systemd socket activation is being used" in
+    Arg.(value & flag & info [ "systemd-socket-activation" ] ~doc)
+
 let exit_status = function
   | Ok () -> Ok Success
   | Error e -> Ok e

daemon/albatross_console.ml

@@ -158,12 +158,12 @@ let handle s addr =
 
 let m = Vmm_core.conn_metrics "unix"
 
-let jump _ influx tmpdir =
+let jump _ systemd influx tmpdir =
   Sys.(set_signal sigpipe Signal_ignore) ;
   Albatross_cli.set_tmpdir tmpdir;
   Lwt_main.run
     (Albatross_cli.init_influx "albatross_console" influx;
-     Vmm_lwt.server_socket `Console >>= fun s ->
+     Vmm_lwt.server_socket ~systemd `Console >>= fun s ->
      let rec loop () =
        Lwt_unix.accept s >>= fun (cs, addr) ->
        m `Open;
@@ -177,7 +177,7 @@ open Cmdliner
 open Albatross_cli
 
 let cmd =
-  Term.(term_result (const jump $ setup_log $ influx $ tmpdir)),
+  Term.(term_result (const jump $ setup_log $ systemd_socket_activation $ influx $ tmpdir)),
   Term.info "albatross_console" ~version
 
 let () = match Term.eval cmd with `Ok () -> exit 0 | _ -> exit 1

daemon/albatross_log.ml

@@ -148,7 +148,7 @@ let handle mvar ring s addr =
 
 let m = Vmm_core.conn_metrics "unix"
 
-let jump _ file read_only influx tmpdir =
+let jump _ systemd file read_only influx tmpdir =
   Sys.(set_signal sigpipe Signal_ignore) ;
   Albatross_cli.set_tmpdir tmpdir;
   Lwt_main.run
@@ -161,7 +161,7 @@ let jump _ file read_only influx tmpdir =
        Lwt.return_unit
      end else begin
        Albatross_cli.init_influx "albatross_log" influx;
-       Vmm_lwt.server_socket `Log >>= fun s ->
+       Vmm_lwt.server_socket ~systemd `Log >>= fun s ->
        let ring = Vmm_ring.create `Startup () in
        List.iter (Vmm_ring.write ring) entries ;
        let mvar = Lwt_mvar.create_empty () in
@@ -192,7 +192,7 @@ let read_only =
   Arg.(value & flag & info [ "read-only" ] ~doc)
 
 let cmd =
-  Term.(const jump $ setup_log $ file $ read_only $ influx $ tmpdir),
+  Term.(const jump $ setup_log $ systemd_socket_activation $ file $ read_only $ influx $ tmpdir),
   Term.info "albatross_log" ~version
 
 let () = match Term.eval cmd with `Ok () -> exit 0 | _ -> exit 1

daemon/albatrossd.ml

@@ -135,7 +135,7 @@ let write_reply name fd txt (hdr, cmd) =
 
 let m = conn_metrics "unix"
 
-let jump _ influx tmpdir dbdir retries enable_stats =
+let jump _ systemd influx tmpdir dbdir retries enable_stats =
   Sys.(set_signal sigpipe Signal_ignore);
   Albatross_cli.set_tmpdir tmpdir;
   Albatross_cli.set_dbdir dbdir;
@@ -165,7 +165,7 @@ let jump _ influx tmpdir dbdir retries enable_stats =
         else
           Lwt.return_none) >>= fun s ->
        Lwt.catch
-         (fun () -> Vmm_lwt.server_socket `Vmmd)
+         (fun () -> Vmm_lwt.server_socket ~systemd `Vmmd)
          (fun e ->
             let str =
               Fmt.strf "unable to create server socket %a: %s"
@@ -218,7 +218,7 @@ let jump _ influx tmpdir dbdir retries enable_stats =
 open Cmdliner
 
 let cmd =
-  Term.(const jump $ setup_log $ influx $ tmpdir $ dbdir $ retry_connections $ enable_stats),
+  Term.(const jump $ setup_log $ systemd_socket_activation $ influx $ tmpdir $ dbdir $ retry_connections $ enable_stats),
   Term.info "albatrossd" ~version:Albatross_cli.version
 
 let () = match Term.eval cmd with `Ok () -> exit 0 | _ -> exit 1

packaging/Linux/README.md

@@ -1,6 +1,8 @@
 # systemd service scripts
 
 these are preliminary and just here to let people play with `solo5-spt`, the seccomp-enabled backend for [Solo5](https://github.com/Solo5/solo5) on Linux.
+Note: The socket paths are hardcoded relative to the RuntimeDirectory (tmpdir).
+If you modify `Vmm_core.socket_path` you must modify the corresponding `.socket` file(s) in this directory.
 
 1) You need to build the `albatross` tooling in this repository
 2) To run unikernels, you need to build and install solo5-elftool and at least one of the tenders: solo5-hvt and solo5-spt. They can be installed somewhere in PATH or in /var/lib/albatross/.

packaging/Linux/albatross_console.service

@@ -3,12 +3,13 @@
 # to create an override configuration:
 # systemctl edit albatross_console.service
 Description=Albatross console daemon (albatross_console)
+Requires=albatross_console.socket
 After=syslog.target
 
 [Service]
 Type=simple
 User=albatross
-ExecStart=/usr/local/sbin/albatross-console --tmpdir="%t/albatross/" -vv
+ExecStart=/usr/local/sbin/albatross-console --systemd-socket-activation --tmpdir="%t/albatross/" -vv
 RuntimeDirectoryPreserve=yes
 RuntimeDirectory=albatross
 ExecStartPre=/bin/mkdir -p %t/albatross/fifo
@@ -18,4 +19,5 @@ PIDFile=%t/albatross/console.pid
 RestrictAddressFamilies=AF_UNIX
 
 [Install]
+Also=albatross_console.socket
 WantedBy=multi-user.target

packaging/Linux/albatross_console.socket

@@ -0,0 +1,12 @@
+[Unit]
+Description=Albatross console socket
+PartOf=albatross_console.service
+
+[Socket]
+ListenStream=%t/albatross/util/console.sock
+SocketUser=albatross
+SocketMode=0600
+Accept=no
+
+[Install]
+WantedBy=sockets.target

packaging/Linux/albatross_daemon.service

@@ -1,6 +1,6 @@
 [Unit]
 Description=Albatross VMM daemon (albatrossd)
-Requires=albatross_console.service albatross_log.service
+Requires=albatross_console.socket albatross_log.socket albatross_daemon.socket
 After=syslog.target albatross_console.service albatross_log.service
 
 [Service]
@@ -8,7 +8,7 @@ Type=simple
 # TODO not necessarily needs to be run as root, anything that can solo5-spt/hvt,
 #  create tap interfaces should be fine!
 User=root
-ExecStart=/usr/local/sbin/albatrossd --tmpdir="%t/albatross/" -vv
+ExecStart=/usr/local/sbin/albatrossd --systemd-socket-activation --tmpdir="%t/albatross/" -vv
 #RuntimeDirectoryPreserve=yes
 #RuntimeDirectory=albatross
 PIDFile=%t/albatross/daemon.pid
@@ -27,4 +27,5 @@ IgnoreSIGPIPE=true
 #RuntimeDirectoryMode=0700
 
 [Install]
+Also=albatross_daemon.socket
 WantedBy=multi-user.target

packaging/Linux/albatross_daemon.socket

@@ -0,0 +1,11 @@
+[Unit]
+Description=Albatross daemon socket
+PartOf=albatross_daemon.service
+
+[Socket]
+ListenStream=%t/albatross/util/vmmd.sock
+SocketMode=0600
+Accept=no
+
+[Install]
+WantedBy=sockets.target

packaging/Linux/albatross_log.service

@@ -4,17 +4,18 @@
 # systemctl edit albatross_log.service
 Description=Albatross log daemon (albatross_log)
 After=syslog.target albatross_console.service
-Requires=albatross_console.service
+Requires=albatross_log.socket
+AssertPathExists=/var/lib/albatross/albatross.log
 
 [Service]
 Type=simple
 User=albatross
-AssertPathExists=/var/lib/albatross/albatross.log
+ExecStart=/usr/local/sbin/albatross-log --systemd-socket-activation --logfile="/var/lib/albatross/albatross.log" --tmpdir="%t/albatross/" -vv
-ExecStart=/usr/local/sbin/albatross-log --logfile="/var/lib/albatross/albatross.log" --tmpdir="%t/albatross/" -vv
 RuntimeDirectory=albatross albatross/util
 #RuntimeDirectoryPreserve=yes # avoid albatross.log being cleaned up
 PIDFile=%t/albatross/log.pid
 RestrictAddressFamilies=AF_UNIX
 
 [Install]
+Also=albatross_log.socket
 WantedBy=multi-user.target

packaging/Linux/albatross_log.socket

@@ -0,0 +1,12 @@
+[Unit]
+Description=Albatross log socket
+PartOf=albatross_log.service
+
+[Socket]
+ListenStream=%t/albatross/util/log.sock
+SocketUser=albatross
+SocketMode=0600
+Accept=no
+
+[Install]
+WantedBy=sockets.target

packaging/Linux/albatross_stats.service

@@ -3,16 +3,18 @@
 # to create an override configuration:
 # systemctl edit albatross_stat.service
 Description=Albatross stat daemon (albatross_stat)
+Requires=albatross_stat.socket
 After=syslog.target
 
 [Service]
 Type=simple
 User=albatross
-ExecStart=/usr/local/sbin/albatross-stats --tmpdir="%t/albatross/" -vv
+ExecStart=/usr/local/sbin/albatross-stats --systemd-socket-activation --tmpdir="%t/albatross/" -vv
 RuntimeDirectoryPreserve=yes
 RuntimeDirectory=albatross albatross/util
 PIDFile=%t/albatross/stat.pid
 RestrictAddressFamilies=AF_UNIX
 
 [Install]
+Also=albatross_stat.socket
 WantedBy=multi-user.target

packaging/Linux/albatross_stats.socket

@@ -0,0 +1,12 @@
+[Unit]
+Description=Albatross stats socket
+PartOf=albatross_stats.service
+
+[Socket]
+ListenStream=%t/albatross/util/stat.sock
+SocketUser=albatross
+SocketMode=0600
+Accept=no
+
+[Install]
+WantedBy=sockets.target

packaging/Linux/install.sh

@@ -5,7 +5,7 @@ sudo mkdir -m 0700 -p /var/lib/albatross/block
 sudo install -o "$ALBATROSS_USER" -- /dev/null /var/lib/albatross/albatross.log
 
 sudo cp ../../_build/install/default/bin/* /usr/local/sbin/
-sudo cp ./albatross_*.service  /etc/systemd/system/
+sudo cp ./albatross_*.service ./albatross_*.socket /etc/systemd/system/
 sudo systemctl daemon-reload
 sudo systemctl stop albatross_console
 sudo systemctl start albatross_console

src/vmm_commands.ml

@@ -141,12 +141,17 @@ type success = [
 let pp_block ppf (id, size, active) =
   Fmt.pf ppf "block %a size %d MB active %B" Name.pp id size active
 
+let my_fmt_list empty pp_elt ppf xs =
+  match xs with
+  | [] -> Fmt.string ppf empty
+  | _ -> Fmt.(list ~sep:(unit "@.") pp_elt ppf xs)
+
 let pp_success ppf = function
   | `Empty -> Fmt.string ppf "success"
   | `String data -> Fmt.pf ppf "success: %s" data
-  | `Policies ps -> Fmt.(list ~sep:(unit "@.") (pair ~sep:(unit ": ") Name.pp Policy.pp)) ppf ps
+  | `Policies ps -> my_fmt_list "no policies" Fmt.(pair ~sep:(unit ": ") Name.pp Policy.pp) ppf ps
-  | `Unikernels vms -> Fmt.(list ~sep:(unit "@.") (pair ~sep:(unit ": ") Name.pp Unikernel.pp_config)) ppf vms
+  | `Unikernels vms -> my_fmt_list "no unikernels" Fmt.(pair ~sep:(unit ": ") Name.pp Unikernel.pp_config) ppf vms
-  | `Block_devices blocks -> Fmt.(list ~sep:(unit "@.") pp_block) ppf blocks
+  | `Block_devices blocks -> my_fmt_list "no block devices" pp_block ppf blocks
 
 type res = [
   | `Command of t

src/vmm_core.ml

@@ -268,7 +268,7 @@ module Stats = struct
   }
 
   let pp_rusage ppf r =
-    Fmt.pf ppf "utime %Lu.%d stime %Lu.%d maxrss %Lu ixrss %Lu idrss %Lu isrss %Lu minflt %Lu majflt %Lu nswap %Lu inblock %Lu outblock %Lu msgsnd %Lu msgrcv %Lu signals %Lu nvcsw %Lu nivcsw %Lu"
+    Fmt.pf ppf "utime %Lu.%06d stime %Lu.%06d maxrss %Lu ixrss %Lu idrss %Lu isrss %Lu minflt %Lu majflt %Lu nswap %Lu inblock %Lu outblock %Lu msgsnd %Lu msgrcv %Lu signals %Lu nvcsw %Lu nivcsw %Lu"
       (fst r.utime) (snd r.utime) (fst r.stime) (snd r.stime) r.maxrss r.ixrss r.idrss r.isrss r.minflt r.majflt r.nswap r.inblock r.outblock r.msgsnd r.msgrcv r.nsignals r.nvcsw r.nivcsw
   let pp_rusage_mem ppf r =
     Fmt.pf ppf "maxrss %Lu ixrss %Lu idrss %Lu isrss %Lu minflt %Lu majflt %Lu"
@@ -286,7 +286,7 @@ module Stats = struct
   }
 
   let pp_kinfo_mem ppf t =
-    Fmt.pf ppf "virtual-size %Lu rss %Lu text-size %Lu data-size %Lu stack-size %Lu runtime %Lu cow %u start %Lu.%d"
+    Fmt.pf ppf "virtual-size %Lu rss %Lu text-size %Lu data-size %Lu stack-size %Lu runtime %Lu cow %u start %Lu.%06d"
       t.vsize t.rss t.tsize t.dsize t.ssize t.runtime t.cow (fst t.start) (snd t.start)
 
   type vmm = (string * int64) list

src/vmm_json.ml

@@ -16,6 +16,30 @@ let find_string_value k = function
     | Some (_, `String value) -> Ok value
     | _ -> Rresult.R.error_msgf "couldn't find %s in json dictionary" k
 
+let find_devices x =
+  let open Rresult in
+  let device dev =
+    find_string_value "name" dev >>= fun name ->
+    find_string_value "type" dev >>| fun typ ->
+    name, typ
+  in
+  match x with
+  | `Null | `Bool _ | `Float _ | `String _ | `A _ ->
+    Rresult.R.error_msg "couldn't find devices in json"
+  | `O dict ->
+    match List.find_opt (fun (key, _) -> String.equal key "devices") dict with
+    | Some (_, `A devices) ->
+      List.fold_left
+        (fun acc dev ->
+           acc >>= fun (block_devices, networks) ->
+           device dev >>= fun (name, typ) ->
+           match typ with
+           | "BLOCK_BASIC" -> Ok (name :: block_devices, networks)
+           | "NET_BASIC" -> Ok (block_devices, name :: networks)
+           | _ -> Rresult.R.error_msgf "unknown device type %s in json" typ)
+        (Ok ([], [])) devices
+    | _ -> Rresult.R.error_msg "devices field is not array in json"
+
 let json_of_string src =
   let dec d = match Jsonm.decode d with
     | `Lexeme l -> l

src/vmm_lwt.ml

@@ -12,20 +12,25 @@ let safe_close fd =
     (fun () -> Lwt_unix.close fd)
     (fun _ -> Lwt.return_unit)
 
-let server_socket sock =
+let server_socket ~systemd sock =
-  let name = Vmm_core.socket_path sock in
+  if systemd
-  (Lwt_unix.file_exists name >>= function
+  then match Vmm_unix.sd_listen_fds () with
-    | true -> Lwt_unix.unlink name
+    | Some [fd] -> Lwt.return (Lwt_unix.of_unix_file_descr fd)
-    | false -> Lwt.return_unit) >>= fun () ->
+    | _ -> failwith "Systemd socket activation error" (* FIXME *)
-  let s = Lwt_unix.(socket PF_UNIX SOCK_STREAM 0) in
+  else
-  Lwt_unix.set_close_on_exec s ;
+    let name = Vmm_core.socket_path sock in
-  let old_umask = Unix.umask 0 in
+    (Lwt_unix.file_exists name >>= function
-  let _ = Unix.umask (old_umask land 0o707) in
+      | true -> Lwt_unix.unlink name
-  Lwt_unix.(bind s (ADDR_UNIX name)) >|= fun () ->
+      | false -> Lwt.return_unit) >>= fun () ->
-  Logs.app (fun m -> m "listening on %s" name);
+    let s = Lwt_unix.(socket PF_UNIX SOCK_STREAM 0) in
-  let _ = Unix.umask old_umask in
+    Lwt_unix.set_close_on_exec s ;
-  Lwt_unix.listen s 1 ;
+    let old_umask = Unix.umask 0 in
-  s
+    let _ = Unix.umask (old_umask land 0o707) in
+    Lwt_unix.(bind s (ADDR_UNIX name)) >|= fun () ->
+    Logs.app (fun m -> m "listening on %s" name);
+    let _ = Unix.umask old_umask in
+    Lwt_unix.listen s 1 ;
+    s
 
 let connect addrtype sockaddr =
   let c = Lwt_unix.(socket addrtype SOCK_STREAM 0) in

src/vmm_lwt.mli

@@ -2,7 +2,7 @@
 
 val pp_sockaddr : Format.formatter -> Lwt_unix.sockaddr -> unit
 
-val server_socket : Vmm_core.service -> Lwt_unix.file_descr Lwt.t
+val server_socket : systemd:bool -> Vmm_core.service -> Lwt_unix.file_descr Lwt.t
 
 val connect : Lwt_unix.socket_domain -> Lwt_unix.sockaddr -> Lwt_unix.file_descr option Lwt.t
 

src/vmm_unix.ml

@@ -26,6 +26,26 @@ let check_solo5_cmd name =
   | Ok cmd, _ | _, Ok cmd -> Ok cmd
   | _ -> R.error_msgf "%s does not exist" name
 
+(* Pure OCaml implementation of SystemD's sd_listen_fds.
+ * Note: this implementation does not unset environment variables. *)
+let sd_listen_fds () =
+  let fd_of_int (fd : int) : Unix.file_descr = Obj.magic fd in
+  let sd_listen_fds_start = 3 in
+  match Sys.getenv_opt "LISTEN_PID", Sys.getenv_opt "LISTEN_FDS" with
+  | None, _ | _, None -> None
+  | Some listen_pid, Some listen_fds ->
+    match int_of_string_opt listen_pid, int_of_string_opt listen_fds with
+    | None, _ | _, None -> None
+    | Some listen_pid, Some listen_fds ->
+      if listen_pid = Unix.getpid ()
+      then Some (List.init listen_fds
+                   (fun i ->
+                      let fd = fd_of_int (sd_listen_fds_start + i) in
+                      let () = Unix.set_close_on_exec fd in
+                      fd))
+      else None
+
+
 (* here we check that the binaries we use in this file are actually present *)
 let check_commands () =
   let uname_cmd = Bos.Cmd.v "uname" in
@@ -181,6 +201,48 @@ let solo5_image_target image =
 
 let solo5_tender = function Spt -> "solo5-spt" | Hvt -> "solo5-hvt"
 
+let solo5_image_devices image =
+  check_solo5_cmd "solo5-elftool" >>= fun cmd ->
+  let cmd = Bos.Cmd.(cmd % "query-manifest" % p image) in
+  Bos.OS.Cmd.(run_out cmd |> out_string |> success) >>= fun s ->
+  R.error_to_msg ~pp_error:Jsonm.pp_error
+    (Vmm_json.json_of_string s) >>= fun data ->
+  Vmm_json.find_devices data
+
+let equal_string_lists b1 b2 err =
+  let open Astring in
+  if String.Set.(equal (of_list b1) (of_list b2)) then
+    Ok ()
+  else
+    R.error_msg err
+
+let devices_match ~bridges ~block_devices (manifest_block, manifest_net) =
+  equal_string_lists manifest_block block_devices
+    "specified block device(s) does not match with manifest" >>= fun () ->
+  equal_string_lists manifest_net bridges
+    "specified bridge(s) does not match with the manifest"
+
+let manifest_devices_match ~bridges ~block_devices image_file =
+  solo5_image_devices image_file >>=
+  let bridges = List.map fst bridges in
+  devices_match ~bridges ~block_devices
+
+let bridge_name (service, b) = match b with None -> service | Some b -> b
+
+let bridge_exists bridge_name =
+  let cmd =
+    match Lazy.force uname with
+    | FreeBSD -> Bos.Cmd.(v "ifconfig" % bridge_name)
+    | Linux -> Bos.Cmd.(v "ip" % "link" % "show" % bridge_name)
+  in
+  Bos.OS.Cmd.(run_out ~err:err_null cmd |> out_null |> success)
+  |> R.reword_error (fun _e -> R.msgf "interface %s does not exist" bridge_name)
+
+let bridges_exist bridges =
+  List.fold_left
+    (fun acc b -> acc >>= fun () -> bridge_exists (bridge_name b))
+    (Ok ()) bridges
+
 let prepare name vm =
   (match vm.Unikernel.typ with
    | `Solo5 ->
@@ -194,6 +256,8 @@ let prepare name vm =
   Bos.OS.File.write filename (Cstruct.to_string image) >>= fun () ->
   solo5_image_target filename >>= fun target ->
   check_solo5_cmd (solo5_tender target) >>= fun _ ->
+  manifest_devices_match ~bridges:vm.Unikernel.bridges ~block_devices:vm.Unikernel.block_devices filename >>= fun () ->
+  bridges_exist vm.Unikernel.bridges >>= fun () ->
   let fifo = Name.fifo_file name in
   begin match fifo_exists fifo with
     | Ok true -> Ok ()
@@ -210,11 +274,11 @@ let prepare name vm =
         let _ = Unix.umask old_umask in
         R.error_msgf "file %a error in %s: %a" Fpath.pp fifo f pp_unix_err e
   end >>= fun () ->
-  List.fold_left (fun acc (net, bri) ->
+  List.fold_left (fun acc arg ->
       acc >>= fun acc ->
-      let bridge = match bri with None -> net | Some b -> b in
+      let bridge = bridge_name arg in
       create_tap bridge >>= fun tap ->
-      Ok ((net, tap) :: acc))
+      Ok ((fst arg, tap) :: acc))
     (Ok []) vm.Unikernel.bridges >>= fun taps ->
   Ok (List.rev taps)
 

src/vmm_unix.mli

@@ -8,6 +8,8 @@ type supported = FreeBSD | Linux
 
 val uname : supported Lazy.t
 
+val sd_listen_fds : unit -> Unix.file_descr list option
+
 val set_dbdir : Fpath.t -> unit
 
 val check_commands : unit -> (unit, [> R.msg ]) result
@@ -35,3 +37,6 @@ val dump : ?name:string -> Cstruct.t -> (unit, [> R.msg ]) result
 val restore : ?name:string -> unit -> (Cstruct.t, [> R.msg | `NoFile ]) result
 
 val vm_device : Unikernel.t -> (string, [> R.msg ]) result
+
+val manifest_devices_match : bridges:(string * string option) list ->
+  block_devices:string list -> Fpath.t -> (unit, [> R.msg]) result

src/vmm_vmmd.ml

@@ -212,12 +212,7 @@ let handle_policy_cmd t id = function
         (fun prefix policy policies-> (prefix, policy) :: policies)
         []
     in
-    match policies with
+    Ok (t, `End (`Success (`Policies policies)))
-    | [] ->
-      Logs.debug (fun m -> m "policies: couldn't find %a" Name.pp id) ;
-      Error (`Msg "policy: not found")
-    | _ ->
-      Ok (t, `End (`Success (`Policies policies)))
 
 let handle_unikernel_cmd t id = function
   | `Unikernel_info ->
@@ -229,13 +224,7 @@ let handle_unikernel_cmd t id = function
            (id, cfg) :: vms)
         []
     in
-    begin match vms with
+    Ok (t, `End (`Success (`Unikernels vms)))
-      | [] ->
-        Logs.debug (fun m -> m "info: couldn't find %a" Name.pp id) ;
-        Error (`Msg "info: no unikernel found")
-      | _ ->
-        Ok (t, `End (`Success (`Unikernels vms)))
-    end
   | `Unikernel_get ->
     Logs.debug (fun m -> m "get %a" Name.pp id) ;
     begin match Vmm_trie.find id t.resources.Vmm_resources.unikernels with
@@ -304,12 +293,7 @@ let handle_block_cmd t id = function
         (fun prefix (size, active) blocks -> (prefix, size, active) :: blocks)
         []
     in
-    match blocks with
+    Ok (t, `End (`Success (`Block_devices blocks)))
-    | [] ->
-      Logs.debug (fun m -> m "block: couldn't find %a" Name.pp id) ;
-      Error (`Msg "block: not found")
-    | _ ->
-      Ok (t, `End (`Success (`Block_devices blocks)))
 
 let handle_command t (header, payload) =
   let msg_to_err = function

stats/albatross_stats.ml

@@ -66,13 +66,13 @@ let timer () =
 
 let m = Vmm_core.conn_metrics "unix"
 
-let jump _ interval influx tmpdir =
+let jump _ systemd interval influx tmpdir =
   Sys.(set_signal sigpipe Signal_ignore);
   Albatross_cli.set_tmpdir tmpdir;
   let interval = Duration.(to_f (of_sec interval)) in
   Lwt_main.run
     (Albatross_cli.init_influx "albatross_stats" influx;
-     Vmm_lwt.server_socket `Stats >>= fun s ->
+     Vmm_lwt.server_socket ~systemd `Stats >>= fun s ->
      let _ev = Lwt_engine.on_timer interval true (fun _e -> Lwt.async timer) in
      let rec loop () =
        Lwt_unix.accept s >>= fun (cs, addr) ->
@@ -90,7 +90,7 @@ let interval =
   Arg.(value & opt int 10 & info [ "interval" ] ~doc)
 
 let cmd =
-  Term.(term_result (const jump $ setup_log $ interval $ influx $ tmpdir)),
+  Term.(term_result (const jump $ setup_log $ systemd_socket_activation $ interval $ influx $ tmpdir)),
   Term.info "albatross_stats" ~version
 
 let () = match Term.eval cmd with `Ok () -> exit 0 | _ -> exit 1

stats/albatross_stats_pure.ml

@@ -5,6 +5,8 @@ open Rresult.R.Infix
 
 open Vmm_core
 
+external sysconf_clock_tick : unit -> int = "vmmanage_sysconf_clock_tick"
+
 external sysctl_kinfo_proc : int -> Stats.rusage * Stats.kinfo_mem =
   "vmmanage_sysctl_kinfo_proc"
 external sysctl_ifcount : unit -> int = "vmmanage_sysctl_ifcount"
@@ -99,9 +101,103 @@ let try_open_vmmapi pid_nic =
       IM.add pid (vmctx, vmmdev, nics) fresh)
     pid_nic IM.empty
 
+let string_of_file filename =
+  try
+    let fh = open_in filename in
+    let content = input_line fh in
+    close_in_noerr fh ;
+    Ok content
+  with _ -> Rresult.R.error_msgf "Error reading file %S" filename
+
+let parse_proc_stat s =
+  let stats_opt =
+    let ( let* ) = Option.bind in
+    let* (pid, rest) = Astring.String.cut ~sep:" (" s in
+    let* (tcomm, rest) = Astring.String.cut ~rev:true ~sep:") " rest in
+    let rest = Astring.String.cuts ~sep:" " rest in
+    Some (pid :: tcomm :: rest)
+  in
+  Option.to_result ~none:(`Msg "unable to parse /proc/<pid>/stat") stats_opt
+
+let read_proc_status pid =
+  try
+    let fh = open_in ("/proc/" ^ string_of_int pid ^ "/status") in
+    let lines =
+      let rec read_lines acc = try
+          read_lines (input_line fh :: acc)
+        with End_of_file -> acc in
+      read_lines []
+    in
+    List.map (Astring.String.cut ~sep:":\t") lines |>
+    List.fold_left (fun acc x -> match acc, x with
+        | Some acc, Some x -> Some (x :: acc)
+        | _ -> None) (Some []) |>
+    Option.to_result ~none:(`Msg "failed to parse /proc/<pid>/status")
+  with _ -> Rresult.R.error_msgf "error reading file /proc/%d/status" pid
+
+let linux_rusage pid =
+  (match Unix.stat ("/proc/" ^ string_of_int pid) with
+   | { Unix.st_ctime = start; _ } ->
+     let frac = Float.rem start 1. in
+     Ok (Int64.of_float start, int_of_float (frac *. 1_000_000.))
+   | exception Unix.Unix_error (Unix.ENOENT,_,_) -> Error (`Msg "failed to stat process") ) >>= fun start ->
+  (* reading /proc/<pid>/stat - since it may disappear mid-time,
+     best to have it in memory *)
+  string_of_file ("/proc/" ^ string_of_int pid ^ "/stat") >>= fun data ->
+  parse_proc_stat data >>= fun stat_vals ->
+  string_of_file ("/proc/" ^ string_of_int pid ^ "/statm") >>= fun data ->
+  let statm_vals = Astring.String.cuts ~sep:" " data in
+  read_proc_status pid >>= fun status ->
+  let assoc_i64 key : (int64, _) result =
+    let e x = Option.to_result ~none:(`Msg "error parsing /proc/<pid>/status") x in
+    e (List.assoc_opt key status) >>= fun v ->
+    e (Int64.of_string_opt v)
+  in
+  let i64 s = try Ok (Int64.of_string s) with
+      Failure _ -> Error (`Msg "couldn't parse integer")
+  in
+  let time_of_int64 t =
+    let clock_tick = Int64.of_int (sysconf_clock_tick ()) in
+    let ( * ) = Int64.mul and ( / ) = Int64.div in
+    (t / clock_tick, Int64.to_int (((Int64.rem t clock_tick) * 1_000_000L) / clock_tick))
+  in
+  if List.length stat_vals >= 52 && List.length statm_vals >= 7 then
+    i64 (List.nth stat_vals 9) >>= fun minflt ->
+    i64 (List.nth stat_vals 11) >>= fun majflt ->
+    i64 (List.nth stat_vals 13) >>= fun utime -> (* divide by sysconf(_SC_CLK_TCK) *)
+    i64 (List.nth stat_vals 14) >>= fun stime -> (* divide by sysconf(_SC_CLK_TCK) *)
+    let runtime = fst (time_of_int64 Int64.(add utime stime)) in
+    let utime = time_of_int64 utime
+    and stime = time_of_int64 stime in
+    i64 (List.nth stat_vals 22) >>= fun vsize -> (* in bytes *)
+    i64 (List.nth stat_vals 23) >>= fun rss -> (* in pages *)
+    i64 (List.nth stat_vals 35) >>= fun nswap -> (* not maintained, 0 *)
+    i64 (List.nth statm_vals 3) >>= fun tsize ->
+    i64 (List.nth statm_vals 5) >>= fun dsize -> (* data + stack *)
+    i64 (List.nth statm_vals 5) >>= fun ssize -> (* data + stack *)
+    assoc_i64 "voluntary_ctxt_switches" >>= fun nvcsw ->
+    assoc_i64 "nonvoluntary_ctxt_switches" >>= fun nivcsw ->
+    let rusage = { Stats.utime ; stime ; maxrss = rss ; ixrss = 0L ;
+         idrss = 0L ; isrss = 0L ; minflt ; majflt ; nswap ; inblock = 0L ; outblock = 0L ;
+         msgsnd = 0L ; msgrcv = 0L ; nsignals = 0L ; nvcsw ; nivcsw }
+    and kmem = { Stats.vsize; rss; tsize; dsize; ssize; runtime; cow = 0; start }
+    in
+    Ok (rusage, kmem)
+  else
+    Error (`Msg "couldn't read /proc/<pid>/stat")
+
+let rusage pid =
+  match Lazy.force Vmm_unix.uname with
+  | Vmm_unix.FreeBSD -> wrap sysctl_kinfo_proc pid
+  | Vmm_unix.Linux -> match linux_rusage pid with
+    | Ok x -> Some x
+    | Error (`Msg msg) ->
+      Logs.err (fun m -> m "error %s while reading /proc/" msg);
+      None
+
 let gather pid vmctx nics =
   let ru, mem =
-    match wrap sysctl_kinfo_proc pid with
+    match rusage pid with
     | None -> None, None
     | Some (mem, ru) -> Some mem, Some ru
   in

stats/albatross_stats_stubs.c

@@ -17,6 +17,17 @@
 #define Val32 caml_copy_int32
 #define Val64 caml_copy_int64
 
+/* We only use sysconf(_SC_CLK_TCK) in Linux only, but it's well-defined in FreeBSD as well. */
+#include <unistd.h>
+CAMLprim value vmmanage_sysconf_clock_tick(value unit) {
+  CAMLparam1(unit);
+  long r;
+  r = sysconf(_SC_CLK_TCK);
+  if (r == 1)
+    uerror("sysconf", Nothing);
+  CAMLreturn(Val_long(r));
+}
+
 #ifdef __FreeBSD__
 #include <net/if_mib.h>
 #include <vmmapi.h>
@@ -211,7 +222,100 @@ CAMLprim value vmmanage_sysctl_ifdata (value num) {
 
   CAMLreturn(res);
 }
-#else /* FreeBSD */
+#elif __linux__ /* FreeBSD */
+#include <netlink/netlink.h>
+#include <netlink/socket.h>
+#include <netlink/route/link.h>
+
+#define get_stat(link, stat) rtnl_link_get_stat(link, RTNL_LINK_##stat)
+
+CAMLprim value vmmanage_sysctl_ifcount(value unit) {
+  CAMLparam1(unit);
+  int err;
+  struct nl_sock *nl_sock;
+  struct nl_cache *link_cache;
+
+  nl_sock = nl_socket_alloc();
+  if (nl_sock == 0)
+    uerror("nl_socket_alloc", Nothing);
+  err = nl_connect(nl_sock, NETLINK_ROUTE);
+  if (err < 0)
+    uerror("nl_connect", Nothing);
+  err = rtnl_link_alloc_cache(nl_sock, AF_UNSPEC, &link_cache);
+  if (err < 0)
+    uerror("rtnl_link_alloc_cache", Nothing);
+
+  CAMLreturn(Val_long(nl_cache_nitems(link_cache)));
+}
+
+CAMLprim value vmmanage_sysctl_ifdata(value num) {
+  CAMLparam1(num);
+  CAMLlocal1(res);
+  int err;
+  struct nl_sock *nl_sock;
+  struct nl_cache *link_cache;
+  struct rtnl_link *link;
+
+  nl_sock = nl_socket_alloc();
+  if (nl_sock == 0)
+    uerror("nl_socket_alloc", Nothing);
+  err = nl_connect(nl_sock, NETLINK_ROUTE);
+  if (err < 0)
+    uerror("nl_connect", Nothing);
+  err = rtnl_link_alloc_cache(nl_sock, AF_UNSPEC, &link_cache);
+  if (err < 0)
+    uerror("rtnl_link_alloc_cache", Nothing);
+  link = rtnl_link_get(link_cache, Int_val(num));
+  if (link == NULL)
+    uerror("rtnl_link_get", Nothing);
+  res = caml_alloc(18, 0);
+  Store_field(res, 0, caml_copy_string(rtnl_link_get_name(link)));
+  Store_field(res, 1, Val32(rtnl_link_get_flags(link)));
+  Store_field(res, 2, Val32(0)); /* send_length */
+  Store_field(res, 3, Val32(0)); /* max_send_length */
+  Store_field(res, 4, Val32(0)); /* send_drops */
+  Store_field(res, 5, Val32(rtnl_link_get_mtu(link)));
+  Store_field(res, 6, Val64(0)); /* baudrate */
+  Store_field(res, 7, Val64(get_stat(link, RX_PACKETS)));
+  Store_field(res, 8, Val64(get_stat(link, RX_ERRORS)));
+  Store_field(res, 9, Val64(get_stat(link, TX_PACKETS)));
+  Store_field(res, 10, Val64(get_stat(link, TX_ERRORS)));
+  Store_field(res, 11, Val64(get_stat(link, COLLISIONS)));
+  Store_field(res, 12, Val64(get_stat(link, RX_BYTES)));
+  Store_field(res, 13, Val64(get_stat(link, TX_BYTES)));
+  Store_field(res, 14, Val64(get_stat(link, MULTICAST)));
+  Store_field(res, 15, Val64(0));
+  Store_field(res, 16, Val64(get_stat(link, RX_DROPPED)));
+  Store_field(res, 17, Val64(get_stat(link, TX_DROPPED)));
+  CAMLreturn(res);
+}
+
+CAMLprim value vmmanage_sysctl_kinfo_proc (value pid_r) {
+  CAMLparam1(pid_r);
+  uerror("sysctl_kinfo_proc", Nothing);
+}
+
+CAMLprim value vmmanage_vmmapi_open (value name) {
+  CAMLparam1(name);
+  uerror("vmmapi_open", Nothing);
+}
+
+CAMLprim value vmmanage_vmmapi_close (value name) {
+  CAMLparam1(name);
+  uerror("vmmapi_close", Nothing);
+}
+
+CAMLprim value vmmanage_vmmapi_stats (value name) {
+  CAMLparam1(name);
+  uerror("vmmapi_stats", Nothing);
+}
+
+CAMLprim value vmmanage_vmmapi_statnames (value name) {
+  CAMLparam1(name);
+  uerror("vmmapi_statnames", Nothing);
+}
+
+#else /* Linux */
 
 /* stub symbols for OS currently not supported */
 

stats/config/discover.ml

@@ -0,0 +1,39 @@
+module C = Configurator.V1
+
+let write_sexp (conf : C.Pkg_config.package_conf) =
+  C.Flags.write_sexp "c_flags.sexp" conf.cflags;
+  C.Flags.write_sexp "c_library_flags.sexp" conf.libs
+
+let pkg_config_combine ~default deps =
+  let deps =
+    List.map (Result.fold ~ok:(fun x -> x) ~error:(fun e -> C.die "pkg-config: %s" e))
+      deps in
+  List.fold_left (fun conf dep ->
+      C.Pkg_config.{ libs = conf.libs @ dep.libs;
+                     cflags = conf.cflags @ dep.cflags })
+    default deps
+
+let freebsd _c =
+  let conf = { C.Pkg_config.libs = ["-lvmmapi"]; cflags = [] } in
+  write_sexp conf
+
+let linux c =
+  (* FIXME: cflags -I *)
+  let default = { C.Pkg_config.libs = ["-lnl-3"; "-lnl-route-3"]; cflags = [] } in
+  let conf =
+    match C.Pkg_config.get c with
+    | None -> default
+    | Some pc ->
+      pkg_config_combine ~default [
+        C.Pkg_config.query_expr_err pc ~package:"libnl-3.0" ~expr:"libnl-3.0";
+        C.Pkg_config.query_expr_err pc ~package:"libnl-route-3.0" ~expr:"libnl-route-3.0";
+      ]
+  in
+  write_sexp conf
+
+let () =
+  C.main ~name:"libnl-3-pkg-config" (fun c ->
+      match C.ocaml_config_var_exn c "system" with
+      | "freebsd" -> freebsd c
+      | "linux" -> linux c
+      | os -> failwith ("Unsupported platform: "^os))

stats/config/dune

@@ -0,0 +1,3 @@
+(executable
+ (name discover)
+ (libraries dune.configurator))

stats/dune

@@ -1,15 +1,11 @@
-(* -*- tuareg -*- *)
-
-let freebsd = try Sys.command "uname -s | grep -c FreeBSD > /dev/null" = 0 with _ -> false
-
-let () =
-  Jbuild_plugin.V1.send @@ Printf.sprintf {|
 (library
   (name albatross_stats)
   (public_name albatross.stats)
   (libraries albatross)
   (wrapped false)
   (c_names albatross_stats_stubs)
+  (c_flags (:include c_flags.sexp))
+  (c_library_flags (:include c_library_flags.sexp))
   (modules albatross_stats_pure))
 
 (executable
@@ -17,7 +13,6 @@ let () =
   (public_name albatross-stats)
   (package albatross)
   (modules albatross_stats)
-  %s
   (libraries albatross.cli albatross.stats albatross))
 
 (executable
@@ -25,9 +20,8 @@ let () =
   (public_name albatross-stat-client)
   (package albatross)
   (modules albatross_stat_client)
-  %s
   (libraries albatross.cli albatross.stats albatross))
- |}
-  (if freebsd then "(link_flags (-ccopt \"-lvmmapi\"))" else "")
-  (if freebsd then "(link_flags (-ccopt \"-lvmmapi\"))" else "")
 
+(rule
+  (targets c_flags.sexp c_library_flags.sexp)
+  (action (run ./config/discover.exe)))