From 8ccda0e410e16a51ff1fcb4f765a38d7e1870cd4 Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Mon, 12 Nov 2018 22:07:45 +0100 Subject: [PATCH] refactor bridge: use a string instead of a complicated thing --- app/vmm_cli.ml | 33 ++------------------------------- src/vmm_asn.ml | 30 +++--------------------------- src/vmm_core.ml | 36 +++++++++--------------------------- src/vmm_core.mli | 11 +---------- src/vmm_resources.ml | 6 +++++- 5 files changed, 20 insertions(+), 96 deletions(-) diff --git a/app/vmm_cli.ml b/app/vmm_cli.ml index 546e924..1d828db 100644 --- a/app/vmm_cli.ml +++ b/app/vmm_cli.ml @@ -31,12 +31,7 @@ let create_vm force image cpuid requested_memory argv block_device network compr if force then `Vm_force_create vm_config else `Vm_create vm_config let policy vms memory cpus block bridges = - let bridges = - let add m v = - let n = match v with `Internal n -> n | `External (n, _, _, _, _) -> n in - String.Map.add n v m - in - List.fold_left add String.Map.empty bridges + let bridges = String.Set.of_list bridges and cpuids = IS.of_list cpus in Policy.{ vms ; cpuids ; memory ; block ; bridges } @@ -60,30 +55,6 @@ let host_port : (string * int) Arg.converter = in parse, fun ppf (h, p) -> Format.fprintf ppf "%s:%d" h p -let bridge = - let parse s = - match Astring.String.cuts ~sep:"/" s with - | [ name ; fst ; lst ; gw ; nm ] -> - begin match Ipaddr.V4.(of_string fst, of_string lst, of_string gw) with - | Some fst, Some lst, Some gw -> - (try - let nm = int_of_string nm in - if nm > 0 && nm <= 32 then - let net = Ipaddr.V4.Prefix.make nm gw in - if Ipaddr.V4.Prefix.mem fst net && Ipaddr.V4.Prefix.mem lst net then - `Ok (`External (name, fst, lst, gw, nm)) - else - `Error "first or last IP are not in subnet" - else - `Error "netmask must be > 0 and <= 32" - with Failure _ -> `Error "couldn't parse netmask") - | _ -> `Error "couldn't parse IP address" - end - | [ name ] -> `Ok (`Internal name) - | _ -> `Error "couldn't parse bridge (either specify 'name' or 'name/firstIP/lastIP/gatewayIP/netmask')" - in - (parse, Policy.pp_bridge) - let vm_c = let parse s = match Name.of_string s with | Error (`Msg msg) -> `Error msg @@ -141,7 +112,7 @@ let mem = let bridge = let doc = "Bridges to allow" in - Arg.(value & opt_all bridge [] & info [ "bridge" ] ~doc) + Arg.(value & opt_all string [] & info [ "bridge" ] ~doc) let cpu = let doc = "CPUid to use" in diff --git a/src/vmm_asn.ml b/src/vmm_asn.ml index 5806c6d..f181826 100644 --- a/src/vmm_asn.ml +++ b/src/vmm_asn.ml @@ -29,33 +29,9 @@ let ipv4 = in Asn.S.map f g Asn.S.octet_string -let bridge = - let f = function - | `C1 nam -> `Internal nam - | `C2 (nam, s, e, r, n) -> `External (nam, s, e, r, n) - and g = function - | `Internal nam -> `C1 nam - | `External (nam, s, e, r, n) -> `C2 (nam, s, e, r, n) - in - Asn.S.map f g @@ - Asn.S.(choice2 - (explicit 0 utf8_string) - (explicit 1 (sequence5 - (required ~label:"name" utf8_string) - (required ~label:"start" ipv4) - (required ~label:"end" ipv4) - (required ~label:"router" ipv4) - (required ~label:"netmask" int)))) - let policy = let f (cpuids, vms, memory, block, bridges) = - let bridges = match bridges with - | xs -> - let add m v = - let n = match v with `Internal n -> n | `External (n, _, _, _, _) -> n in - String.Map.add n v m - in - List.fold_left add String.Map.empty xs + let bridges = String.Set.of_list bridges and cpuids = IS.of_list cpuids in Policy.{ vms ; cpuids ; memory ; block ; bridges } @@ -64,7 +40,7 @@ let policy = policy.Policy.vms, policy.Policy.memory, policy.Policy.block, - snd @@ List.split @@ String.Map.bindings policy.Policy.bridges) + String.Set.elements policy.Policy.bridges) in Asn.S.map f g @@ Asn.S.(sequence5 @@ -72,7 +48,7 @@ let policy = (required ~label:"vms" int) (required ~label:"memory" int) (optional ~label:"block" int) - (required ~label:"bridges" Asn.S.(sequence_of bridge))) + (required ~label:"bridges" Asn.S.(sequence_of utf8_string))) let image = let f = function diff --git a/src/vmm_core.ml b/src/vmm_core.ml index b07585b..431ac8c 100644 --- a/src/vmm_core.ml +++ b/src/vmm_core.ml @@ -144,7 +144,7 @@ module Policy = struct cpuids : IS.t ; memory : int ; block : int option ; - bridges : bridge String.Map.t ; + bridges : String.Set.t ; } let equal p1 p2 = @@ -157,41 +157,27 @@ module Policy = struct IS.equal p1.cpuids p2.cpuids && eq_int p1.memory p2.memory && eq_opt p1.block p2.block && - String.Map.equal equal_bridge p1.bridges p2.bridges + String.Set.equal p1.bridges p2.bridges let pp ppf res = Fmt.pf ppf "policy: %d vms %a cpus %d MB memory %a MB block bridges: %a" res.vms pp_is res.cpuids res.memory Fmt.(option ~none:(unit "no") int) res.block - Fmt.(list ~sep:(unit ", ") pp_bridge) - (List.map snd (String.Map.bindings res.bridges)) + (String.Set.pp ~sep:Fmt.(unit ", ") Fmt.string) res.bridges - let sub_bridges super sub = - String.Map.for_all (fun idx v -> - match String.Map.find idx super, v with - | None, _ -> false - | Some (`Internal nam), `Internal nam' -> String.compare nam nam' = 0 - | Some (`External (nam, supf, supl, gw, nm)), - `External (nam', subf, subl, gw', nm') -> - String.compare nam nam' = 0 && nm = nm' && - Ipaddr.V4.compare supf subf <= 0 && Ipaddr.V4.compare supl subl >= 0 && - Ipaddr.V4.compare gw gw' = 0 - | _ -> false) - sub - - let sub_block super sub = + let sub_block sub super = match super, sub with | None, None -> true | Some _, None -> true | Some x, Some y -> x >= y | None, Some _ -> false - let sub_cpu super sub = IS.subset sub super - let is_sub ~super ~sub = - sub.vms <= super.vms && sub_cpu super.cpuids sub.cpuids && + sub.vms <= super.vms && sub.memory <= super.memory && - sub_bridges super.bridges sub.bridges && sub_block super.block sub.block + IS.subset sub.cpuids super.cpuids && + String.Set.subset sub.bridges super.bridges && + sub_block sub.block super.block end module Vm = struct @@ -223,14 +209,10 @@ module Vm = struct pp_image vm.vmimage Fmt.(option ~none:(unit "no") (list ~sep:(unit " ") string)) vm.argv - let good_bridge idxs nets = - (* TODO: uniqueness of n -- it should be an ordered set? *) - List.for_all (fun n -> String.Map.mem n nets) idxs - let vm_matches_res (res : Policy.t) (vm : config) = res.Policy.vms >= 1 && IS.mem vm.cpuid res.Policy.cpuids && vm.requested_memory <= res.Policy.memory && - good_bridge vm.network res.Policy.bridges + List.for_all (fun nw -> String.Set.mem nw res.Policy.bridges) vm.network let check_policies vm res = let rec climb = function diff --git a/src/vmm_core.mli b/src/vmm_core.mli index 349760a..d373af9 100644 --- a/src/vmm_core.mli +++ b/src/vmm_core.mli @@ -39,20 +39,12 @@ module Name : sig end module Policy : sig - type bridge = - [ `External of string * Ipaddr.V4.t * Ipaddr.V4.t * Ipaddr.V4.t * int - | `Internal of string ] - - val equal_bridge : bridge -> bridge -> bool - - val pp_bridge : bridge Fmt.t - type t = { vms : int; cpuids : IS.t; memory : int; block : int option; - bridges : bridge Astring.String.Map.t; + bridges : Astring.String.Set.t; } val equal : t -> t -> bool @@ -78,7 +70,6 @@ module Vm : sig val pp_image : (vmtype * Cstruct.t) Fmt.t val pp_config : config Fmt.t - val good_bridge : string list -> 'a Astring.String.map -> bool val vm_matches_res : Policy.t -> config -> bool diff --git a/src/vmm_resources.ml b/src/vmm_resources.ml index 24f492b..9bcefc8 100644 --- a/src/vmm_resources.ml +++ b/src/vmm_resources.ml @@ -1,5 +1,7 @@ (* (c) 2017, 2018 Hannes Mehnert, all rights reserved *) +open Astring + open Vmm_core type res_entry = { @@ -136,7 +138,9 @@ let check_policy_below t name p = else None | Vm vm, Some p -> let cfg = vm.Vm.config in - if IS.mem cfg.Vm.cpuid p.Policy.cpuids && Vm.good_bridge cfg.Vm.network p.Policy.bridges + if + IS.mem cfg.Vm.cpuid p.Policy.cpuids && + List.for_all (fun net -> String.Set.mem net p.Policy.bridges) cfg.Vm.network then Some p else None | _, res -> res)