virt-top/SOURCES/0017-Use-virConnectGetAllDomainStats-API-to-collect-domai.patch

From 74971ed8c85400929714a7adff5b61c2ebe9fcee Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
Date: Tue, 28 Mar 2017 13:30:07 +0100
Subject: [PATCH 17/23] Use virConnectGetAllDomainStats API to collect domain
 stats (RHBZ#1422795).

This is much faster than using the basic libvirt APIs to collect
stats for each domain individually.

Note this will not work unless you have the latest ocaml-libvirt
package which includes this new API binding.
---
 src/collect.ml  | 242 +++++++++++++++++++++++++++++++++++-------------
 src/collect.mli |   1 +
 src/utils.ml    |   6 ++
 src/utils.mli   |   3 +
 4 files changed, 190 insertions(+), 62 deletions(-)

diff --git a/src/collect.ml b/src/collect.ml
index 448ce8c..a1e50a1 100644
--- a/src/collect.ml
+++ b/src/collect.ml
@@ -38,6 +38,7 @@ let parse_device_xml : (int -> [>`R] D.t -> string list * string list) ref =
 type rd_domain = Inactive | Active of rd_active
 and rd_active = {
   rd_domid : int;			(* Domain ID. *)
+  rd_domuuid : Libvirt.uuid;            (* Domain UUID. *)
   rd_dom : [`R] D.t;			(* Domain object. *)
   rd_info : D.info;			(* Domain CPU info now. *)
   rd_block_stats : (string * D.block_stats) list;
@@ -110,6 +111,16 @@ let last_pcpu_usages = Hashtbl.create 13
 let clear_pcpu_display_data () =
   Hashtbl.clear last_pcpu_usages
 
+(* What to get from virConnectGetAllDomainStats. *)
+let what = [
+  D.StatsState; D.StatsCpuTotal; D.StatsBalloon; D.StatsVcpu;
+  D.StatsInterface; D.StatsBlock
+]
+(* Which domains to get.  Empty list means return all domains:
+ * active, inactive, persistent, transient etc.
+ *)
+let who = []
+
 let collect (conn, _, _, _, _, node_info, _, _) =
   (* Number of physical CPUs (some may be disabled). *)
   let nr_pcpus = C.maxcpus_of_node_info node_info in
@@ -129,72 +140,179 @@ let collect (conn, _, _, _, _, node_info, _, _) =
 
   (* Get the domains.  Match up with their last_info (if any). *)
   let doms =
-    (* Active domains. *)
-    let n = C.num_of_domains conn in
-    let ids =
-      if n > 0 then Array.to_list (C.list_domains conn n)
-      else [] in
-    let doms =
-      List.filter_map (
-	fun id ->
-	  try
-	    let dom = D.lookup_by_id conn id in
-	    let name = D.get_name dom in
-	    let blkdevs, netifs = get_devices id dom in
+    let doms = D.get_all_domain_stats conn what who in
+    let doms = Array.to_list doms in
+    List.map (
+      fun { D.dom_uuid = uuid; D.params = params } ->
+        let nr_params = Array.length params in
+        let get_param name =
+          let rec loop i =
+            if i = nr_params then None
+            else if fst params.(i) = name then Some (snd params.(i))
+            else loop (i+1)
+          in
+          loop 0
+        in
+        let get_param_int name default =
+          match get_param name with
+          | None -> None
+          | Some (D.TypedFieldInt32 i)
+          | Some (D.TypedFieldUInt32 i) -> Some (Int32.to_int i)
+          | Some (D.TypedFieldInt64 i)
+          | Some (D.TypedFieldUInt64 i) -> Some (Int64.to_int i)
+          | _ -> default
+        in
+        let get_param_int64 name default =
+          match get_param name with
+          | None -> None
+          | Some (D.TypedFieldInt32 i)
+          | Some (D.TypedFieldUInt32 i) -> Some (Int64.of_int32 i)
+          | Some (D.TypedFieldInt64 i)
+          | Some (D.TypedFieldUInt64 i) -> Some i
+          | _ -> default
+        in
 
-	    (* Get current CPU, block and network stats. *)
-	    let info = D.get_info dom in
-	    let block_stats =
-	      try List.map (fun dev -> dev, D.block_stats dom dev) blkdevs
-	      with
-	      | Libvirt.Not_supported "virDomainBlockStats"
-	      | Libvirt.Virterror _ -> [] in
-	    let interface_stats =
-	      try List.map (fun dev -> dev, D.interface_stats dom dev) netifs
-	      with
-	      | Libvirt.Not_supported "virDomainInterfaceStats"
-	      | Libvirt.Virterror _ -> [] in
+        let dom = D.lookup_by_uuid conn uuid in
+        let id = D.get_id dom in
+        let name = D.get_name dom in
+        let state = get_param_int "state.state" None in
 
-	    let prev_info, prev_block_stats, prev_interface_stats =
-	      try
-		let prev_info, prev_block_stats, prev_interface_stats =
-		  Hashtbl.find last_info id in
-		Some prev_info, prev_block_stats, prev_interface_stats
-	      with Not_found -> None, [], [] in
+        if state = Some 5 (* VIR_DOMAIN_SHUTOFF *) then
+          (name, Inactive)
+        else (
+          (* Active domain. *)
 
-	    Some (name,
-                  Active {
-		      rd_domid = id; rd_dom = dom; rd_info = info;
-		      rd_block_stats = block_stats;
-		      rd_interface_stats = interface_stats;
-		      rd_prev_info = prev_info;
-		      rd_prev_block_stats = prev_block_stats;
-		      rd_prev_interface_stats = prev_interface_stats;
-		      rd_cpu_time = 0.; rd_percent_cpu = 0.;
-                      rd_mem_bytes = 0L; rd_mem_percent = 0L;
-		      rd_block_rd_reqs = None; rd_block_wr_reqs = None;
-                      rd_block_rd_bytes = None; rd_block_wr_bytes = None;
-		      rd_net_rx_bytes = None; rd_net_tx_bytes = None;
-		    })
-	  with
-	    Libvirt.Virterror _ -> None (* ignore transient error *)
-      ) ids in
+          (* Synthesize a D.info struct out of the data we have
+           * from virConnectGetAllDomainStats.  Doing this is an
+           * artifact from the old APIs we used to use to fetch
+           * stats, we could simplify here, and also return the
+           * RSS memory. XXX
+           *)
+          let state =
+            match state with
+            | None | Some 0 -> D.InfoNoState
+            | Some 1 -> D.InfoRunning
+            | Some 2 -> D.InfoBlocked
+            | Some 3 -> D.InfoPaused
+            | Some 4 -> D.InfoShutdown
+            | Some 5 -> D.InfoShutoff
+            | Some 6 -> D.InfoCrashed
+            | Some 7 -> D.InfoPaused (* XXX really VIR_DOMAIN_PMSUSPENDED *)
+            | _ -> D.InfoNoState in
+          let memory =
+            match get_param_int64 "balloon.current" None with
+            | None -> 0_L
+            | Some m -> m in
+          let nr_virt_cpu =
+            match get_param_int "vcpu.current" None with
+            | None -> 1
+            | Some v -> v in
+          let cpu_time =
+            (* NB: libvirt does not return cpu.time for non-root domains. *)
+            match get_param_int64 "cpu.time" None with
+            | None -> 0_L
+            | Some ns -> ns in
+          let info = {
+            D.state = state;
+            max_mem = -1_L; (* not used anywhere in virt-top *)
+            memory = memory;
+            nr_virt_cpu = nr_virt_cpu;
+            cpu_time = cpu_time
+          } in
 
-    (* Inactive domains. *)
-    let doms_inactive =
-      try
-	let n = C.num_of_defined_domains conn in
-	let names =
-	  if n > 0 then Array.to_list (C.list_defined_domains conn n)
-	  else [] in
-	List.map (fun name -> name, Inactive) names
-      with
-      (* Ignore transient errors, in particular errors from
-       * num_of_defined_domains if it cannot contact xend.
-       *)
-      | Libvirt.Virterror _ -> [] in
+          let nr_block_devs =
+            match get_param_int "block.count" None with
+            | None -> 0
+            | Some i -> i in
+          let block_stats =
+            List.map (
+              fun i ->
+              let dev =
+                match get_param (sprintf "block.%d.name" i) with
+                | None -> sprintf "blk%d" i
+                | Some (D.TypedFieldString s) -> s
+                | _ -> assert false in
+              dev, {
+                D.rd_req =
+                  (match get_param_int64 (sprintf "block.%d.rd.reqs" i) None
+                   with None -> 0_L | Some v -> v);
+                rd_bytes =
+                  (match get_param_int64 (sprintf "block.%d.rd.bytes" i) None
+                   with None -> 0_L | Some v -> v);
+                wr_req =
+                  (match get_param_int64 (sprintf "block.%d.wr.reqs" i) None
+                   with None -> 0_L | Some v -> v);
+                wr_bytes =
+                  (match get_param_int64 (sprintf "block.%d.wr.bytes" i) None
+                   with None -> 0_L | Some v -> v);
+                errs = 0_L
+              }
+            ) (range 0 (nr_block_devs-1)) in
 
-    doms @ doms_inactive in
+          let nr_interface_devs =
+            match get_param_int "net.count" None with
+            | None -> 0
+            | Some i -> i in
+          let interface_stats =
+            List.map (
+              fun i ->
+              let dev =
+                match get_param (sprintf "net.%d.name" i) with
+                | None -> sprintf "net%d" i
+                | Some (D.TypedFieldString s) -> s
+                | _ -> assert false in
+              dev, {
+                D.rx_bytes =
+                  (match get_param_int64 (sprintf "net.%d.rx.bytes" i) None
+                   with None -> 0_L | Some v -> v);
+                rx_packets =
+                  (match get_param_int64 (sprintf "net.%d.rx.pkts" i) None
+                   with None -> 0_L | Some v -> v);
+                rx_errs =
+                  (match get_param_int64 (sprintf "net.%d.rx.errs" i) None
+                   with None -> 0_L | Some v -> v);
+                rx_drop =
+                  (match get_param_int64 (sprintf "net.%d.rx.drop" i) None
+                   with None -> 0_L | Some v -> v);
+                tx_bytes =
+                  (match get_param_int64 (sprintf "net.%d.tx.bytes" i) None
+                   with None -> 0_L | Some v -> v);
+                tx_packets =
+                  (match get_param_int64 (sprintf "net.%d.tx.pkts" i) None
+                   with None -> 0_L | Some v -> v);
+                tx_errs =
+                  (match get_param_int64 (sprintf "net.%d.tx.errs" i) None
+                   with None -> 0_L | Some v -> v);
+                tx_drop =
+                  (match get_param_int64 (sprintf "net.%d.tx.drop" i) None
+                   with None -> 0_L | Some v -> v);
+              }
+            ) (range 0 (nr_interface_devs-1)) in
+
+	  let prev_info, prev_block_stats, prev_interface_stats =
+	    try
+	      let prev_info, prev_block_stats, prev_interface_stats =
+		Hashtbl.find last_info uuid in
+	      Some prev_info, prev_block_stats, prev_interface_stats
+	    with Not_found -> None, [], [] in
+
+	  (name,
+           Active {
+	     rd_domid = id; rd_domuuid = uuid; rd_dom = dom;
+             rd_info = info;
+	     rd_block_stats = block_stats;
+	     rd_interface_stats = interface_stats;
+	     rd_prev_info = prev_info;
+	     rd_prev_block_stats = prev_block_stats;
+	     rd_prev_interface_stats = prev_interface_stats;
+	     rd_cpu_time = 0.; rd_percent_cpu = 0.;
+             rd_mem_bytes = 0L; rd_mem_percent = 0L;
+	     rd_block_rd_reqs = None; rd_block_wr_reqs = None;
+             rd_block_rd_bytes = None; rd_block_wr_bytes = None;
+	     rd_net_rx_bytes = None; rd_net_tx_bytes = None;
+	   })
+        )
+    ) doms in
 
   (* Calculate the CPU time (ns) and %CPU used by each domain. *)
   let doms =
@@ -329,7 +447,7 @@ let collect (conn, _, _, _, _, node_info, _, _) =
     function
     | (_, Active rd) ->
        let info = rd.rd_info, rd.rd_block_stats, rd.rd_interface_stats in
-       Hashtbl.add last_info rd.rd_domid info
+       Hashtbl.add last_info rd.rd_domuuid info
     | _ -> ()
   ) doms;
 
diff --git a/src/collect.mli b/src/collect.mli
index 9ad3dcb..3c5492f 100644
--- a/src/collect.mli
+++ b/src/collect.mli
@@ -27,6 +27,7 @@ val parse_device_xml :
 type rd_domain = Inactive | Active of rd_active
 and rd_active = {
   rd_domid : int;			(* Domain ID. *)
+  rd_domuuid : Libvirt.uuid;            (* Domain UUID. *)
   rd_dom : [`R] Libvirt.Domain.t;       (* Domain object. *)
   rd_info : Libvirt.Domain.info;        (* Domain CPU info now. *)
   rd_block_stats : (string * Libvirt.Domain.block_stats) list;
diff --git a/src/utils.ml b/src/utils.ml
index 5fcc905..4332ff7 100644
--- a/src/utils.ml
+++ b/src/utils.ml
@@ -32,6 +32,12 @@ let (/^) = Int64.div
 (* failwithf is a printf-like version of failwith. *)
 let failwithf fs = ksprintf failwith fs
 
+let rec range a b =
+  if a <= b then
+    a :: range (a+1) b
+  else
+    []
+
 (* Input a whole file as a list of lines. *)
 let input_all_lines chan =
   let lines = ref [] in
diff --git a/src/utils.mli b/src/utils.mli
index 6e81215..3c966f8 100644
--- a/src/utils.mli
+++ b/src/utils.mli
@@ -25,6 +25,9 @@ val (//) : string -> string -> string
 (* failwithf is a printf-like version of failwith. *)
 val failwithf : ('a, unit, string, 'b) format4 -> 'a
 
+(* Return the list of integers [a..b] (inclusive). *)
+val range : int -> int -> int list
+
 (* Read a configuration file as a list of (lineno, key, value) pairs.
  * If the config file is missing this returns an empty list.
  *)
-- 
2.31.1