reynir/albatross
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

changes for solo5 0.6

Browse source 
-- this is a breaking change in the wire protocol
This commit is contained in:
Hannes Mehnert 2019-09-28 18:09:45 +01:00
parent a46538cabc
commit 94912c21e4
8 changed files with 98 additions and 73 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
command-line/albatross_cli.ml
View file

@ -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

48
src/vmm_asn.ml
View file

@ -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))
(optional ~label:"block" utf8_string)))
(required ~label:"taps"
(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 network_interfaces = match network_interfaces with None -> [] | Some xs -> xs in
{ cpuid ; memory ; block_device ; network_interfaces ; image ; argv }
let f (image, cpuid, memory, blocks, bridges, argv) =
let bridges = match bridges with None -> [] | Some xs -> xs
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
(vm.cpuid, vm.memory, vm.block_device, network_interfaces, vm.image, vm.argv)
let bridges = match vm.bridges with [] -> None | xs -> Some xs
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:"network_interfaces" (sequence_of utf8_string))
(required ~label:"image" image)
(optional ~label:"arguments" (sequence_of utf8_string)))
(optional ~label:"blocks" (explicit 0 (sequence_of utf8_string)))
(optional ~label:"bridges" (explicit 1 (sequence_of utf8_string)))
(optional ~label:"arguments"(explicit 2 (sequence_of utf8_string))))
let unikernel_cmd =
let f = function

25
src/vmm_core.ml
View file

@ -157,8 +157,8 @@ module Unikernel = struct
type config = {
cpuid : int ;
memory : int ;
block_device : string option ;
network_interfaces : string list ;
block_devices : 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.network_interfaces
Fmt.(list ~sep:(unit ", ") string) vm.block_devices
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
Fmt.(option ~none:(unit "no") string) vm.config.block_device
vm.pid
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) ->
Fmt.pf ppf "%a started %d (tap %a, block %a)"
Name.pp name pid Fmt.(list ~sep:(unit "; ") string) taps
Fmt.(option ~none:(unit "no") string) block
| `Unikernel_start (name, pid, taps, blocks) ->
Fmt.pf ppf "%a started %d (taps %a, block %a)"
Name.pp name pid Fmt.(list ~sep:(unit "; ") (pair ~sep:(unit "=") string string)) taps
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"

6
src/vmm_core.mli
View file

@ -60,8 +60,8 @@ module Unikernel : sig
type config = {
cpuid : int;
memory : int;
block_device : string option;
network_interfaces : string list;
block_devices : 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
]

29
src/vmm_resources.ml
View file

@ -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 =
match vm.Unikernel.config.Unikernel.block_device with
| None -> t
| Some block ->
let block_name = Name.block_name name block in
set_block_usage t block_name active
let use_blocks t name vm active =
match vm.Unikernel.config.Unikernel.block_devices with
| [] -> t
| blocks ->
let block_names = List.map (Name.block_name name) blocks in
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
| None -> Ok ()
| Some block ->
and block_ok =
List.fold_left (fun r 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

19
src/vmm_unix.ml
View file

@ -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 =
(match taps, block with
| [], None -> Ok "none"
| [_], 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) ]
let exec name config bridge_taps blocks =
let net = List.map (fun (bridge, tap) -> "--net:" ^ bridge ^ "=" ^ tap) bridge_taps
and blocks = List.map (fun (name, dev) -> "--disk:" ^ name ^ "=" ^ Fpath.to_string (block_file dev)) blocks
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 %%
of_list net %% of_list block %
Bos.Cmd.(of_list cpuset % p Fpath.(dbdir / "solo5-hvt") % mem %%
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, _, _) ->

4
src/vmm_unix.mli
View file

@ -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 ->
(Unikernel.t, [> R.msg ]) result
val exec : Name.t -> Unikernel.config -> (string * string) list ->
(string * Name.t) list -> (Unikernel.t, [> R.msg ]) result
val free_system_resources : Name.t -> string list -> (unit, [> R.msg ]) result

20
src/vmm_vmmd.ml
View file

@ -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 () =