diff --git a/src/vmm_core.ml b/src/vmm_core.ml index 43243ee..1edf505 100644 --- a/src/vmm_core.ml +++ b/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 diff --git a/src/vmm_core.mli b/src/vmm_core.mli index a464914..0db3d44 100644 --- a/src/vmm_core.mli +++ b/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 diff --git a/src/vmm_resources.ml b/src/vmm_resources.ml index abb37f1..0bfdd3a 100644 --- a/src/vmm_resources.ml +++ b/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 diff --git a/src/vmm_resources.mli b/src/vmm_resources.mli index aa5a162..607e6eb 100644 --- a/src/vmm_resources.mli +++ b/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 diff --git a/src/vmm_vmmd.ml b/src/vmm_vmmd.ml index 8976260..33e813c 100644 --- a/src/vmm_vmmd.ml +++ b/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) ;