rrdd: Avoid missing aggregation of metrics from newly destroyed domains

Currently rrdd needs to know when a metric comes from a newly created domain,
(after a local migration, for example). This is because when a new domain is
created the counters start from zero again. This needs special logic for
aggregating metrics since xcp-rrdd needs to provide continuity of metrics of a
VM with a UUID, even if the domid changes.

Previously rrdd fetched the data about domains before metrics from plugins
were collected, and reused the data for self-reported metrics. While this meant
that for self-reported metrics it was impossible to miss collected information,
for plugin metrics it meant that for created and destroyed domains, the
between between domain id and VM UUID was not available.

With the current change the domain ids and VM UUIDs are collected every
iteration of the monitor loop, and kept for one more iteration, so domains
destroyed in the last iteration are remembered and not missed.

With this done it's now safe to move the host and memory metrics collection
into its own plugin.

Also use sequences more thoroughly in the code for transformations

Signed-off-by: Pau Ruiz Safont <[email protected]>

Author: psafont

ocaml/xcp-rrdd/bin/rrdd/rrdd_monitor.ml

@@ -156,7 +156,6 @@ let convert_to_owner_map dss =
     weren't updated on this refresh cycle.
     *)
 let update_rrds uuid_domids plugins_dss =
-  let uuid_domids = List.to_seq uuid_domids |> StringMap.of_seq in
   let per_owner_flattened_map, per_plugin_map =
     convert_to_owner_map plugins_dss
   in

ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml

@@ -255,85 +255,124 @@ let mem_available () =
   let* size, kb = scan "/proc/meminfo" in
   match kb with "kB" -> ok size | _ -> res_error "unexpected unit: %s" kb
 
-let dss_mem_vms doms =
-  List.fold_left
-    (fun acc (dom, uuid, domid) ->
-      let add_vm_metrics () =
-        let kib =
-          Xenctrl.pages_to_kib
-            (Int64.of_nativeint dom.Xenctrl.total_memory_pages)
-        in
-        let memory = Int64.mul kib 1024L in
-        let main_mem_ds =
-          ( Rrd.VM uuid
-          , Ds.ds_make ~name:"memory"
-              ~description:"Memory currently allocated to VM" ~units:"B"
-              ~value:(Rrd.VT_Int64 memory) ~ty:Rrd.Gauge ~min:0.0 ~default:true
-              ()
-          )
-        in
-        let memory_target_opt =
-          with_lock Rrdd_shared.memory_targets_m (fun _ ->
-              Hashtbl.find_opt Rrdd_shared.memory_targets domid
-          )
-        in
-        let mem_target_ds =
-          Option.map
-            (fun memory_target ->
-              ( Rrd.VM uuid
-              , Ds.ds_make ~name:"memory_target"
-                  ~description:"Target of VM balloon driver" ~units:"B"
-                  ~value:(Rrd.VT_Int64 memory_target) ~ty:Rrd.Gauge ~min:0.0
-                  ~default:true ()
-              )
+let uuid_blacklist = ["00000000-0000-0000"; "deadbeef-dead-beef"]
+
+module IntSet = Set.Make (Int)
+
+let domain_snapshot xc =
+  let metadata_of_domain dom =
+    let ( let* ) = Option.bind in
+    let* uuid_raw = Uuidx.of_int_array dom.Xenctrl.handle in
+    let uuid = Uuidx.to_string uuid_raw in
+    let domid = dom.Xenctrl.domid in
+    let start = String.sub uuid 0 18 in
+    (* Actively hide migrating VM uuids, these are temporary and xenops writes
+       the original and the final uuid to xenstore *)
+    let uuid_from_key key =
+      let path = Printf.sprintf "/vm/%s/%s" uuid key in
+      try Ezxenstore_core.Xenstore.(with_xs (fun xs -> xs.read path))
+      with Xs_protocol.Enoent _hint ->
+        info "Couldn't read path %s; falling back to actual uuid" path ;
+        uuid
+    in
+    let stable_uuid = Option.fold ~none:uuid ~some:uuid_from_key in
+    if List.mem start uuid_blacklist then
+      None
+    else
+      let key =
+        if Astring.String.is_suffix ~affix:"000000000000" uuid then
+          Some "origin-uuid"
+        else if Astring.String.is_suffix ~affix:"000000000001" uuid then
+          Some "final-uuid"
+        else
+          None
+      in
+      Some (dom, stable_uuid key, domid)
+  in
+  let domains =
+    Xenctrl.domain_getinfolist xc 0 |> List.filter_map metadata_of_domain
+  in
+  let domids = List.map (fun (_, _, i) -> i) domains |> IntSet.of_list in
+  let domains_only k v = Option.map (Fun.const v) (IntSet.find_opt k domids) in
+  Hashtbl.filter_map_inplace domains_only Rrdd_shared.memory_targets ;
+  domains |> List.to_seq
+
+let dss_mem_vms xc =
+  let mem_metrics_of (dom, uuid, domid) =
+    let vm_metrics () =
+      let kib =
+        Xenctrl.pages_to_kib (Int64.of_nativeint dom.Xenctrl.total_memory_pages)
+      in
+      let memory = Int64.mul kib 1024L in
+      let main_mem_ds =
+        ( Rrd.VM uuid
+        , Ds.ds_make ~name:"memory"
+            ~description:"Memory currently allocated to VM" ~units:"B"
+            ~value:(Rrd.VT_Int64 memory) ~ty:Rrd.Gauge ~min:0.0 ~default:true ()
+        )
+      in
+      let memory_target_opt =
+        with_lock Rrdd_shared.memory_targets_m (fun _ ->
+            Hashtbl.find_opt Rrdd_shared.memory_targets domid
+        )
+      in
+      let mem_target_ds =
+        Option.map
+          (fun memory_target ->
+            ( Rrd.VM uuid
+            , Ds.ds_make ~name:"memory_target"
+                ~description:"Target of VM balloon driver" ~units:"B"
+                ~value:(Rrd.VT_Int64 memory_target) ~ty:Rrd.Gauge ~min:0.0
+                ~default:true ()
             )
-            memory_target_opt
-        in
-        let other_ds =
-          if domid = 0 then
-            match mem_available () with
-            | Ok mem ->
-                Some
-                  ( Rrd.VM uuid
-                  , Ds.ds_make ~name:"memory_internal_free" ~units:"KiB"
-                      ~description:"Dom0 current free memory"
-                      ~value:(Rrd.VT_Int64 mem) ~ty:Rrd.Gauge ~min:0.0
-                      ~default:true ()
-                  )
-            | Error msg ->
-                let _ =
-                  error "%s: retrieving  Dom0 free memory failed: %s"
-                    __FUNCTION__ msg
-                in
-                None
-          else
-            try
-              let mem_free =
-                Watch.IntMap.find domid !current_meminfofree_values
-              in
+          )
+          memory_target_opt
+      in
+      let other_ds =
+        if domid = 0 then
+          match mem_available () with
+          | Ok mem ->
               Some
                 ( Rrd.VM uuid
                 , Ds.ds_make ~name:"memory_internal_free" ~units:"KiB"
-                    ~description:"Memory used as reported by the guest agent"
-                    ~value:(Rrd.VT_Int64 mem_free) ~ty:Rrd.Gauge ~min:0.0
+                    ~description:"Dom0 current free memory"
+                    ~value:(Rrd.VT_Int64 mem) ~ty:Rrd.Gauge ~min:0.0
                     ~default:true ()
                 )
-            with Not_found -> None
-        in
+          | Error msg ->
+              let _ =
+                error "%s: retrieving  Dom0 free memory failed: %s" __FUNCTION__
+                  msg
+              in
+              None
+        else
+          try
+            let mem_free =
+              Watch.IntMap.find domid !current_meminfofree_values
+            in
+            Some
+              ( Rrd.VM uuid
+              , Ds.ds_make ~name:"memory_internal_free" ~units:"KiB"
+                  ~description:"Memory used as reported by the guest agent"
+                  ~value:(Rrd.VT_Int64 mem_free) ~ty:Rrd.Gauge ~min:0.0
+                  ~default:true ()
+              )
+          with Not_found -> None
+      in
+      let metrics =
         List.concat
-          [
-            main_mem_ds :: Option.to_list other_ds
-          ; Option.to_list mem_target_ds
-          ; acc
-          ]
+          [main_mem_ds :: Option.to_list other_ds; Option.to_list mem_target_ds]
       in
-      (* CA-34383: Memory updates from paused domains serve no useful purpose.
-         During a migrate such updates can also cause undesirable
-         discontinuities in the observed value of memory_actual. Hence, we
-         ignore changes from paused domains: *)
-      if dom.Xenctrl.paused then acc else add_vm_metrics ()
-    )
-    [] doms
+      Some (List.to_seq metrics)
+    in
+    (* CA-34383: Memory updates from paused domains serve no useful purpose.
+       During a migrate such updates can also cause undesirable
+       discontinuities in the observed value of memory_actual. Hence, we
+       ignore changes from paused domains: *)
+    if dom.Xenctrl.paused then None else vm_metrics ()
+  in
+  let domains = domain_snapshot xc in
+  Seq.filter_map mem_metrics_of domains |> Seq.concat |> List.of_seq
 
 (**** Local cache SR stuff *)
 
@@ -438,62 +477,18 @@ let handle_exn log f default =
       (Printexc.to_string e) ;
     default
 
-let uuid_blacklist = ["00000000-0000-0000"; "deadbeef-dead-beef"]
-
-module IntSet = Set.Make (Int)
-
-let domain_snapshot xc =
-  let metadata_of_domain dom =
-    let ( let* ) = Option.bind in
-    let* uuid_raw = Uuidx.of_int_array dom.Xenctrl.handle in
-    let uuid = Uuidx.to_string uuid_raw in
-    let domid = dom.Xenctrl.domid in
-    let start = String.sub uuid 0 18 in
-    (* Actively hide migrating VM uuids, these are temporary and xenops writes
-       the original and the final uuid to xenstore *)
-    let uuid_from_key key =
-      let path = Printf.sprintf "/vm/%s/%s" uuid key in
-      try Ezxenstore_core.Xenstore.(with_xs (fun xs -> xs.read path))
-      with Xs_protocol.Enoent _hint ->
-        info "Couldn't read path %s; falling back to actual uuid" path ;
-        uuid
-    in
-    let stable_uuid = Option.fold ~none:uuid ~some:uuid_from_key in
-    if List.mem start uuid_blacklist then
-      None
-    else
-      let key =
-        if Astring.String.is_suffix ~affix:"000000000000" uuid then
-          Some "origin-uuid"
-        else if Astring.String.is_suffix ~affix:"000000000001" uuid then
-          Some "final-uuid"
-        else
-          None
-      in
-      Some (dom, stable_uuid key, domid)
-  in
-  let domains =
-    Xenctrl.domain_getinfolist xc 0 |> List.filter_map metadata_of_domain
-  in
-  let domids = List.map (fun (_, _, i) -> i) domains |> IntSet.of_list in
-  let domains_only k v = Option.map (Fun.const v) (IntSet.find_opt k domids) in
-  Hashtbl.filter_map_inplace domains_only Rrdd_shared.memory_targets ;
-  domains
-
 let dom0_stat_generators =
   [
-    ("ha", fun _ _ _ -> Rrdd_ha_stats.all ())
-  ; ("mem_host", fun xc _ _ -> dss_mem_host xc)
-  ; ("mem_vms", fun _ _ domains -> dss_mem_vms domains)
-  ; ("cache", fun _ timestamp _ -> dss_cache timestamp)
+    ("ha", fun _ _ -> Rrdd_ha_stats.all ())
+  ; ("mem_host", fun xc _ -> dss_mem_host xc)
+  ; ("mem_vms", fun xc _ -> dss_mem_vms xc)
+  ; ("cache", fun _ timestamp -> dss_cache timestamp)
   ]
 
-let generate_all_dom0_stats xc domains =
+let generate_all_dom0_stats xc =
   let handle_generator (name, generator) =
     let timestamp = Unix.gettimeofday () in
-    ( name
-    , (timestamp, handle_exn name (fun _ -> generator xc timestamp domains) [])
-    )
+    (name, (timestamp, handle_exn name (fun _ -> generator xc timestamp) []))
   in
   List.map handle_generator dom0_stat_generators
 
@@ -510,10 +505,9 @@ let write_dom0_stats writers tagged_dss =
   in
   List.iter write_dss writers
 
-let do_monitor_write xc writers =
+let do_monitor_write domains_before xc writers =
   Rrdd_libs.Stats.time_this "monitor" (fun _ ->
-      let domains = domain_snapshot xc in
-      let tagged_dom0_stats = generate_all_dom0_stats xc domains in
+      let tagged_dom0_stats = generate_all_dom0_stats xc in
       write_dom0_stats writers tagged_dom0_stats ;
       let dom0_stats =
         tagged_dom0_stats
@@ -523,26 +517,34 @@ let do_monitor_write xc writers =
            )
       in
       let plugins_stats = Rrdd_server.Plugin.read_stats () in
+      let domains_after = domain_snapshot xc in
       let stats = Seq.append plugins_stats dom0_stats in
       Rrdd_stats.print_snapshot () ;
-      let uuid_domids = List.map (fun (_, u, i) -> (u, i)) domains in
-
+      (* merge the domain ids from the previous iteration and the current one
+         to avoid missing updates *)
+      let uuid_domids =
+        Seq.append domains_before domains_after
+        |> Seq.map (fun (_, u, i) -> (u, i))
+        |> Rrd.StringMap.of_seq
+      in
       (* stats are grouped per plugin, which provides its timestamp *)
       Rrdd_monitor.update_rrds uuid_domids stats ;
 
       Rrdd_libs.Constants.datasource_dump_file
       |> Rrdd_server.dump_host_dss_to_file ;
       Rrdd_libs.Constants.datasource_vm_dump_file
-      |> Rrdd_server.dump_vm_dss_to_file
+      |> Rrdd_server.dump_vm_dss_to_file ;
+      domains_after
   )
 
 let monitor_write_loop writers =
   Debug.with_thread_named "monitor_write"
     (fun () ->
       Xenctrl.with_intf (fun xc ->
+          let domains = ref Seq.empty in
           while true do
             try
-              do_monitor_write xc writers ;
+              domains := do_monitor_write !domains xc writers ;
               with_lock Rrdd_shared.next_iteration_start_m (fun _ ->
                   Rrdd_shared.next_iteration_start :=
                     Clock.Timer.extend_by !Rrdd_shared.timeslice

ocaml/xcp-rrdd/test/rrdd/test_rrdd_monitor.ml

@@ -74,60 +74,61 @@ let update_rrds_test ~timestamp ~dss ~uuid_domids ~expected_vm_rrds
 
 let update_rrds =
   let open Rrd in
+  let map_of_list ls = StringMap.of_seq (List.to_seq ls) in
   [
     ( "Null update"
-    , update_rrds_test ~timestamp:0. ~dss:[] ~uuid_domids:[]
+    , update_rrds_test ~timestamp:0. ~dss:[] ~uuid_domids:StringMap.empty
         ~expected_vm_rrds:[] ~expected_sr_rrds:[] ~expected_host_dss:[]
     )
   ; ( "Single host update"
     , update_rrds_test ~timestamp:0.
         ~dss:[(Host, ds_a)]
-        ~uuid_domids:[] ~expected_vm_rrds:[] ~expected_sr_rrds:[]
+        ~uuid_domids:StringMap.empty ~expected_vm_rrds:[] ~expected_sr_rrds:[]
         ~expected_host_dss:[("host", [ds_a])]
     )
   ; ( "Multiple host updates"
     , update_rrds_test ~timestamp:0.
         ~dss:[(Host, ds_a); (Host, ds_b)]
-        ~uuid_domids:[] ~expected_vm_rrds:[] ~expected_sr_rrds:[]
+        ~uuid_domids:StringMap.empty ~expected_vm_rrds:[] ~expected_sr_rrds:[]
         ~expected_host_dss:[("host", [ds_a; ds_b])]
     )
   ; ( "Single non-resident VM update"
     , update_rrds_test ~timestamp:0.
         ~dss:[(VM "a", ds_a)]
-        ~uuid_domids:[] ~expected_vm_rrds:[] ~expected_sr_rrds:[]
+        ~uuid_domids:StringMap.empty ~expected_vm_rrds:[] ~expected_sr_rrds:[]
         ~expected_host_dss:[]
     )
   ; ( "Multiple non-resident VM updates"
     , update_rrds_test ~timestamp:0.
         ~dss:[(VM "a", ds_a); (VM "b", ds_a)]
-        ~uuid_domids:[] ~expected_vm_rrds:[] ~expected_sr_rrds:[]
+        ~uuid_domids:StringMap.empty ~expected_vm_rrds:[] ~expected_sr_rrds:[]
         ~expected_host_dss:[]
     )
   ; ( "Single resident VM update"
     , update_rrds_test ~timestamp:0.
         ~dss:[(VM "a", ds_a)]
-        ~uuid_domids:[("a", 1)]
+        ~uuid_domids:(map_of_list [("a", 1)])
         ~expected_vm_rrds:[("a", [ds_a])]
         ~expected_sr_rrds:[] ~expected_host_dss:[]
     )
   ; ( "Multiple resident VM updates"
     , update_rrds_test ~timestamp:0.
         ~dss:[(VM "a", ds_a); (VM "b", ds_a); (VM "b", ds_b)]
-        ~uuid_domids:[("a", 1); ("b", 1)]
+        ~uuid_domids:(map_of_list [("a", 1); ("b", 1)])
         ~expected_vm_rrds:[("a", [ds_a]); ("b", [ds_a; ds_b])]
         ~expected_sr_rrds:[] ~expected_host_dss:[]
     )
   ; ( "Multiple resident and non-resident VM updates"
     , update_rrds_test ~timestamp:0.
         ~dss:[(VM "a", ds_a); (VM "b", ds_a); (VM "c", ds_a)]
-        ~uuid_domids:[("a", 1); ("b", 1)]
+        ~uuid_domids:(map_of_list [("a", 1); ("b", 1)])
         ~expected_vm_rrds:[("a", [ds_a]); ("b", [ds_a])]
         ~expected_sr_rrds:[] ~expected_host_dss:[]
     )
   ; ( "Multiple SR updates"
     , update_rrds_test ~timestamp:0.
         ~dss:[(SR "a", ds_a); (SR "b", ds_a); (SR "b", ds_b)]
-        ~uuid_domids:[] ~expected_vm_rrds:[]
+        ~uuid_domids:StringMap.empty ~expected_vm_rrds:[]
         ~expected_sr_rrds:[("a", [ds_a]); ("b", [ds_a; ds_b])]
         ~expected_host_dss:[]
     )