changes for solo5 0.6

-- this is a breaking change in the wire protocol

command-line/albatross_cli.ml

@@ -17,7 +17,7 @@ let setup_log style_renderer level =
   Logs.set_level level;
   Logs.set_reporter (Logs_fmt.reporter ~dst:Format.std_formatter ())
 
-let create_vm force image cpuid memory argv block_device network_interfaces compression =
+let create_vm force image cpuid memory argv block_devices bridges compression =
   let open Rresult.R.Infix in
   Bos.OS.File.read (Fpath.v image) >>| fun image ->
   let image = match compression with
@@ -27,7 +27,7 @@ let create_vm force image cpuid memory argv block_device network_interfaces comp
       `Hvt_amd64_compressed, Cstruct.of_string img
   and argv = match argv with [] -> None | xs -> Some xs
   in
-  let config = Unikernel.{ cpuid ; memory ; block_device ; network_interfaces ; argv ; image } in
+  let config = Unikernel.{ cpuid ; memory ; block_devices ; bridges ; argv ; image } in
   if force then `Unikernel_force_create config else `Unikernel_create config
 
 let policy vms memory cpus block bridges =
@@ -148,7 +148,7 @@ let args =
 
 let block =
   let doc = "Block device name" in
-  Arg.(value & opt (some string) None & info [ "block" ] ~doc)
+  Arg.(value & opt_all string [] & info [ "block" ] ~doc)
 
 let net =
   let doc = "Network device names" in

src/vmm_asn.ml

@@ -207,7 +207,13 @@ let log_event =
     | `C1 () -> `Startup
     | `C2 (name, ip, port) -> `Login (to_name name, ip, port)
     | `C3 (name, ip, port) -> `Logout (to_name name, ip, port)
-    | `C4 (name, pid, taps, block) -> `Unikernel_start (to_name name, pid, taps, block)
+    | `C4 (name, pid, taps, blocks) ->
+      let blocks = List.map (fun (name, dev) ->
+          name, match Name.of_string dev with
+          | Error _ -> Name.append_exn "name" Name.(append_exn "invalid" root)
+          | Ok id -> id) blocks
+      in
+      `Unikernel_start (to_name name, pid, taps, blocks)
     | `C5 (name, pid, status) ->
       let status' = match status with
         | `C1 n -> `Exit n
@@ -220,7 +226,11 @@ let log_event =
     | `Startup -> `C1 ()
     | `Login (name, ip, port) -> `C2 (of_name name, ip, port)
     | `Logout (name, ip, port) -> `C3 (of_name name, ip, port)
-    | `Unikernel_start (name, pid, taps, block) -> `C4 (of_name name, pid, taps, block)
+    | `Unikernel_start (name, pid, taps, blocks) ->
+      let blocks =
+        List.map (fun (name, dev) -> name, Name.to_string dev) blocks
+      in
+      `C4 (of_name name, pid, taps, blocks)
     | `Unikernel_stop (name, pid, status) ->
       let status' = match status with
         | `Exit n -> `C1 n
@@ -244,8 +254,16 @@ let log_event =
            (explicit 3 (sequence4
                          (required ~label:"name" (sequence_of utf8_string))
                          (required ~label:"pid" int)
-                         (required ~label:"taps" (sequence_of utf8_string))
+                         (required ~label:"taps"
-                         (optional ~label:"block" utf8_string)))
+                            (sequence_of
+                               (sequence2
+                                  (required ~label:"bridge" utf8_string)
+                                  (required ~label:"tap" utf8_string))))
+                         (required ~label:"blocks"
+                            (sequence_of
+                               (sequence2
+                                  (required ~label:"name" utf8_string)
+                                  (required ~label:"device" utf8_string))))))
            (explicit 4 (sequence3
                           (required ~label:"name" (sequence_of utf8_string))
                           (required ~label:"pid" int)
@@ -266,21 +284,25 @@ let log_cmd =
 
 let unikernel_config =
   let open Unikernel in
-  let f (cpuid, memory, block_device, network_interfaces, image, argv) =
+  let f (image, cpuid, memory, blocks, bridges, argv) =
-    let network_interfaces = match network_interfaces with None -> [] | Some xs -> xs in
+    let bridges = match bridges with None -> [] | Some xs -> xs
-    { cpuid ; memory ; block_device ; network_interfaces ; image ; argv }
+    and block_devices = match blocks with None -> [] | Some xs -> xs
+    in
+    { cpuid ; memory ; block_devices ; bridges ; image ; argv }
   and g vm =
-    let network_interfaces = match vm.network_interfaces with [] -> None | xs -> Some xs in
+    let bridges = match vm.bridges with [] -> None | xs -> Some xs
-    (vm.cpuid, vm.memory, vm.block_device, network_interfaces, vm.image, vm.argv)
+    and blocks = match vm.block_devices with [] -> None | xs -> Some xs
+    in
+    (vm.image, vm.cpuid, vm.memory, blocks, bridges, vm.argv)
   in
   Asn.S.map f g @@
   Asn.S.(sequence6
+           (required ~label:"image" image)
            (required ~label:"cpu" int)
            (required ~label:"memory" int)
-           (optional ~label:"block" utf8_string)
+           (optional ~label:"blocks" (explicit 0 (sequence_of utf8_string)))
-           (optional ~label:"network_interfaces" (sequence_of utf8_string))
+           (optional ~label:"bridges" (explicit 1 (sequence_of utf8_string)))
-           (required ~label:"image" image)
+           (optional ~label:"arguments"(explicit 2 (sequence_of utf8_string))))
-           (optional ~label:"arguments" (sequence_of utf8_string)))
 
 let unikernel_cmd =
   let f = function

src/vmm_core.ml

@@ -157,8 +157,8 @@ module Unikernel = struct
   type config = {
     cpuid : int ;
     memory : int ;
-    block_device : string option ;
+    block_devices : string list ;
-    network_interfaces : string list ;
+    bridges : string list ;
     image : typ * Cstruct.t ;
     argv : string list option ;
   }
@@ -168,10 +168,10 @@ module Unikernel = struct
     Fmt.pf ppf "%a: %d bytes" pp_typ typ l
 
   let pp_config ppf (vm : config) =
-    Fmt.pf ppf "cpu %d, %d MB memory, block device %a@ bridge %a, image %a, argv %a"
+    Fmt.pf ppf "cpu %d, %d MB memory, block devices %a@ bridge %a, image %a, argv %a"
       vm.cpuid vm.memory
-      Fmt.(option ~none:(unit "no") string) vm.block_device
+      Fmt.(list ~sep:(unit ", ") string) vm.block_devices
-      Fmt.(list ~sep:(unit ", ") string) vm.network_interfaces
+      Fmt.(list ~sep:(unit ", ") string) vm.bridges
       pp_image vm.image
       Fmt.(option ~none:(unit "no") (list ~sep:(unit " ") string)) vm.argv
 
@@ -184,8 +184,9 @@ module Unikernel = struct
 
   let pp ppf vm =
     Fmt.pf ppf "pid %d@ taps %a (block %a) cmdline %a"
-      vm.pid Fmt.(list ~sep:(unit ", ") string) vm.taps
+      vm.pid
-      Fmt.(option ~none:(unit "no") string) vm.config.block_device
+      Fmt.(list ~sep:(unit ", ") string) vm.taps
+      Fmt.(list ~sep:(unit ", ") string) vm.config.block_devices
       Bos.Cmd.pp vm.cmd
 end
 
@@ -284,7 +285,7 @@ module Log = struct
     | `Login of Name.t * Ipaddr.V4.t * int
     | `Logout of Name.t * Ipaddr.V4.t * int
     | `Startup
-    | `Unikernel_start of Name.t * int * string list * string option
+    | `Unikernel_start of Name.t * int * (string * string) list * (string * Name.t) list
     | `Unikernel_stop of Name.t * int * process_exit
     | `Hup
   ]
@@ -301,10 +302,10 @@ module Log = struct
     | `Startup -> Fmt.string ppf "startup"
     | `Login (name, ip, port) -> Fmt.pf ppf "%a login %a:%d" Name.pp name Ipaddr.V4.pp ip port
     | `Logout (name, ip, port) -> Fmt.pf ppf "%a logout %a:%d" Name.pp name Ipaddr.V4.pp ip port
-    | `Unikernel_start (name, pid, taps, block) ->
+    | `Unikernel_start (name, pid, taps, blocks) ->
-      Fmt.pf ppf "%a started %d (tap %a, block %a)"
+      Fmt.pf ppf "%a started %d (taps %a, block %a)"
-        Name.pp name pid Fmt.(list ~sep:(unit "; ") string) taps
+        Name.pp name pid Fmt.(list ~sep:(unit "; ") (pair ~sep:(unit "=") string string)) taps
-        Fmt.(option ~none:(unit "no") string) block
+        Fmt.(list ~sep:(unit "; ") (pair ~sep:(unit "=") string Name.pp)) blocks
     | `Unikernel_stop (name, pid, code) ->
       Fmt.pf ppf "%a stopped %d with %a" Name.pp name pid pp_process_exit code
     | `Hup -> Fmt.string ppf "hup"

src/vmm_core.mli

@@ -60,8 +60,8 @@ module Unikernel : sig
   type config = {
     cpuid : int;
     memory : int;
-    block_device : string option;
+    block_devices : string list;
-    network_interfaces : string list;
+    bridges : string list;
     image : typ * Cstruct.t;
     argv : string list option;
   }
@@ -154,7 +154,7 @@ module Log : sig
     | `Login of Name.t * Ipaddr.V4.t * int
     | `Logout of Name.t * Ipaddr.V4.t * int
     | `Startup
-    | `Unikernel_start of Name.t * int * string list * string option
+    | `Unikernel_start of Name.t * int * (string * string) list * (string * Name.t) list
     | `Unikernel_stop of Name.t * int * process_exit
     | `Hup
   ]

src/vmm_resources.ml

@@ -57,17 +57,17 @@ let set_block_usage t name active =
     then invalid_arg ("block device " ^ Name.to_string name ^ " already in state " ^ (if curr then "active" else "inactive"))
     else fst (Vmm_trie.insert name (size, active) t)
 
-let use_block t name vm active =
+let use_blocks t name vm active =
-  match vm.Unikernel.config.Unikernel.block_device with
+  match vm.Unikernel.config.Unikernel.block_devices with
-  | None -> t
+  | [] -> t
-  | Some block ->
+  | blocks ->
-    let block_name = Name.block_name name block in
+    let block_names = List.map (Name.block_name name) blocks in
-    set_block_usage t block_name active
+    List.fold_left (fun t' n -> set_block_usage t' n active) t block_names
 
 let remove_vm t name = match find_vm t name with
   | None -> Error (`Msg "unknown vm")
   | Some vm ->
-    let block_devices = use_block t.block_devices name vm false in
+    let block_devices = use_blocks t.block_devices name vm false in
     let unikernels = Vmm_trie.remove name t.unikernels in
     Ok { t with block_devices ; unikernels }
 
@@ -93,7 +93,7 @@ let check_policy (p : Policy.t) (running_vms, used_memory) (vm : Unikernel.confi
     Error (`Msg "maximum allowed memory reached")
   else if not (IS.mem vm.Unikernel.cpuid p.Policy.cpuids) then
     Error (`Msg "CPUid is not allowed by policy")
-  else if not (List.for_all (flipped_set_mem p.Policy.bridges) vm.Unikernel.network_interfaces) then
+  else if not (List.for_all (flipped_set_mem p.Policy.bridges) vm.Unikernel.bridges) then
     Error (`Msg "network not allowed by policy")
   else Ok ()
 
@@ -105,9 +105,9 @@ let check_vm t name vm =
     | Some p ->
       let used = vm_usage t dom in
       check_policy p used vm
-  and block_ok = match vm.Unikernel.block_device with
+  and block_ok =
-    | None -> Ok ()
+    List.fold_left (fun r block ->
-    | Some block ->
+        r >>= fun () ->
         let block_name = Name.block_name name block in
         match find_block t block_name with
         | None -> Error (`Msg "block device not found")
@@ -115,7 +115,8 @@ let check_vm t name vm =
           if active then
             Error (`Msg "block device already in use")
           else
-           Ok ()
+            Ok ())
+      (Ok ()) vm.block_devices
   and vm_ok = match find_vm t name with
     | None -> Ok ()
     | Some _ -> Error (`Msg "vm with same name already exists")
@@ -127,7 +128,7 @@ let check_vm t name vm =
 let insert_vm t name vm =
   let unikernels, old = Vmm_trie.insert name vm t.unikernels in
   (match old with None -> () | Some _ -> invalid_arg ("unikernel " ^ Name.to_string name ^ " already exists in trie")) ;
-  let block_devices = use_block t.block_devices name vm true in
+  let block_devices = use_blocks t.block_devices name vm true in
   { t with unikernels ; block_devices }
 
 let check_block t name size =
@@ -207,7 +208,7 @@ let check_vms t name p =
     Vmm_trie.fold name t.unikernels
       (fun _ vm (bridges, cpuids) ->
          let config = vm.Unikernel.config in
-         (String.Set.(union (of_list config.Unikernel.network_interfaces) bridges),
+         (String.Set.(union (of_list config.Unikernel.bridges) bridges),
           IS.add config.Unikernel.cpuid cpuids))
       (String.Set.empty, IS.empty)
   in

src/vmm_unix.ml

@@ -146,7 +146,7 @@ let prepare name vm =
       acc >>= fun acc ->
       create_tap b >>= fun tap ->
       Ok (tap :: acc))
-    (Ok []) vm.Unikernel.network_interfaces >>= fun taps ->
+    (Ok []) vm.Unikernel.bridges >>= fun taps ->
   Bos.OS.File.write (Name.image_file name) (Cstruct.to_string image) >>= fun () ->
   Ok (List.rev taps)
 
@@ -170,22 +170,16 @@ let cpuset cpu =
     Ok ([ "taskset" ; "-c" ; cpustring ])
   | x -> Error (`Msg ("unsupported operating system " ^ x))
 
-let exec name config taps block =
+let exec name config bridge_taps blocks =
-  (match taps, block with
+  let net = List.map (fun (bridge, tap) -> "--net:" ^ bridge ^ "=" ^ tap) bridge_taps
-   | [], None -> Ok "none"
+  and blocks = List.map (fun (name, dev) -> "--disk:" ^ name ^ "=" ^ Fpath.to_string (block_file dev)) blocks
-   | [_], None -> Ok "net"
-   | [], Some _ -> Ok "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 (block_file dev) ]
   and argv = match config.Unikernel.argv with None -> [] | Some xs -> xs
   and mem = "--mem=" ^ string_of_int config.Unikernel.memory
   in
   cpuset config.Unikernel.cpuid >>= fun cpuset ->
   let cmd =
-    Bos.Cmd.(of_list cpuset % p Fpath.(dbdir / "solo5-hvt" + bin) % mem %%
+    Bos.Cmd.(of_list cpuset % p Fpath.(dbdir / "solo5-hvt") % mem %%
-             of_list net %% of_list block %
+             of_list net %% of_list blocks %
              "--" % p (Name.image_file name) %% of_list argv)
   in
   let line = Bos.Cmd.to_list cmd in
@@ -202,6 +196,7 @@ let exec name config taps block =
     (* we gave a copy (well, two copies) of that file descriptor to the solo5
        process and don't really need it here anymore... *)
     close_no_err stdout ;
+    let taps = snd (List.split bridge_taps) in
     Ok Unikernel.{ config ; cmd ; pid ; taps }
   with
     Unix.Unix_error (e, _, _) ->

src/vmm_unix.mli

@@ -6,8 +6,8 @@ open Vmm_core
 
 val prepare : Name.t -> Unikernel.config -> (string list, [> R.msg ]) result
 
-val exec : Name.t -> Unikernel.config -> string list -> Name.t option ->
+val exec : Name.t -> Unikernel.config -> (string * string) list ->
-  (Unikernel.t, [> R.msg ]) result
+  (string * Name.t) list -> (Unikernel.t, [> R.msg ]) result
 
 val free_system_resources : Name.t -> string list -> (unit, [> R.msg ]) result
 

src/vmm_vmmd.ml

@@ -105,7 +105,7 @@ let setup_stats t name vm =
     let name = match Vmm_unix.vm_device vm with
       | Error _ -> ""
       | Ok name -> name
-    and ifs = Unikernel.(List.combine vm.config.network_interfaces vm.taps)
+    and ifs = Unikernel.(List.combine vm.config.bridges vm.taps)
     in
     `Stats_add (name, vm.Unikernel.pid, ifs)
   in
@@ -138,17 +138,23 @@ let handle_create t hdr name vm_config =
        - update resources
        --> if either the first or second fails, then the fail continuation
            below needs to be called *)
-    let block_device = match vm_config.Unikernel.block_device with
-      | None -> None
-      | Some block -> Some (Name.block_name name block)
-    in
     Vmm_resources.check_vm t.resources name vm_config >>= fun () ->
-    Vmm_unix.exec name vm_config taps block_device >>| fun vm ->
+    let ifs = List.combine vm_config.bridges taps
+    and block_devices =
+      List.map (fun d -> d, Name.block_name name d)
+        vm_config.Unikernel.block_devices
+    in
+    Vmm_unix.exec name vm_config ifs block_devices >>| fun vm ->
     Logs.debug (fun m -> m "exec()ed vm") ;
     let resources = Vmm_resources.insert_vm t.resources name vm in
     let t = { t with resources } in
     dump_unikernels t ;
-    let t, log_out = log t name (`Unikernel_start (name, vm.Unikernel.pid, vm.Unikernel.taps, None)) in
+    let t, log_out =
+      let start =
+        `Unikernel_start (name, vm.Unikernel.pid, ifs, block_devices)
+      in
+      log t name start
+    in
     let t, stat_out = setup_stats t name vm in
     (t, stat_out, log_out, (hdr, `Success (`String "created VM")), name, vm)
   and fail () =