refactor bridge: use a string instead of a complicated thing

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

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

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

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
 

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)