add policy does nothing when received policy is equal to stored one

src/vmm_core.ml

@@ -70,6 +70,20 @@ type bridge = [
   | `External of string * Ipaddr.V4.t * Ipaddr.V4.t * Ipaddr.V4.t * int
 ]
 
+let eq_int (a : int) (b : int) = a = b
+
+let eq_bridge b1 b2 = match b1, b2 with
+  | `Internal a, `Internal a' -> String.equal a a'
+  | `External (name, ip_start, ip_end, ip_gw, netmask),
+    `External (name', ip_start', ip_end', ip_gw', netmask') ->
+    let eq_ip a b = Ipaddr.V4.compare a b = 0 in
+    String.equal name name' &&
+    eq_ip ip_start ip_start' &&
+    eq_ip ip_end ip_end' &&
+    eq_ip ip_gw ip_gw' &&
+    eq_int netmask netmask'
+  | _ -> false
+
 let pp_bridge ppf = function
   | `Internal name -> Fmt.pf ppf "%s (internal)" name
   | `External (name, l, h, gw, nm) ->
@@ -84,6 +98,18 @@ type policy = {
   bridges : bridge String.Map.t ;
 }
 
+let eq_policy p1 p2 =
+  let eq_opt a b = match a, b with
+    | None, None -> true
+    | Some a, Some b -> eq_int a b
+    | _ -> false
+  in
+  eq_int p1.vms p2.vms &&
+  IS.equal p1.cpuids p2.cpuids &&
+  eq_int p1.memory p2.memory &&
+  eq_opt p1.block p2.block &&
+  String.Map.equal eq_bridge p1.bridges p2.bridges
+
 let pp_policy 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

src/vmm_core.mli

@@ -30,6 +30,9 @@ val pp_id : id Fmt.t
 type bridge =
   [ `External of string * Ipaddr.V4.t * Ipaddr.V4.t * Ipaddr.V4.t * int
   | `Internal of string ]
+
+val eq_bridge : bridge -> bridge -> bool
+
 val pp_bridge : bridge Fmt.t
 
 type policy = {
@@ -39,6 +42,9 @@ type policy = {
   block : int option;
   bridges : bridge Astring.String.Map.t;
 }
+
+val eq_policy : policy -> policy -> bool
+
 val pp_policy : policy Fmt.t
 
 val sub_bridges : bridge Astring.String.map -> bridge Astring.String.map -> bool

src/vmm_resources.ml

@@ -58,6 +58,10 @@ let find_vm t name = match Vmm_trie.find name t with
   | Some (Vm vm) -> Some vm
   | _ -> None
 
+let find_policy t name = match Vmm_trie.find name t with
+  | Some (Policy p) -> Some p
+  | _ -> None
+
 let check_vm_policy t name vm =
   let dom = domain name in
   let res = resource_usage t dom in

src/vmm_resources.mli

@@ -20,6 +20,9 @@ val empty : t
 (** [find_vm t id] is either [Some vm] or [None]. *)
 val find_vm : t -> Vmm_core.id -> Vmm_core.vm option
 
+(** [find_policy t id] is either [Some policy] or [None]. *)
+val find_policy : t -> Vmm_core.id -> Vmm_core.policy option
+
 (** [check_vm_policy t vm] checks whether [vm] under [id] in [t] would be
     allowed under the current policies. *)
 val check_vm_policy : t -> Vmm_core.id -> Vmm_core.vm_config -> bool

src/vmm_vmmd.ml

@@ -107,8 +107,15 @@ let handle_command t (header, payload) =
           Ok ({ t with resources }, [ reply (`String "removed policy") ], `End)
         | `Policy_add policy ->
           Logs.debug (fun m -> m "insert policy %a" pp_id id) ;
-          Vmm_resources.insert_policy t.resources id policy >>= fun resources ->
-          Ok ({ t with resources }, [ reply (`String "added policy") ], `End)
+          let same_policy = match Vmm_resources.find_policy t.resources id with
+            | None -> false
+            | Some p' -> eq_policy policy p'
+          in
+          if same_policy then
+            Ok (t, [ reply (`String "no modification of policy") ], `End)
+          else
+            Vmm_resources.insert_policy t.resources id policy >>= fun resources ->
+            Ok ({ t with resources }, [ reply (`String "added policy") ], `End)
         | `Policy_info ->
           begin
             Logs.debug (fun m -> m "policy %a" pp_id id) ;