From 65693ea188e9713ae6eb2a32b2f35c9c9162f902 Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Wed, 25 Mar 2020 15:19:28 +0100 Subject: [PATCH] revise the "--net=yyy" argument to (optionally) contain a service:bridge it used to only contain service, and used the same string for the bridge. This is not flexible enough to run off-the-shelf unikernels (configured for bridge "service" and "management" on multi-homed servers). The old behaviour is the new default (i.e. "--net=service" creates and attaches a tap device to bridge "service", and passes "--net:service=tapYY" to the solo5 tender). But it is more flexible now: "--net=service:other-bridge" will create a tap device attached to "other-bridge" and pass "--net:service=tapYY" to the tender. This way, there's no need to match bridge names on the actual server with network device names of the unikernels. NB: this is (mostly) backwards-compatible: the on-disk data structures are versioned (and the version is bumped with this PR), an old albatross client can send "create" commands to a new server. But a new client will get a parse error from an old server - which is fine taking into consideration the deployment base. --- command-line/albatross_cli.ml | 14 ++++++-- command-line/dune | 2 +- src/vmm_asn.ml | 66 +++++++++++++++++++++++++++-------- src/vmm_core.ml | 11 ++++-- src/vmm_core.mli | 4 ++- src/vmm_resources.ml | 8 ++--- src/vmm_unix.ml | 7 ++-- src/vmm_unix.mli | 3 +- src/vmm_vmmd.ml | 15 ++++---- 9 files changed, 93 insertions(+), 37 deletions(-) diff --git a/command-line/albatross_cli.ml b/command-line/albatross_cli.ml index 44fbc8a..d38876b 100644 --- a/command-line/albatross_cli.ml +++ b/command-line/albatross_cli.ml @@ -73,7 +73,7 @@ let create_vm force image cpuid memory argv block_devices bridges compression re let exits = match exit_codes with [] -> None | xs -> Some (IS.of_list xs) in if restart_on_fail then `Restart exits else `Quit in - let config = Unikernel.{ typ = `Solo5 ; compressed ; image ; fail_behaviour ; cpuid ; memory ; block_devices ; bridges ; argv } in + let config = { Unikernel.typ = `Solo5 ; compressed ; image ; fail_behaviour ; cpuid ; memory ; block_devices ; bridges ; argv } in if force then `Unikernel_force_create config else `Unikernel_create config let policy vms memory cpus block bridges = @@ -216,9 +216,17 @@ let block = let doc = "Block device name" in Arg.(value & opt_all string [] & info [ "block" ] ~doc) +let srv_bridge_c = + let parse s = match Astring.String.cut ~sep:":" s with + | None -> `Ok (s, None) + | Some (srv, bri) -> `Ok (srv, Some bri) + in + (parse, fun ppf (srv, bri) -> Fmt.pf ppf "%s:%s" srv + (match bri with None -> srv | Some bri -> bri)) + let net = - let doc = "Network device names" in - Arg.(value & opt_all string [] & info [ "net" ] ~doc) + let doc = "Network device names (bridge or name:bridge)" in + Arg.(value & opt_all srv_bridge_c [] & info [ "net" ] ~doc) let restart_on_fail = let doc = "Restart on fail" in diff --git a/command-line/dune b/command-line/dune index 222ab7b..0669385 100644 --- a/command-line/dune +++ b/command-line/dune @@ -3,4 +3,4 @@ (public_name albatross.cli) (wrapped false) (modules albatross_cli) - (libraries checkseum.c albatross lwt.unix cmdliner logs.fmt logs.cli fmt.cli fmt.tty ipaddr.unix metrics metrics-lwt metrics-influx)) + (libraries checkseum.c albatross lwt.unix cmdliner logs.fmt logs.cli fmt fmt.cli fmt.tty ipaddr.unix metrics metrics-lwt metrics-influx)) diff --git a/src/vmm_asn.ml b/src/vmm_asn.ml index 6368400..c9d70d3 100644 --- a/src/vmm_asn.ml +++ b/src/vmm_asn.ml @@ -328,7 +328,7 @@ let fail_behaviour = (explicit 1 (set_of int))) (* this is part of the state file! *) -let v3_unikernel_config = +let v0_unikernel_config = let image = let f = function | `C1 x -> `Hvt_amd64, x @@ -347,7 +347,7 @@ let v3_unikernel_config = in let open Unikernel in let f (cpuid, memory, block_device, network_interfaces, image, argv) = - let bridges = match network_interfaces with None -> [] | Some xs -> xs + let bridges = match network_interfaces with None -> [] | Some xs -> List.map (fun n -> n, None) xs and block_devices = match block_device with None -> [] | Some b -> [ b ] in let typ = `Solo5 @@ -357,7 +357,7 @@ let v3_unikernel_config = in { typ ; compressed ; image ; fail_behaviour ; cpuid ; memory ; block_devices ; bridges ; argv } and g vm = - let network_interfaces = match vm.bridges with [] -> None | xs -> Some xs + let network_interfaces = match vm.bridges with [] -> None | xs -> Some (List.map fst xs) and block_device = match vm.block_devices with [] -> None | x::_ -> Some x and typ = if vm.compressed then `Hvt_amd64_compressed else `Hvt_amd64 in @@ -376,6 +376,30 @@ let v3_unikernel_config = (* this is part of the state file (and unikernel_create command) be aware if this (or a dependent grammar) is changed! *) +let v1_unikernel_config = + let open Unikernel in + let f (typ, (compressed, (image, (fail_behaviour, (cpuid, (memory, (blocks, (bridges, argv)))))))) = + let bridges = match bridges with None -> [] | Some xs -> List.map (fun b -> b, None) xs + and block_devices = match blocks with None -> [] | Some xs -> xs + in + { typ ; compressed ; image ; fail_behaviour ; cpuid ; memory ; block_devices ; bridges ; argv } + and g vm = + let bridges = match vm.bridges with [] -> None | xs -> Some (List.map fst xs) + and blocks = match vm.block_devices with [] -> None | xs -> Some xs + in + (vm.typ, (vm.compressed, (vm.image, (vm.fail_behaviour, (vm.cpuid, (vm.memory, (blocks, (bridges, vm.argv)))))))) + in + Asn.S.(map f g @@ sequence @@ + (required ~label:"typ" typ) + @ (required ~label:"compressed" bool) + @ (required ~label:"image" octet_string) + @ (required ~label:"fail behaviour" fail_behaviour) + @ (required ~label:"cpuid" int) + @ (required ~label:"memory" int) + @ (optional ~label:"blocks" (explicit 0 (set_of utf8_string))) + @ (optional ~label:"bridges" (explicit 1 (set_of utf8_string))) + -@ (optional ~label:"arguments"(explicit 2 (sequence_of utf8_string)))) + let unikernel_config = let open Unikernel in let f (typ, (compressed, (image, (fail_behaviour, (cpuid, (memory, (blocks, (bridges, argv)))))))) = @@ -397,7 +421,11 @@ let unikernel_config = @ (required ~label:"cpuid" int) @ (required ~label:"memory" int) @ (optional ~label:"blocks" (explicit 0 (set_of utf8_string))) - @ (optional ~label:"bridges" (explicit 1 (set_of utf8_string))) + @ (optional ~label:"bridges" + (explicit 1 (sequence_of + (sequence2 + (required ~label:"netif" utf8_string) + (optional ~label:"bridge" utf8_string))))) -@ (optional ~label:"arguments"(explicit 2 (sequence_of utf8_string)))) let unikernel_cmd = @@ -406,18 +434,22 @@ let unikernel_cmd = | `C2 vm -> `Unikernel_create vm | `C3 vm -> `Unikernel_force_create vm | `C4 () -> `Unikernel_destroy + | `C5 vm -> `Unikernel_create vm + | `C6 vm -> `Unikernel_force_create vm and g = function | `Unikernel_info -> `C1 () - | `Unikernel_create vm -> `C2 vm - | `Unikernel_force_create vm -> `C3 vm + | `Unikernel_create vm -> `C5 vm + | `Unikernel_force_create vm -> `C6 vm | `Unikernel_destroy -> `C4 () in Asn.S.map f g @@ - Asn.S.(choice4 + Asn.S.(choice6 (explicit 0 null) - (explicit 1 unikernel_config) - (explicit 2 unikernel_config) - (explicit 3 null)) + (explicit 1 v1_unikernel_config) + (explicit 2 v1_unikernel_config) + (explicit 3 null) + (explicit 4 unikernel_config) + (explicit 5 unikernel_config)) let policy_cmd = let f = function @@ -632,9 +664,11 @@ let trie e = (required ~label:"name" utf8_string) (required ~label:"value" e))) -let version0_unikernels = trie v3_unikernel_config +let version0_unikernels = trie v0_unikernel_config -let version1_unikernels = trie unikernel_config +let version1_unikernels = trie v1_unikernel_config + +let version2_unikernels = trie unikernel_config let unikernels = (* the choice is the implicit version + migration... be aware when @@ -642,13 +676,15 @@ let unikernels = let f = function | `C1 data -> data | `C2 data -> data + | `C3 data -> data and g data = - `C1 data + `C3 data in Asn.S.map f g @@ - Asn.S.(choice2 + Asn.S.(choice3 (explicit 0 version1_unikernels) - (explicit 1 version0_unikernels)) + (explicit 1 version0_unikernels) + (explicit 2 version2_unikernels)) let unikernels_of_cstruct, unikernels_to_cstruct = projections_of unikernels diff --git a/src/vmm_core.ml b/src/vmm_core.ml index c566832..a500e28 100644 --- a/src/vmm_core.ml +++ b/src/vmm_core.ml @@ -207,10 +207,15 @@ module Unikernel = struct cpuid : int ; memory : int ; block_devices : string list ; - bridges : string list ; + bridges : (string * string option) list ; argv : string list option ; } + let bridges (vm : config) = + List.map + (fun (net, bri) -> match bri with None -> net | Some s -> s) + vm.bridges + let pp_config ppf (vm : config) = Fmt.pf ppf "typ %a@ compression %B image %d bytes@ fail behaviour %a@ cpu %d@ %d MB memory@ block devices %a@ bridge %a@ argv %a" pp_typ vm.typ @@ -219,7 +224,9 @@ module Unikernel = struct pp_fail_behaviour vm.fail_behaviour vm.cpuid vm.memory Fmt.(list ~sep:(unit ", ") string) vm.block_devices - Fmt.(list ~sep:(unit ", ") string) vm.bridges + Fmt.(list ~sep:(unit ", ") + (pair ~sep:(unit " -> ") string string)) + (List.map (fun (a, b) -> a, (match b with None -> a | Some b -> b)) vm.bridges) Fmt.(option ~none:(unit "no") (list ~sep:(unit " ") string)) vm.argv let restart_handler config = diff --git a/src/vmm_core.mli b/src/vmm_core.mli index 503b88b..ee7c656 100644 --- a/src/vmm_core.mli +++ b/src/vmm_core.mli @@ -82,10 +82,12 @@ module Unikernel : sig cpuid : int ; memory : int ; block_devices : string list ; - bridges : string list ; + bridges : (string * string option) list ; argv : string list option ; } + val bridges : config -> string list + val pp_config : config Fmt.t val restart_handler : config -> bool diff --git a/src/vmm_resources.ml b/src/vmm_resources.ml index 2c72b99..bdee06e 100644 --- a/src/vmm_resources.ml +++ b/src/vmm_resources.ml @@ -6,8 +6,6 @@ open Rresult.R.Infix open Vmm_core -let flipped_set_mem set s = String.Set.mem s set - type t = { policies : Policy.t Vmm_trie.t ; block_devices : (int * bool) Vmm_trie.t ; @@ -135,6 +133,8 @@ let remove_block t name = match find_block t name with report_vms t' name; Ok t' +let bridge_allowed set s = String.Set.mem s set + let check_policy (p : Policy.t) (running_vms, used_memory) (vm : Unikernel.config) = if succ running_vms > p.Policy.vms then Error (`Msg "maximum amount of unikernels reached") @@ -142,7 +142,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.bridges) then + else if not (List.for_all (bridge_allowed p.Policy.bridges) (Unikernel.bridges vm)) then Error (`Msg "network not allowed by policy") else Ok () @@ -261,7 +261,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.bridges) bridges), + (String.Set.(union (of_list (Unikernel.bridges config)) bridges), IS.add config.Unikernel.cpuid cpuids)) (String.Set.empty, IS.empty) in diff --git a/src/vmm_unix.ml b/src/vmm_unix.ml index beb565e..aea6176 100644 --- a/src/vmm_unix.ml +++ b/src/vmm_unix.ml @@ -202,10 +202,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 b -> + List.fold_left (fun acc (net, bri) -> acc >>= fun acc -> - create_tap b >>= fun tap -> - Ok (tap :: acc)) + let bridge = match bri with None -> net | Some b -> b in + create_tap bridge >>= fun tap -> + Ok ((net, tap) :: acc)) (Ok []) vm.Unikernel.bridges >>= fun taps -> Ok (List.rev taps) diff --git a/src/vmm_unix.mli b/src/vmm_unix.mli index 621b820..638de2e 100644 --- a/src/vmm_unix.mli +++ b/src/vmm_unix.mli @@ -12,7 +12,8 @@ val set_dbdir : Fpath.t -> unit val check_commands : unit -> (unit, [> R.msg ]) result -val prepare : Name.t -> Unikernel.config -> (string list, [> R.msg ]) result +val prepare : Name.t -> Unikernel.config -> + ((string * string) list, [> R.msg ]) result val exec : Name.t -> Unikernel.config -> (string * string) list -> (string * Name.t) list -> (Unikernel.t, [> R.msg ]) result diff --git a/src/vmm_vmmd.ml b/src/vmm_vmmd.ml index ffcb030..ee91f4c 100644 --- a/src/vmm_vmmd.ml +++ b/src/vmm_vmmd.ml @@ -117,7 +117,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.bridges vm.taps) + and ifs = Unikernel.(List.combine (List.map fst vm.config.bridges) vm.taps) in `Stats_add (name, vm.Unikernel.pid, ifs) in @@ -138,7 +138,9 @@ let handle_create t name vm_config = Vmm_resources.check_vm t.resources name vm_config >>= fun () -> (* prepare VM: save VM image to disk, create fifo, ... *) Vmm_unix.prepare name vm_config >>= fun taps -> - Logs.debug (fun m -> m "prepared vm with taps %a" Fmt.(list ~sep:(unit ",@ ") string) taps) ; + Logs.debug (fun m -> m "prepared vm with taps %a" + Fmt.(list ~sep:(unit ",@ ") (pair ~sep:(unit " -> ") string string)) + taps) ; let cons_out = let header = Vmm_commands.header ~sequence:t.console_counter name in (header, `Command (`Console_cmd `Console_add)) @@ -151,26 +153,25 @@ let handle_create t name vm_config = --> if either the first or second fails, then the fail continuation below needs to be called *) Vmm_resources.check_vm t.resources name vm_config >>= fun () -> - let ifs = List.combine vm_config.bridges taps - and block_devices = + let 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 -> + Vmm_unix.exec name vm_config taps 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 = let start = - `Unikernel_start (name, vm.Unikernel.pid, ifs, block_devices) + `Unikernel_start (name, vm.Unikernel.pid, taps, block_devices) in log t name start in let t, stat_out = setup_stats t name vm in (t, stat_out, log_out, `Success (`String "created VM"), name, vm) and fail () = - match Vmm_unix.free_system_resources name taps with + match Vmm_unix.free_system_resources name (List.map snd taps) with | Ok () -> `Failure "could not create VM: console failed" | Error (`Msg msg) -> let m = "could not create VM: console failed, and also " ^ msg ^ " while cleaning resources" in