From 8ab37d6b3b1737cf826b54282f514ed324c54df6 Mon Sep 17 00:00:00 2001
From: Hannes Mehnert <hannes@mehnert.org>
Date: Sun, 28 Oct 2018 19:50:48 +0100
Subject: [PATCH] resources: remove_vm and remove_policy - no need to
 intertwine into a single remove

---
 src/vmm_resources.ml  | 10 ++++++++--
 src/vmm_resources.mli |  7 +++++--
 src/vmm_vmmd.ml       | 11 ++++++++---
 3 files changed, 21 insertions(+), 7 deletions(-)

diff --git a/src/vmm_resources.ml b/src/vmm_resources.ml
index 0bfdd3a..4df3791 100644
--- a/src/vmm_resources.ml
+++ b/src/vmm_resources.ml
@@ -36,8 +36,6 @@ let pp ppf t =
 
 let empty = Vmm_trie.empty
 
-let remove t name = Vmm_trie.remove name t
-
 let fold t name f g acc =
   Vmm_trie.fold name t (fun prefix entry acc ->
       match entry with
@@ -62,6 +60,14 @@ let find_policy t name = match Vmm_trie.find name t with
   | Some (Policy p) -> Some p
   | _ -> None
 
+let remove_vm t name =  match find_vm t name with
+  | None -> Error (`Msg "unknown vm")
+  | Some _ -> Ok (Vmm_trie.remove name t)
+
+let remove_policy t name = match find_policy t name with
+  | None -> Error (`Msg "unknown policy")
+  | Some _ -> Ok (Vmm_trie.remove name t)
+
 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 607e6eb..a0eb877 100644
--- a/src/vmm_resources.mli
+++ b/src/vmm_resources.mli
@@ -35,8 +35,11 @@ val insert_vm : t -> Vmm_core.id -> Vmm_core.vm -> (t, [> `Msg of string]) resul
    the new [t] or an error. *)
 val insert_policy : t -> Vmm_core.id -> Vmm_core.policy -> (t, [> `Msg of string]) result
 
-(** [remove t id] removes [id] from [t]. *)
-val remove : t -> Vmm_core.id -> t
+(** [remove_vm t id] removes vm [id] from [t]. *)
+val remove_vm : t -> Vmm_core.id -> (t, [> `Msg of string ]) result
+
+(** [remove_policy t id] removes policy [id] from [t]. *)
+val remove_policy : t -> Vmm_core.id -> (t, [> `Msg of string ]) result
 
 (** [fold t id f g acc] folds [f] and [g] below [id] over [t]. *)
 val fold : t -> Vmm_core.id ->
diff --git a/src/vmm_vmmd.ml b/src/vmm_vmmd.ml
index 33e813c..fd6cead 100644
--- a/src/vmm_vmmd.ml
+++ b/src/vmm_vmmd.ml
@@ -80,7 +80,12 @@ let handle_shutdown t name vm r =
   (match Vmm_unix.shutdown name vm with
    | Ok () -> ()
    | Error (`Msg e) -> Logs.warn (fun m -> m "%s while shutdown vm %a" e pp_vm vm)) ;
-  let resources = Vmm_resources.remove t.resources name in
+  let resources = match Vmm_resources.remove_vm t.resources name with
+    | Error (`Msg e) ->
+      Logs.warn (fun m -> m "%s while removing vm %a from resources" e pp_vm vm) ;
+      t.resources
+    | Ok resources -> resources
+  in
   let header = Vmm_commands.{ version = t.wire_version ; sequence = t.stats_counter ; id = name } in
   let tasks = String.Map.remove (string_of_id name) t.tasks in
   let t = { t with stats_counter = Int64.succ t.stats_counter ; resources ; tasks } in
@@ -103,7 +108,7 @@ let handle_command t (header, payload) =
       begin match pc with
         | `Policy_remove ->
           Logs.debug (fun m -> m "remove policy %a" pp_id header.Vmm_commands.id) ;
-          let resources = Vmm_resources.remove t.resources id in
+          Vmm_resources.remove_policy t.resources id >>= fun resources ->
           Ok ({ t with resources }, [ reply (`String "removed policy") ], `End)
         | `Policy_add policy ->
           Logs.debug (fun m -> m "insert policy %a" pp_id id) ;
@@ -153,7 +158,7 @@ let handle_command t (header, payload) =
         | `Vm_create vm_config ->
           handle_create t header vm_config
         | `Vm_force_create vm_config ->
-          let resources = Vmm_resources.remove t.resources id in
+          Vmm_resources.remove_vm t.resources id >>= fun resources ->
           if Vmm_resources.check_vm_policy resources id vm_config then
             begin match Vmm_resources.find_vm t.resources id with
               | None -> handle_create t header vm_config