Split up huge Top module into smaller modules.
authorRichard W.M. Jones <rjones@redhat.com>
Mon, 27 Mar 2017 14:29:23 +0000 (15:29 +0100)
committerRichard W.M. Jones <rjones@redhat.com>
Mon, 27 Mar 2017 20:06:02 +0000 (21:06 +0100)
This change is hopefully pure refactoring, splitting up the very large
and highly interlinked module into more manageable modules with
well-defined (or at least *better*-defined) interfaces between them.

23 files changed:
MANIFEST
po/POTFILES
src/.depend
src/Makefile.in
src/README
src/collect.ml [new file with mode: 0644]
src/collect.mli [new file with mode: 0644]
src/csv_output.ml [new file with mode: 0644]
src/csv_output.mli [new file with mode: 0644]
src/opt_csv.ml
src/opt_xml.ml
src/redraw.ml [new file with mode: 0644]
src/redraw.mli [new file with mode: 0644]
src/screen.ml [new file with mode: 0644]
src/screen.mli [new file with mode: 0644]
src/stream_output.ml [new file with mode: 0644]
src/stream_output.mli [new file with mode: 0644]
src/top.ml
src/top.mli
src/types.ml [new file with mode: 0644]
src/types.mli [new file with mode: 0644]
src/utils.ml
src/utils.mli

index 26e87b2..4e4014b 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -54,12 +54,24 @@ TODO
 src/.depend
 src/Makefile.in
 src/README
+src/collect.ml
+src/collect.mli
+src/csv_output.ml
+src/csv_output.mli
 src/main.ml
 src/opt_calendar.ml
 src/opt_csv.ml
 src/opt_xml.ml
+src/redraw.ml
+src/redraw.mli
+src/screen.ml
+src/screen.mli
+src/stream_output.ml
+src/stream_output.mli
 src/top.ml
 src/top.mli
+src/types.ml
+src/types.mli
 src/utils.ml
 src/utils.mli
 src/version.ml.in
index b826a2a..6150703 100644 (file)
@@ -1,8 +1,14 @@
+../src/collect.ml
+../src/csv_output.ml
 ../src/main.ml
 ../src/opt_calendar.ml
 ../src/opt_csv.ml
 ../src/opt_gettext.ml
 ../src/opt_xml.ml
+../src/redraw.ml
+../src/screen.ml
+../src/stream.ml
 ../src/top.ml
+../src/types.ml
 ../src/utils.ml
 ../src/version.ml
index f487c18..1075f36 100644 (file)
@@ -1,18 +1,36 @@
+collect.cmi: types.cmi
+collect.cmo: utils.cmi types.cmi collect.cmi
+collect.cmx: utils.cmx types.cmx collect.cmi
+csv_output.cmi: types.cmi collect.cmi
+csv_output.cmo: collect.cmi csv_output.cmi
+csv_output.cmx: collect.cmx csv_output.cmi
 main.cmo: top.cmi opt_gettext.cmo
 main.cmx: top.cmx opt_gettext.cmx
 opt_calendar.cmo: top.cmi opt_gettext.cmo
 opt_calendar.cmx: top.cmx opt_gettext.cmx
-opt_csv.cmo: top.cmi opt_gettext.cmo
-opt_csv.cmx: top.cmx opt_gettext.cmx
+opt_csv.cmo: top.cmi opt_gettext.cmo csv_output.cmi
+opt_csv.cmx: top.cmx opt_gettext.cmx csv_output.cmx
 opt_gettext.cmo:
 opt_gettext.cmx:
-opt_xml.cmo: top.cmi opt_gettext.cmo
-opt_xml.cmx: top.cmx opt_gettext.cmx
-top.cmi:
-top.cmo: version.cmo utils.cmi opt_gettext.cmo top.cmi
-top.cmx: version.cmx utils.cmx opt_gettext.cmx top.cmi
+opt_xml.cmo: opt_gettext.cmo collect.cmi
+opt_xml.cmx: opt_gettext.cmx collect.cmx
+redraw.cmi: types.cmi collect.cmi
+redraw.cmo: utils.cmi types.cmi screen.cmi opt_gettext.cmo collect.cmi redraw.cmi
+redraw.cmx: utils.cmx types.cmx screen.cmx opt_gettext.cmx collect.cmx redraw.cmi
+screen.cmi:
+screen.cmo: screen.cmi
+screen.cmx: screen.cmi
+stream_output.cmi: types.cmi collect.cmi
+stream_output.cmo: utils.cmi screen.cmi collect.cmi stream_output.cmi
+stream_output.cmx: utils.cmx screen.cmx collect.cmx stream_output.cmi
+top.cmi: types.cmi
+top.cmo: version.cmo utils.cmi types.cmi stream_output.cmi screen.cmi redraw.cmi opt_gettext.cmo csv_output.cmi collect.cmi top.cmi
+top.cmx: version.cmx utils.cmx types.cmx stream_output.cmx screen.cmx redraw.cmx opt_gettext.cmx csv_output.cmx collect.cmx top.cmi
+types.cmi:
+types.cmo: utils.cmi opt_gettext.cmo types.cmi
+types.cmx: utils.cmx opt_gettext.cmx types.cmi
 utils.cmi:
-utils.cmo: opt_gettext.cmo utils.cmi
-utils.cmx: opt_gettext.cmx utils.cmi
+utils.cmo: utils.cmi
+utils.cmx: utils.cmi
 version.cmo:
 version.cmx:
index ae896cb..64f431e 100644 (file)
@@ -42,6 +42,12 @@ OBJS         := \
                   version.cmo \
                   opt_gettext.cmo \
                   utils.cmo \
+                  types.cmo \
+                  collect.cmo \
+                  screen.cmo \
+                  redraw.cmo \
+                  csv_output.cmo \
+                  stream_output.cmo \
                   top.cmo
 ifneq ($(OCAML_PKG_xml_light),no)
 OBJS           += opt_xml.cmo
index 8aa2348..1fd4be3 100644 (file)
@@ -5,19 +5,37 @@ The code is structured into these files:
     String functions and other small utility functions.  This is
     included directly into virt_top.ml.
 
-  top.mli, top.ml
+  types.mli, types.ml
 
-    This is the virt-top program.
+    Various internally used types and functions operating on those
+    types.
+
+  collect.mli, collect.ml
+
+    Stats information is collected in these functions.
+
+  screen.mli, screen.ml
+
+    Various useful functions for drawing to the curses screen.
+
+  redraw.mli, redraw.ml
 
-    The two interesting functions are called 'collect' and 'redraw'.
+    Redraw the main display.
 
-    'collect' collects all the information about domains, etc.
+  csv_output.mli, csv_output.ml
 
-    'redraw' updates the display on each frame.
+    Functions which implement --csv mode.
+
+  stream_output.mli, stream_output.ml
+
+    Functions which implement --stream mode.
+
+  top.mli, top.ml
+
+    This is the virt-top program.
 
-    Another interesting function is 'start_up' which handles all
-    start-up stuff, eg. command line arguments, connecting to the
-    hypervisor, enabling curses.
+    'start_up' handles all start-up stuff, eg. command line arguments,
+    connecting to the hypervisor, enabling curses.
 
     The function 'main_loop' runs the main loop and has sub-functions
     to deal with keypresses, help screens and so on.
@@ -38,7 +56,7 @@ The code is structured into these files:
   opt_csv.ml
 
     Any code which needs the optional ocaml-csv library goes
-    in here.  This implements the --csv command line option.
+    in here.
 
   opt_calendar.ml
 
diff --git a/src/collect.ml b/src/collect.ml
new file mode 100644 (file)
index 0000000..f856067
--- /dev/null
@@ -0,0 +1,455 @@
+(* 'top'-like tool for libvirt domains.
+   (C) Copyright 2007-2017 Richard W.M. Jones, Red Hat Inc.
+   http://libvirt.org/
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU General Public License as published by
+   the Free Software Foundation; either version 2 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   along with this program; if not, write to the Free Software
+   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+*)
+
+module C = Libvirt.Connect
+module D = Libvirt.Domain
+
+open Printf
+open ExtList
+
+open Utils
+open Types
+
+(* Hook for XML support (see [opt_xml.ml]). *)
+let parse_device_xml : (int -> [>`R] D.t -> string list * string list) ref =
+  ref (
+    fun _ _ -> [], []
+  )
+
+(* Intermediate "domain + stats" structure that we use to collect
+ * everything we know about a domain within the collect function.
+ *)
+type rd_domain = Inactive | Active of rd_active
+and rd_active = {
+  rd_domid : int;                      (* Domain ID. *)
+  rd_dom : [`R] D.t;                   (* Domain object. *)
+  rd_info : D.info;                    (* Domain CPU info now. *)
+  rd_block_stats : (string * D.block_stats) list;
+                                        (* Domain block stats now. *)
+  rd_interface_stats : (string * D.interface_stats) list;
+                                        (* Domain net stats now. *)
+  rd_prev_info : D.info option;                (* Domain CPU info previously. *)
+  rd_prev_block_stats : (string * D.block_stats) list;
+                                        (* Domain block stats prev. *)
+  rd_prev_interface_stats : (string * D.interface_stats) list;
+                                        (* Domain interface stats prev. *)
+  (* The following are since the last slice, or 0 if cannot be calculated: *)
+  rd_cpu_time : float;                 (* CPU time used in nanoseconds. *)
+  rd_percent_cpu : float;              (* CPU time as percent of total. *)
+  rd_mem_bytes : int64;                        (* Memory usage in bytes *)
+  rd_mem_percent: int64;               (* Memory usage as percent of total *)
+  (* The following are since the last slice, or None if cannot be calc'd: *)
+  rd_block_rd_reqs : int64 option;      (* Number of block device read rqs. *)
+  rd_block_wr_reqs : int64 option;      (* Number of block device write rqs. *)
+  rd_block_rd_bytes : int64 option;   (* Number of bytes block device read *)
+  rd_block_wr_bytes : int64 option;   (* Number of bytes block device write *)
+  (* _info fields includes the number considering --block_in_bytes option *)
+  rd_block_rd_info : int64 option;    (* Block device read info for user *)
+  rd_block_wr_info : int64 option;    (* Block device read info for user *)
+
+  rd_net_rx_bytes : int64 option;      (* Number of bytes received. *)
+  rd_net_tx_bytes : int64 option;      (* Number of bytes transmitted. *)
+}
+
+type stats = {
+  rd_doms : (string * rd_domain) list;  (* List of domains. *)
+  rd_time : float;
+  rd_printable_time : string;
+  rd_nr_pcpus : int;
+  rd_total_cpu : float;
+  rd_total_cpu_per_pcpu : float;
+  rd_totals : (int * int * int * int * int * int * int * int * int * float *
+                 int64 * int64);
+}
+
+type pcpu_stats = {
+  rd_pcpu_doms : (int * string * int *
+                  Libvirt.Domain.vcpu_info array * int64 array array *
+                  int64 array array * string * int) list;
+  rd_pcpu_pcpus : int64 array array array;
+  rd_pcpu_pcpus_cpu_time : float array
+}
+
+(* We cache the list of block devices and interfaces for each domain
+ * here, so we don't need to reparse the XML each time.
+ *)
+let devices = Hashtbl.create 13
+
+(* Function to get the list of block devices, network interfaces for
+ * a particular domain.  Get it from the devices cache, and if not
+ * there then parse the domain XML.
+ *)
+let get_devices id dom =
+  try Hashtbl.find devices id
+  with Not_found ->
+    let blkdevs, netifs = (!parse_device_xml) id dom in
+    Hashtbl.replace devices id (blkdevs, netifs);
+    blkdevs, netifs
+
+(* We save the state of domains across redraws here, which allows us
+ * to deduce %CPU usage from the running total.
+ *)
+let last_info = Hashtbl.create 13
+let last_time = ref (Unix.gettimeofday ())
+
+(* Save pcpu_usages structures across redraws too (only for pCPU display). *)
+let last_pcpu_usages = Hashtbl.create 13
+
+let clear_pcpu_display_data () =
+  Hashtbl.clear last_pcpu_usages
+
+let collect (conn, _, _, _, _, node_info, _, _) block_in_bytes =
+  (* Number of physical CPUs (some may be disabled). *)
+  let nr_pcpus = C.maxcpus_of_node_info node_info in
+
+  (* Get the current time. *)
+  let time = Unix.gettimeofday () in
+  let tm = Unix.localtime time in
+  let printable_time =
+    sprintf "%02d:%02d:%02d" tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec in
+
+  (* What's the total CPU time elapsed since we were last called? (ns) *)
+  let total_cpu_per_pcpu = 1_000_000_000. *. (time -. !last_time) in
+  (* Avoid division by zero. *)
+  let total_cpu_per_pcpu =
+    if total_cpu_per_pcpu <= 0. then 1. else total_cpu_per_pcpu in
+  let total_cpu = float node_info.C.cpus *. total_cpu_per_pcpu in
+
+  (* 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
+
+           (* 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 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
+
+           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_block_rd_info = None; rd_block_wr_info = None;
+                     rd_net_rx_bytes = None; rd_net_tx_bytes = None;
+                   })
+         with
+           Libvirt.Virterror _ -> None (* ignore transient error *)
+      ) ids 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
+
+    doms @ doms_inactive in
+
+  (* Calculate the CPU time (ns) and %CPU used by each domain. *)
+  let doms =
+    List.map (
+      function
+      (* We have previous CPU info from which to calculate it? *)
+      | name, Active ({ rd_prev_info = Some prev_info } as rd) ->
+        let cpu_time =
+          Int64.to_float (rd.rd_info.D.cpu_time -^ prev_info.D.cpu_time) in
+        let percent_cpu = 100. *. cpu_time /. total_cpu in
+         let mem_usage = rd.rd_info.D.memory in
+         let mem_percent =
+           100L *^ rd.rd_info.D.memory /^ node_info.C.memory in
+        let rd = { rd with
+                   rd_cpu_time = cpu_time;
+                   rd_percent_cpu = percent_cpu;
+                   rd_mem_bytes = mem_usage;
+                    rd_mem_percent = mem_percent} in
+        name, Active rd
+      (* For all other domains we can't calculate it, so leave as 0 *)
+      | rd -> rd
+    ) doms in
+
+  (* Calculate the number of block device read/write requests across
+   * all block devices attached to a domain.
+   *)
+  let doms =
+    List.map (
+      function
+      (* Do we have stats from the previous slice? *)
+      | name, Active ({ rd_prev_block_stats = ((_::_) as prev_block_stats) }
+                     as rd) ->
+        let block_stats = rd.rd_block_stats in (* stats now *)
+
+        (* Add all the devices together.  Throw away device names. *)
+        let prev_block_stats =
+          sum_block_stats (List.map snd prev_block_stats) in
+        let block_stats =
+          sum_block_stats (List.map snd block_stats) in
+
+        (* Calculate increase in read & write requests. *)
+        let read_reqs =
+          block_stats.D.rd_req -^ prev_block_stats.D.rd_req in
+        let write_reqs =
+          block_stats.D.wr_req -^ prev_block_stats.D.wr_req in
+         let read_bytes =
+           block_stats.D.rd_bytes -^ prev_block_stats.D.rd_bytes in
+         let write_bytes =
+           block_stats.D.wr_bytes -^ prev_block_stats.D.wr_bytes in
+
+        let rd = { rd with
+                   rd_block_rd_reqs = Some read_reqs;
+                   rd_block_wr_reqs = Some write_reqs;
+                    rd_block_rd_bytes = Some read_bytes;
+                    rd_block_wr_bytes = Some write_bytes;
+         } in
+         let rd = { rd with
+                    rd_block_rd_info =
+                      if block_in_bytes then
+                        rd.rd_block_rd_bytes else rd.rd_block_rd_reqs;
+                    rd_block_wr_info =
+                      if block_in_bytes then
+                        rd.rd_block_wr_bytes else rd.rd_block_wr_reqs;
+         } in
+        name, Active rd
+      (* For all other domains we can't calculate it, so leave as None. *)
+      | rd -> rd
+    ) doms in
+
+  (* Calculate the same as above for network interfaces across
+   * all network interfaces attached to a domain.
+   *)
+  let doms =
+    List.map (
+      function
+      (* Do we have stats from the previous slice? *)
+      | name, Active ({ rd_prev_interface_stats =
+                         ((_::_) as prev_interface_stats) }
+                     as rd) ->
+        let interface_stats = rd.rd_interface_stats in (* stats now *)
+
+        (* Add all the devices together.  Throw away device names. *)
+        let prev_interface_stats =
+          sum_interface_stats (List.map snd prev_interface_stats) in
+        let interface_stats =
+          sum_interface_stats (List.map snd interface_stats) in
+
+        (* Calculate increase in rx & tx bytes. *)
+        let rx_bytes =
+          interface_stats.D.rx_bytes -^ prev_interface_stats.D.rx_bytes in
+        let tx_bytes =
+          interface_stats.D.tx_bytes -^ prev_interface_stats.D.tx_bytes in
+
+        let rd = { rd with
+                   rd_net_rx_bytes = Some rx_bytes;
+                   rd_net_tx_bytes = Some tx_bytes } in
+        name, Active rd
+      (* For all other domains we can't calculate it, so leave as None. *)
+      | rd -> rd
+    ) doms in
+
+  (* Calculate totals. *)
+  let totals =
+    List.fold_left (
+        fun (count, running, blocked, paused, shutdown, shutoff,
+            crashed, active, inactive,
+            total_cpu_time, total_memory, total_domU_memory) ->
+       function
+       | (name, Active rd) ->
+          let test state orig =
+            if rd.rd_info.D.state = state then orig+1 else orig
+          in
+          let running = test D.InfoRunning running in
+          let blocked = test D.InfoBlocked blocked in
+          let paused = test D.InfoPaused paused in
+          let shutdown = test D.InfoShutdown shutdown in
+          let shutoff = test D.InfoShutoff shutoff in
+          let crashed = test D.InfoCrashed crashed in
+
+          let total_cpu_time = total_cpu_time +. rd.rd_cpu_time in
+          let total_memory = total_memory +^ rd.rd_info.D.memory in
+          let total_domU_memory =
+             total_domU_memory +^
+              if rd.rd_domid > 0 then rd.rd_info.D.memory else 0L in
+
+          (count+1, running, blocked, paused, shutdown, shutoff,
+           crashed, active+1, inactive,
+           total_cpu_time, total_memory, total_domU_memory)
+
+       | (name, Inactive) -> (* inactive domain *)
+          (count+1, running, blocked, paused, shutdown, shutoff,
+           crashed, active, inactive+1,
+           total_cpu_time, total_memory, total_domU_memory)
+    ) (0,0,0,0,0,0,0,0,0, 0.,0L,0L) doms in
+
+  (* Update last_time, last_info. *)
+  last_time := time;
+  Hashtbl.clear last_info;
+  List.iter (
+    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
+    | _ -> ()
+  ) doms;
+
+  { rd_doms = doms;
+    rd_time = time;
+    rd_printable_time = printable_time;
+    rd_nr_pcpus = nr_pcpus;
+    rd_total_cpu = total_cpu;
+    rd_total_cpu_per_pcpu = total_cpu_per_pcpu;
+    rd_totals = totals }
+
+(* Collect some extra information in PCPUDisplay display_mode. *)
+let collect_pcpu { rd_doms = doms; rd_nr_pcpus = nr_pcpus } =
+  (* Get the VCPU info and VCPU->PCPU mappings for active domains.
+   * Also cull some data we don't care about.
+   *)
+  let doms =
+    List.filter_map (
+      function
+      | (name, Active rd) ->
+        (try
+            let domid = rd.rd_domid in
+            let maplen = C.cpumaplen nr_pcpus in
+            let cpu_stats = D.get_cpu_stats rd.rd_dom in
+
+             (* Note the terminology is confusing.
+              *
+              * In libvirt, cpu_time is the total time (hypervisor +
+              * vCPU).  vcpu_time is the time only taken by the vCPU,
+              * excluding time taken inside the hypervisor.
+              *
+              * For each pCPU, libvirt may return either "cpu_time"
+              * or "vcpu_time" or neither or both.  This function
+              * returns an array pair [|cpu_time, vcpu_time|];
+              * if either is missing it is returned as 0.
+              *)
+            let find_cpu_usages params =
+               let rec find_uint64_field name = function
+                 | (n, D.TypedFieldUInt64 usage) :: _ when n = name ->
+                    usage
+                 | _ :: params -> find_uint64_field name params
+                 | [] -> 0L
+               in
+               [| find_uint64_field "cpu_time" params;
+                  find_uint64_field "vcpu_time" params |]
+             in
+
+            let pcpu_usages = Array.map find_cpu_usages cpu_stats in
+            let maxinfo = rd.rd_info.D.nr_virt_cpu in
+            let nr_vcpus, vcpu_infos, cpumaps =
+              D.get_vcpus rd.rd_dom maxinfo maplen in
+
+            (* Got previous pcpu_usages for this domain? *)
+            let prev_pcpu_usages =
+              try Some (Hashtbl.find last_pcpu_usages domid)
+              with Not_found -> None in
+            (* Update last_pcpu_usages. *)
+            Hashtbl.replace last_pcpu_usages domid pcpu_usages;
+
+            (match prev_pcpu_usages with
+             | Some prev_pcpu_usages
+                  when Array.length prev_pcpu_usages = Array.length pcpu_usages ->
+                Some (domid, name, nr_vcpus, vcpu_infos, pcpu_usages,
+                      prev_pcpu_usages, cpumaps, maplen)
+             | _ -> None (* ignore missing / unequal length prev_vcpu_infos *)
+            );
+          with
+            Libvirt.Virterror _ -> None (* ignore transient libvirt errors *)
+        )
+      | (_, Inactive) -> None (* ignore inactive doms *)
+    ) doms in
+  let nr_doms = List.length doms in
+
+  (* Rearrange the data into a matrix.  Major axis (down) is
+   * pCPUs.  Minor axis (right) is domains.  At each node we store:
+   *  cpu_time hypervisor + domain (on this pCPU only, nanosecs),
+   *  vcpu_time domain only (on this pCPU only, nanosecs).
+   *)
+  let make_3d_array dimx dimy dimz e =
+    Array.init dimx (fun _ -> Array.make_matrix dimy dimz e)
+  in
+  let pcpus = make_3d_array nr_pcpus nr_doms 2 0L in
+
+  List.iteri (
+    fun di (domid, name, nr_vcpus, vcpu_infos, pcpu_usages,
+           prev_pcpu_usages, cpumaps, maplen) ->
+      (* Which pCPUs can this dom run on? *)
+      for p = 0 to Array.length pcpu_usages - 1 do
+       pcpus.(p).(di).(0) <-
+          pcpu_usages.(p).(0) -^ prev_pcpu_usages.(p).(0);
+       pcpus.(p).(di).(1) <-
+          pcpu_usages.(p).(1) -^ prev_pcpu_usages.(p).(1)
+      done
+  ) doms;
+
+  (* Sum the total CPU time used by each pCPU, for the %CPU column. *)
+  let pcpus_cpu_time =
+    Array.map (
+      fun row ->
+        let cpu_time = ref 0L in
+       for di = 0 to Array.length row-1 do
+         let t = row.(di).(0) in
+         cpu_time := !cpu_time +^ t
+       done;
+       Int64.to_float !cpu_time
+    ) pcpus in
+
+  { rd_pcpu_doms = doms;
+    rd_pcpu_pcpus = pcpus;
+    rd_pcpu_pcpus_cpu_time = pcpus_cpu_time }
diff --git a/src/collect.mli b/src/collect.mli
new file mode 100644 (file)
index 0000000..440859b
--- /dev/null
@@ -0,0 +1,86 @@
+(* 'top'-like tool for libvirt domains.
+   (C) Copyright 2007-2017 Richard W.M. Jones, Red Hat Inc.
+   http://libvirt.org/
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU General Public License as published by
+   the Free Software Foundation; either version 2 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   along with this program; if not, write to the Free Software
+   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+*)
+
+(* Hook for [Opt_xml] to override (if present). *)
+val parse_device_xml :
+  (int -> [ `R ] Libvirt.Domain.t -> string list * string list) ref
+
+(* Intermediate "domain + stats" structure that we use to collect
+ * everything we know about a domain within the collect function.
+ *)
+type rd_domain = Inactive | Active of rd_active
+and rd_active = {
+  rd_domid : int;                      (* Domain ID. *)
+  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;
+                                        (* Domain block stats now. *)
+  rd_interface_stats : (string * Libvirt.Domain.interface_stats) list;
+                                        (* Domain net stats now. *)
+  rd_prev_info : Libvirt.Domain.info option; (* Domain CPU info previously. *)
+  rd_prev_block_stats : (string * Libvirt.Domain.block_stats) list;
+                                        (* Domain block stats prev. *)
+  rd_prev_interface_stats : (string * Libvirt.Domain.interface_stats) list;
+                                        (* Domain interface stats prev. *)
+  (* The following are since the last slice, or 0 if cannot be calculated: *)
+  rd_cpu_time : float;                 (* CPU time used in nanoseconds. *)
+  rd_percent_cpu : float;              (* CPU time as percent of total. *)
+  rd_mem_bytes : int64;                        (* Memory usage in bytes *)
+  rd_mem_percent: int64;               (* Memory usage as percent of total *)
+  (* The following are since the last slice, or None if cannot be calc'd: *)
+  rd_block_rd_reqs : int64 option;      (* Number of block device read rqs. *)
+  rd_block_wr_reqs : int64 option;      (* Number of block device write rqs. *)
+  rd_block_rd_bytes : int64 option;     (* Number of bytes block device read *)
+  rd_block_wr_bytes : int64 option;     (* Number of bytes block device write *)
+  (* _info fields includes the number considering --block_in_bytes option *)
+  rd_block_rd_info : int64 option;      (* Block device read info for user *)
+  rd_block_wr_info : int64 option;      (* Block device read info for user *)
+
+  rd_net_rx_bytes : int64 option;      (* Number of bytes received. *)
+  rd_net_tx_bytes : int64 option;      (* Number of bytes transmitted. *)
+}
+
+type stats = {
+  rd_doms : (string * rd_domain) list;  (* List of domains. *)
+  rd_time : float;
+  rd_printable_time : string;
+  rd_nr_pcpus : int;
+  rd_total_cpu : float;
+  rd_total_cpu_per_pcpu : float;
+  rd_totals : (int * int * int * int * int * int * int * int * int * float *
+                 int64 * int64);
+}
+
+type pcpu_stats = {
+  rd_pcpu_doms : (int * string * int *
+                  Libvirt.Domain.vcpu_info array * int64 array array *
+                  int64 array array * string * int) list;
+  rd_pcpu_pcpus : int64 array array array;
+  rd_pcpu_pcpus_cpu_time : float array
+}
+
+val collect : Types.setup -> bool -> stats
+(** Collect statistics. *)
+
+val collect_pcpu : stats -> pcpu_stats
+(** Used in PCPUDisplay mode only, this returns extra per-PCPU stats. *)
+
+val clear_pcpu_display_data : unit -> unit
+(** Clear the cache of pcpu_usages used by PCPUDisplay display_mode
+    when we switch back to TaskDisplay mode. *)
diff --git a/src/csv_output.ml b/src/csv_output.ml
new file mode 100644 (file)
index 0000000..9496ca8
--- /dev/null
@@ -0,0 +1,118 @@
+(* 'top'-like tool for libvirt domains.
+   (C) Copyright 2007-2017 Richard W.M. Jones, Red Hat Inc.
+   http://libvirt.org/
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU General Public License as published by
+   the Free Software Foundation; either version 2 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   along with this program; if not, write to the Free Software
+   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+*)
+
+(* CSV output functions. *)
+
+open Printf
+open ExtList
+
+open Collect
+
+module C = Libvirt.Connect
+
+(* Hook for CSV support (see [opt_csv.ml]). *)
+let csv_write : (string list -> unit) ref =
+  ref (
+    fun _ -> ()
+  )
+
+(* Write CSV header row. *)
+let write_csv_header (csv_cpu, csv_mem, csv_block, csv_net) block_in_bytes =
+  (!csv_write) (
+    [ "Hostname"; "Time"; "Arch"; "Physical CPUs";
+      "Count"; "Running"; "Blocked"; "Paused"; "Shutdown";
+      "Shutoff"; "Crashed"; "Active"; "Inactive";
+      "%CPU";
+      "Total hardware memory (KB)";
+      "Total memory (KB)"; "Total guest memory (KB)";
+      "Total CPU time (ns)" ] @
+      (* These fields are repeated for each domain: *)
+    [ "Domain ID"; "Domain name"; ] @
+    (if csv_cpu then [ "CPU (ns)"; "%CPU"; ] else []) @
+    (if csv_mem then [ "Mem (bytes)"; "%Mem";] else []) @
+    (if csv_block && not block_in_bytes
+       then [ "Block RDRQ"; "Block WRRQ"; ] else []) @
+    (if csv_block && block_in_bytes
+       then [ "Block RDBY"; "Block WRBY"; ] else []) @
+    (if csv_net then [ "Net RXBY"; "Net TXBY" ] else [])
+  )
+
+(* Write summary data to CSV file. *)
+let append_csv (_, _, _, _, _, node_info, hostname, _) (* setup *)
+               (csv_cpu, csv_mem, csv_block, csv_net)
+               { rd_doms = doms;
+                 rd_printable_time = printable_time;
+                 rd_nr_pcpus = nr_pcpus; rd_total_cpu = total_cpu;
+                 rd_totals = totals } (* state *) =
+  (* The totals / summary fields. *)
+  let (count, running, blocked, paused, shutdown, shutoff,
+       crashed, active, inactive,
+       total_cpu_time, total_memory, total_domU_memory) = totals in
+
+  let percent_cpu = 100. *. total_cpu_time /. total_cpu in
+
+  let summary_fields = [
+    hostname; printable_time; node_info.C.model; string_of_int nr_pcpus;
+    string_of_int count; string_of_int running; string_of_int blocked;
+    string_of_int paused; string_of_int shutdown; string_of_int shutoff;
+    string_of_int crashed; string_of_int active; string_of_int inactive;
+    sprintf "%2.1f" percent_cpu;
+    Int64.to_string node_info.C.memory;
+    Int64.to_string total_memory; Int64.to_string total_domU_memory;
+    Int64.to_string (Int64.of_float total_cpu_time)
+  ] in
+
+  (* The domains.
+   *
+   * Sort them by ID so that the list of relatively stable.  Ignore
+   * inactive domains.
+   *)
+  let doms = List.filter_map (
+    function
+    | _, Inactive -> None              (* Ignore inactive domains. *)
+    | name, Active rd -> Some (name, rd)
+  ) doms in
+  let cmp (_, { rd_domid = rd_domid1 }) (_, { rd_domid = rd_domid2 }) =
+    compare rd_domid1 rd_domid2
+  in
+  let doms = List.sort ~cmp doms in
+
+  let string_of_int64_option = Option.map_default Int64.to_string "" in
+
+  let domain_fields = List.map (
+    fun (domname, rd) ->
+      [ string_of_int rd.rd_domid; domname ] @
+       (if csv_cpu then [
+          string_of_float rd.rd_cpu_time; string_of_float rd.rd_percent_cpu
+        ] else []) @
+        (if csv_mem then [
+            Int64.to_string rd.rd_mem_bytes; Int64.to_string rd.rd_mem_percent
+         ] else []) @
+       (if csv_block then [
+          string_of_int64_option rd.rd_block_rd_info;
+          string_of_int64_option rd.rd_block_wr_info;
+        ] else []) @
+       (if csv_net then [
+          string_of_int64_option rd.rd_net_rx_bytes;
+          string_of_int64_option rd.rd_net_tx_bytes;
+        ] else [])
+  ) doms in
+  let domain_fields = List.flatten domain_fields in
+
+  (!csv_write) (summary_fields @ domain_fields)
diff --git a/src/csv_output.mli b/src/csv_output.mli
new file mode 100644 (file)
index 0000000..d5eab0f
--- /dev/null
@@ -0,0 +1,27 @@
+(* 'top'-like tool for libvirt domains.
+   (C) Copyright 2007-2017 Richard W.M. Jones, Red Hat Inc.
+   http://libvirt.org/
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU General Public License as published by
+   the Free Software Foundation; either version 2 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   along with this program; if not, write to the Free Software
+   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+*)
+
+(** CSV output functions. *)
+
+(* Hook for [Opt_csv] to override (if present). *)
+val csv_write : (string list -> unit) ref
+
+val write_csv_header : bool * bool * bool * bool -> bool -> unit
+
+val append_csv : Types.setup -> bool * bool * bool * bool -> Collect.stats -> unit
index 6c3b2be..6625c61 100644 (file)
@@ -28,7 +28,7 @@ Top.csv_start :=
   fun filename ->
     chan := Some (open_out filename) ;;
 
-Top.csv_write :=
+Csv_output.csv_write :=
   fun row ->
     match !chan with
     | None -> ()                       (* CSV output not enabled. *)
index bb83780..1037b85 100644 (file)
@@ -27,7 +27,7 @@ module C = Libvirt.Connect
 module D = Libvirt.Domain
 module N = Libvirt.Network ;;
 
-Top.parse_device_xml :=
+Collect.parse_device_xml :=
 fun id dom ->
   try
     let xml = D.get_xml_desc dom in
diff --git a/src/redraw.ml b/src/redraw.ml
new file mode 100644 (file)
index 0000000..9ce889b
--- /dev/null
@@ -0,0 +1,506 @@
+(* 'top'-like tool for libvirt domains.
+   (C) Copyright 2007-2017 Richard W.M. Jones, Red Hat Inc.
+   http://libvirt.org/
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU General Public License as published by
+   the Free Software Foundation; either version 2 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   along with this program; if not, write to the Free Software
+   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+*)
+
+open ExtList
+open Curses
+open Printf
+
+open Opt_gettext.Gettext
+open Utils
+open Types
+open Screen
+open Collect
+
+module C = Libvirt.Connect
+module D = Libvirt.Domain
+
+(* Keep a historical list of %CPU usages. *)
+let historical_cpu = ref []
+let historical_cpu_last_time = ref (Unix.gettimeofday ())
+
+(* Redraw the display. *)
+let redraw display_mode sort_order
+           (_, _, _, _, _, node_info, _, _) (* setup *)
+           block_in_bytes
+           historical_cpu_delay
+           { rd_doms = doms;
+             rd_time = time; rd_printable_time = printable_time;
+             rd_nr_pcpus = nr_pcpus;
+             rd_total_cpu = total_cpu;
+             rd_total_cpu_per_pcpu = total_cpu_per_pcpu;
+             rd_totals = totals } (* state *)
+           pcpu_display =
+  clear ();
+
+  (* Get the screen/window size. *)
+  let lines, cols = get_size () in
+
+  (* Time. *)
+  mvaddstr top_lineno 0 (sprintf "virt-top %s - " printable_time);
+
+  (* Basic node_info. *)
+  addstr
+    (sprintf "%s %d/%dCPU %dMHz %LdMB "
+            node_info.C.model node_info.C.cpus nr_pcpus node_info.C.mhz
+            (node_info.C.memory /^ 1024L));
+  (* Save the cursor position for when we come to draw the
+   * historical CPU times (down in this function).
+   *)
+  let stdscr = stdscr () in
+  let historical_cursor = getyx stdscr in
+
+  (match display_mode with
+
+   (*---------- Showing domains ----------*)
+   | TaskDisplay ->
+      (* Sort domains on current sort_order. *)
+      let doms =
+       let cmp =
+         match sort_order with
+         | DomainName ->
+            (fun _ -> 0) (* fallthrough to default name compare *)
+         | Processor ->
+            (function
+              | Active rd1, Active rd2 ->
+                 compare rd2.rd_percent_cpu rd1.rd_percent_cpu
+              | Active _, Inactive -> -1
+              | Inactive, Active _ -> 1
+              | Inactive, Inactive -> 0)
+         | Memory ->
+            (function
+              | Active { rd_info = info1 }, Active { rd_info = info2 } ->
+                 compare info2.D.memory info1.D.memory
+              | Active _, Inactive -> -1
+              | Inactive, Active _ -> 1
+              | Inactive, Inactive -> 0)
+         | Time ->
+            (function
+              | Active { rd_info = info1 }, Active { rd_info = info2 } ->
+                 compare info2.D.cpu_time info1.D.cpu_time
+              | Active _, Inactive -> -1
+              | Inactive, Active _ -> 1
+              | Inactive, Inactive -> 0)
+         | DomainID ->
+            (function
+              | Active { rd_domid = id1 }, Active { rd_domid = id2 } ->
+                 compare id1 id2
+              | Active _, Inactive -> -1
+              | Inactive, Active _ -> 1
+              | Inactive, Inactive -> 0)
+         | NetRX ->
+            (function
+              | Active { rd_net_rx_bytes = r1 }, Active { rd_net_rx_bytes = r2 } ->
+                 compare r2 r1
+              | Active _, Inactive -> -1
+              | Inactive, Active _ -> 1
+              | Inactive, Inactive -> 0)
+         | NetTX ->
+            (function
+              | Active { rd_net_tx_bytes = r1 }, Active { rd_net_tx_bytes = r2 } ->
+                 compare r2 r1
+              | Active _, Inactive -> -1
+              | Inactive, Active _ -> 1
+              | Inactive, Inactive -> 0)
+         | BlockRdRq ->
+            (function
+              | Active { rd_block_rd_reqs = r1 }, Active { rd_block_rd_reqs = r2 } ->
+                 compare r2 r1
+              | Active _, Inactive -> -1
+              | Inactive, Active _ -> 1
+              | Inactive, Inactive -> 0)
+         | BlockWrRq ->
+            (function
+              | Active { rd_block_wr_reqs = r1 }, Active { rd_block_wr_reqs = r2 } ->
+                 compare r2 r1
+              | Active _, Inactive -> -1
+              | Inactive, Active _ -> 1
+              | Inactive, Inactive -> 0)
+       in
+       let cmp (name1, dom1) (name2, dom2) =
+         let r = cmp (dom1, dom2) in
+         if r <> 0 then r
+         else compare name1 name2
+       in
+       List.sort ~cmp doms in
+
+      (* Print domains. *)
+      attron A.reverse;
+      let header_string =
+        if block_in_bytes
+        then "   ID S RDBY WRBY RXBY TXBY %CPU %MEM    TIME   NAME"
+        else "   ID S RDRQ WRRQ RXBY TXBY %CPU %MEM    TIME   NAME"
+      in
+      mvaddstr header_lineno 0
+              (pad cols header_string);
+      attroff A.reverse;
+
+      let rec loop lineno = function
+       | [] -> ()
+       | (name, Active rd) :: doms ->
+          if lineno < lines then (
+            let state = show_state rd.rd_info.D.state in
+            let rd_req = Show.int64_option rd.rd_block_rd_info in
+            let wr_req = Show.int64_option rd.rd_block_wr_info in
+            let rx_bytes = Show.int64_option rd.rd_net_rx_bytes in
+            let tx_bytes = Show.int64_option rd.rd_net_tx_bytes in
+            let percent_cpu = Show.percent rd.rd_percent_cpu in
+            let percent_mem = Int64.to_float rd.rd_mem_percent in
+            let percent_mem = Show.percent percent_mem in
+            let time = Show.time rd.rd_info.D.cpu_time in
+
+            let line =
+               sprintf "%5d %c %s %s %s %s %s %s %s %s"
+                      rd.rd_domid state rd_req wr_req rx_bytes tx_bytes
+                      percent_cpu percent_mem time name in
+            let line = pad cols line in
+            mvaddstr lineno 0 line;
+            loop (lineno+1) doms
+          )
+       | (name, Inactive) :: doms -> (* inactive domain *)
+          if lineno < lines then (
+            let line =
+              sprintf
+                "    -                                           (%s)"
+                name in
+            let line = pad cols line in
+            mvaddstr lineno 0 line;
+            loop (lineno+1) doms
+          )
+      in
+      loop domains_lineno doms
+
+   (*---------- Showing physical CPUs ----------*)
+   | PCPUDisplay ->
+      let { rd_pcpu_doms = doms;
+            rd_pcpu_pcpus = pcpus;
+            rd_pcpu_pcpus_cpu_time = pcpus_cpu_time } =
+       match pcpu_display with
+       | Some p -> p
+       | None -> failwith "internal error: no pcpu_display data" in
+
+      (* Display the pCPUs. *)
+      let dom_names =
+       String.concat "" (
+                       List.map (
+                           fun (_, name, _, _, _, _, _, _) ->
+                           let len = String.length name in
+                           let width = max (len+1) 12 in
+                           pad width name
+                         ) doms
+                     ) in
+      attron A.reverse;
+      mvaddstr header_lineno 0 (pad cols ("PHYCPU %CPU " ^ dom_names));
+      attroff A.reverse;
+
+      Array.iteri (
+       fun p row ->
+         mvaddstr (p+domains_lineno) 0 (sprintf "%4d   " p);
+         let cpu_time = pcpus_cpu_time.(p) in (* ns used on this CPU *)
+         let percent_cpu = 100. *. cpu_time /. total_cpu_per_pcpu in
+         addstr (Show.percent percent_cpu);
+         addch ' ';
+
+         List.iteri (
+           fun di (domid, name, _, _, _, _, _, _) ->
+             let t = pcpus.(p).(di).(0) in (* hypervisor + domain *)
+             let t_only = pcpus.(p).(di).(1) in (* domain only *)
+             let len = String.length name in
+             let width = max (len+1) 12 in
+             let str_t =
+               if t <= 0L then ""
+               else (
+                 let t = Int64.to_float t in
+                 let percent = 100. *. t /. total_cpu_per_pcpu in
+                 Show.percent percent
+               ) in
+              let str_t_only =
+                if t_only <= 0L then ""
+                else (
+                  let t_only = Int64.to_float t_only in
+                  let percent = 100. *. t_only /. total_cpu_per_pcpu in
+                  Show.percent percent
+                ) in
+              addstr (pad 5 str_t);
+              addstr (pad 5 str_t_only);
+              addstr (pad (width-10) " ");
+             ()
+          ) doms
+      ) pcpus;
+
+   (*---------- Showing network interfaces ----------*)
+   | NetDisplay ->
+      (* Only care about active domains. *)
+      let doms =
+        List.filter_map (
+           function
+           | (name, Active rd) -> Some (name, rd)
+           | (_, Inactive) -> None
+       ) doms in
+
+      (* For each domain we have a list of network interfaces seen
+       * this slice, and seen in the previous slice, which we now
+       * match up to get a list of (domain, interface) for which
+       * we have current & previous knowledge.  (And ignore the rest).
+       *)
+      let devs =
+       List.map (
+         fun (name, rd) ->
+           List.filter_map (
+             fun (dev, stats) ->
+               try
+                 (* Have prev slice stats for this device? *)
+                 let prev_stats =
+                   List.assoc dev rd.rd_prev_interface_stats in
+                 Some (dev, name, rd, stats, prev_stats)
+               with Not_found -> None
+             ) rd.rd_interface_stats
+         ) doms in
+
+      (* Finally we have a list of:
+       * device name, domain name, rd_* stuff, curr stats, prev stats.
+       *)
+      let devs : (string * string * rd_active *
+                   D.interface_stats * D.interface_stats) list =
+       List.flatten devs in
+
+      (* Difference curr slice & prev slice. *)
+      let devs =
+        List.map (
+         fun (dev, name, rd, curr, prev) ->
+           dev, name, rd, diff_interface_stats curr prev
+         ) devs in
+
+      (* Sort by current sort order, but map some of the standard
+       * sort orders into ones which makes sense here.
+       *)
+      let devs =
+       let cmp =
+         match sort_order with
+         | DomainName ->
+            (fun _ -> 0) (* fallthrough to default name compare *)
+         | DomainID ->
+            (fun (_, { rd_domid = id1 }, _, { rd_domid = id2 }) ->
+             compare id1 id2)
+         | Processor | Memory | Time
+          | BlockRdRq | BlockWrRq
+            (* fallthrough to RXBY comparison. *)
+         | NetRX ->
+            (fun ({ D.rx_bytes = b1 }, _, { D.rx_bytes = b2 }, _) ->
+             compare b2 b1)
+         | NetTX ->
+            (fun ({ D.tx_bytes = b1 }, _, { D.tx_bytes = b2 }, _) ->
+             compare b2 b1)
+       in
+       let cmp (dev1, name1, rd1, stats1) (dev2, name2, rd2, stats2) =
+         let r = cmp (stats1, rd1, stats2, rd2) in
+         if r <> 0 then r
+         else compare (dev1, name1) (dev2, name2)
+       in
+       List.sort ~cmp devs in
+
+      (* Print the header for network devices. *)
+      attron A.reverse;
+      mvaddstr header_lineno 0
+              (pad cols "   ID S RXBY TXBY RXPK TXPK DOMAIN       INTERFACE");
+      attroff A.reverse;
+
+      (* Print domains and devices. *)
+      let rec loop lineno = function
+       | [] -> ()
+       | (dev, name, rd, stats) :: devs ->
+          if lineno < lines then (
+            let state = show_state rd.rd_info.D.state in
+            let rx_bytes =
+              if stats.D.rx_bytes >= 0L
+              then Show.int64 stats.D.rx_bytes
+              else "    " in
+            let tx_bytes =
+              if stats.D.tx_bytes >= 0L
+              then Show.int64 stats.D.tx_bytes
+              else "    " in
+            let rx_packets =
+              if stats.D.rx_packets >= 0L
+              then Show.int64 stats.D.rx_packets
+              else "    " in
+            let tx_packets =
+              if stats.D.tx_packets >= 0L
+              then Show.int64 stats.D.tx_packets
+              else "    " in
+
+            let line = sprintf "%5d %c %s %s %s %s %-12s %s"
+                               rd.rd_domid state
+                               rx_bytes tx_bytes
+                               rx_packets tx_packets
+                               (pad 12 name) dev in
+            let line = pad cols line in
+            mvaddstr lineno 0 line;
+            loop (lineno+1) devs
+          )
+      in
+      loop domains_lineno devs
+
+   (*---------- Showing block devices ----------*)
+   | BlockDisplay ->
+      (* Only care about active domains. *)
+      let doms =
+        List.filter_map (
+           function
+           | (name, Active rd) -> Some (name, rd)
+           | (_, Inactive) -> None
+       ) doms in
+
+      (* For each domain we have a list of block devices seen
+       * this slice, and seen in the previous slice, which we now
+       * match up to get a list of (domain, device) for which
+       * we have current & previous knowledge.  (And ignore the rest).
+       *)
+      let devs =
+       List.map (
+         fun (name, rd) ->
+           List.filter_map (
+             fun (dev, stats) ->
+               try
+                 (* Have prev slice stats for this device? *)
+                 let prev_stats =
+                   List.assoc dev rd.rd_prev_block_stats in
+                 Some (dev, name, rd, stats, prev_stats)
+               with Not_found -> None
+           ) rd.rd_block_stats
+       ) doms in
+
+      (* Finally we have a list of:
+       * device name, domain name, rd_* stuff, curr stats, prev stats.
+       *)
+      let devs : (string * string * rd_active *
+                   D.block_stats * D.block_stats) list =
+       List.flatten devs in
+
+      (* Difference curr slice & prev slice. *)
+      let devs =
+        List.map (
+         fun (dev, name, rd, curr, prev) ->
+           dev, name, rd, diff_block_stats curr prev
+        ) devs in
+
+      (* Sort by current sort order, but map some of the standard
+       * sort orders into ones which makes sense here.
+       *)
+      let devs =
+       let cmp =
+         match sort_order with
+         | DomainName ->
+            (fun _ -> 0) (* fallthrough to default name compare *)
+         | DomainID ->
+            (fun (_, { rd_domid = id1 }, _, { rd_domid = id2 }) ->
+             compare id1 id2)
+         | Processor | Memory | Time
+          | NetRX | NetTX
+            (* fallthrough to RDRQ comparison. *)
+         | BlockRdRq ->
+            (fun ({ D.rd_req = b1 }, _, { D.rd_req = b2 }, _) ->
+             compare b2 b1)
+         | BlockWrRq ->
+            (fun ({ D.wr_req = b1 }, _, { D.wr_req = b2 }, _) ->
+             compare b2 b1)
+       in
+       let cmp (dev1, name1, rd1, stats1) (dev2, name2, rd2, stats2) =
+         let r = cmp (stats1, rd1, stats2, rd2) in
+         if r <> 0 then r
+         else compare (dev1, name1) (dev2, name2)
+       in
+       List.sort ~cmp devs in
+
+      (* Print the header for block devices. *)
+      attron A.reverse;
+      mvaddstr header_lineno 0
+              (pad cols "   ID S RDBY WRBY RDRQ WRRQ DOMAIN       DEVICE");
+      attroff A.reverse;
+
+      (* Print domains and devices. *)
+      let rec loop lineno = function
+       | [] -> ()
+       | (dev, name, rd, stats) :: devs ->
+          if lineno < lines then (
+            let state = show_state rd.rd_info.D.state in
+            let rd_bytes =
+              if stats.D.rd_bytes >= 0L
+              then Show.int64 stats.D.rd_bytes
+              else "    " in
+            let wr_bytes =
+              if stats.D.wr_bytes >= 0L
+              then Show.int64 stats.D.wr_bytes
+              else "    " in
+            let rd_req =
+              if stats.D.rd_req >= 0L
+              then Show.int64 stats.D.rd_req
+              else "    " in
+            let wr_req =
+              if stats.D.wr_req >= 0L
+              then Show.int64 stats.D.wr_req
+              else "    " in
+
+            let line = sprintf "%5d %c %s %s %s %s %-12s %s"
+                               rd.rd_domid state
+                               rd_bytes wr_bytes
+                               rd_req wr_req
+                               (pad 12 name) dev in
+            let line = pad cols line in
+            mvaddstr lineno 0 line;
+            loop (lineno+1) devs
+          )
+      in
+      loop domains_lineno devs
+  ); (* end of display_mode conditional section *)
+
+  let (count, running, blocked, paused, shutdown, shutoff,
+       crashed, active, inactive,
+       total_cpu_time, total_memory, total_domU_memory) = totals in
+
+  mvaddstr summary_lineno 0
+           (sprintf
+             (f_"%d domains, %d active, %d running, %d sleeping, %d paused, %d inactive D:%d O:%d X:%d")
+             count active running blocked paused inactive shutdown shutoff crashed);
+
+  (* Total %CPU used, and memory summary. *)
+  let percent_cpu = 100. *. total_cpu_time /. total_cpu in
+  mvaddstr (summary_lineno+1) 0
+           (sprintf
+             (f_"CPU: %2.1f%%  Mem: %Ld MB (%Ld MB by guests)")
+             percent_cpu (total_memory /^ 1024L) (total_domU_memory /^ 1024L));
+
+  (* Time to grab another historical %CPU for the list? *)
+  if time >= !historical_cpu_last_time +. float historical_cpu_delay
+  then (
+    historical_cpu := percent_cpu :: List.take 10 !historical_cpu;
+    historical_cpu_last_time := time
+  );
+
+  (* Display historical CPU time. *)
+  let () =
+    let y, x = historical_cursor in
+    let maxwidth = cols - x in
+    let line =
+      String.concat " "
+                   (List.map (sprintf "%2.1f%%") !historical_cpu) in
+    let line = pad maxwidth line in
+    mvaddstr y x line;
+    () in
+
+  move message_lineno 0; (* Park cursor in message area, as with top. *)
+  refresh ()             (* Refresh the display. *)
diff --git a/src/redraw.mli b/src/redraw.mli
new file mode 100644 (file)
index 0000000..2ea97c3
--- /dev/null
@@ -0,0 +1,20 @@
+(* 'top'-like tool for libvirt domains.
+   (C) Copyright 2007-2017 Richard W.M. Jones, Red Hat Inc.
+   http://libvirt.org/
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU General Public License as published by
+   the Free Software Foundation; either version 2 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   along with this program; if not, write to the Free Software
+   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+*)
+
+val redraw : Types.display -> Types.sort_order -> Types.setup -> bool -> int -> Collect.stats -> Collect.pcpu_stats option -> unit
diff --git a/src/screen.ml b/src/screen.ml
new file mode 100644 (file)
index 0000000..0d847a2
--- /dev/null
@@ -0,0 +1,52 @@
+(* 'top'-like tool for libvirt domains.
+   (C) Copyright 2007-2017 Richard W.M. Jones, Red Hat Inc.
+   http://libvirt.org/
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU General Public License as published by
+   the Free Software Foundation; either version 2 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   along with this program; if not, write to the Free Software
+   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+*)
+
+(* The virt-top screen layout. *)
+
+open Curses
+
+module D = Libvirt.Domain
+
+(* Line numbers. *)
+let top_lineno = 0
+let summary_lineno = 1 (* this takes 2 lines *)
+let message_lineno = 3
+let header_lineno = 4
+let domains_lineno = 5
+
+(* Easier to use versions of curses functions addstr, mvaddstr, etc. *)
+let move y x = ignore (move y x)
+let refresh () = ignore (refresh ())
+let addch c = ignore (addch (int_of_char c))
+let addstr s = ignore (addstr s)
+let mvaddstr y x s = ignore (mvaddstr y x s)
+
+(* Print in the "message area". *)
+let clear_msg () = move message_lineno 0; clrtoeol ()
+let print_msg str = clear_msg (); mvaddstr message_lineno 0 str
+
+(* Show a libvirt domain state (the 'S' column). *)
+let show_state = function
+  | D.InfoNoState -> '?'
+  | D.InfoRunning -> 'R'
+  | D.InfoBlocked -> 'S'
+  | D.InfoPaused -> 'P'
+  | D.InfoShutdown -> 'D'
+  | D.InfoShutoff -> 'O'
+  | D.InfoCrashed -> 'X'
diff --git a/src/screen.mli b/src/screen.mli
new file mode 100644 (file)
index 0000000..a8a23a0
--- /dev/null
@@ -0,0 +1,41 @@
+(* 'top'-like tool for libvirt domains.
+   (C) Copyright 2007-2017 Richard W.M. Jones, Red Hat Inc.
+   http://libvirt.org/
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU General Public License as published by
+   the Free Software Foundation; either version 2 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   along with this program; if not, write to the Free Software
+   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+*)
+
+(** The virt-top screen layout. *)
+
+(* Line numbers. *)
+val top_lineno : int
+val summary_lineno : int (** this takes 2 lines *)
+val message_lineno : int
+val header_lineno : int
+val domains_lineno : int
+
+(* Easier to use versions of curses functions addstr, mvaddstr, etc. *)
+val move : int -> int -> unit
+val refresh : unit -> unit
+val addch : char -> unit
+val addstr : string -> unit
+val mvaddstr : int -> int -> string -> unit
+
+(* Print in the "message area". *)
+val clear_msg : unit -> unit
+val print_msg : string -> unit
+
+(* Show a libvirt domain state (the 'S' column). *)
+val show_state : Libvirt.Domain.state -> char
diff --git a/src/stream_output.ml b/src/stream_output.ml
new file mode 100644 (file)
index 0000000..bf7b114
--- /dev/null
@@ -0,0 +1,84 @@
+(* 'top'-like tool for libvirt domains.
+   (C) Copyright 2007-2017 Richard W.M. Jones, Red Hat Inc.
+   http://libvirt.org/
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU General Public License as published by
+   the Free Software Foundation; either version 2 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   along with this program; if not, write to the Free Software
+   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+*)
+
+(* [--stream] mode output functions. *)
+
+open Printf
+open ExtList
+
+open Utils
+open Collect
+
+module C = Libvirt.Connect
+module D = Libvirt.Domain
+
+let append_stream (_, _, _, _, _, node_info, hostname, _) (* setup *)
+                  block_in_bytes
+                  { rd_doms = doms;
+                    rd_printable_time = printable_time;
+                    rd_nr_pcpus = nr_pcpus; rd_total_cpu = total_cpu;
+                    rd_totals = totals } (* state *) =
+  (* Header for this iteration *)
+  printf "virt-top time  %s Host %s %s %d/%dCPU %dMHz %LdMB \n"
+    printable_time hostname node_info.C.model node_info.C.cpus nr_pcpus
+    node_info.C.mhz (node_info.C.memory /^ 1024L);
+  (* dump domain information one by one *)
+   let rd, wr = if block_in_bytes then "RDBY", "WRBY" else "RDRQ", "WRRQ"
+   in
+     printf "   ID S %s %s RXBY TXBY %%CPU %%MEM   TIME    NAME\n" rd wr;
+
+  (* sort by ID *)
+  let doms =
+    let compare =
+      (function
+       | Active {rd_domid = id1 }, Active {rd_domid = id2} ->
+           compare id1 id2
+       | Active _, Inactive -> -1
+       | Inactive, Active _ -> 1
+       | Inactive, Inactive -> 0)
+    in
+    let cmp  (name1, dom1) (name2, dom2) = compare(dom1, dom2) in
+    List.sort ~cmp doms in
+  (*Print domains *)
+  let dump_domain = fun name rd
+  -> begin
+    let state = Screen.show_state rd.rd_info.D.state in
+         let rd_req = if rd.rd_block_rd_info = None then "   0"
+                      else Show.int64_option rd.rd_block_rd_info in
+         let wr_req = if rd.rd_block_wr_info = None then "   0"
+                      else Show.int64_option rd.rd_block_wr_info in
+    let rx_bytes = if rd.rd_net_rx_bytes = None then "   0"
+    else Show.int64_option rd.rd_net_rx_bytes in
+    let tx_bytes = if rd.rd_net_tx_bytes = None then "   0"
+    else Show.int64_option rd.rd_net_tx_bytes in
+    let percent_cpu = Show.percent rd.rd_percent_cpu in
+    let percent_mem = Int64.to_float rd.rd_mem_percent in
+    let percent_mem = Show.percent percent_mem in
+    let time = Show.time rd.rd_info.D.cpu_time in
+    printf "%5d %c %s %s %s %s %s %s %s %s\n"
+      rd.rd_domid state rd_req wr_req rx_bytes tx_bytes
+      percent_cpu percent_mem time name;
+  end
+  in
+  List.iter (
+    function
+    | name, Active dom -> dump_domain name dom
+    | name, Inactive -> ()
+  ) doms;
+  flush stdout
diff --git a/src/stream_output.mli b/src/stream_output.mli
new file mode 100644 (file)
index 0000000..c45e548
--- /dev/null
@@ -0,0 +1,22 @@
+(* 'top'-like tool for libvirt domains.
+   (C) Copyright 2007-2017 Richard W.M. Jones, Red Hat Inc.
+   http://libvirt.org/
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU General Public License as published by
+   the Free Software Foundation; either version 2 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   along with this program; if not, write to the Free Software
+   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+*)
+
+(** [--stream] mode output functions. *)
+
+val append_stream : Types.setup -> bool -> Collect.stats -> unit
index f50e6a8..204f3b6 100644 (file)
@@ -1,5 +1,5 @@
 (* 'top'-like tool for libvirt domains.
-   (C) Copyright 2007-2009 Richard W.M. Jones, Red Hat Inc.
+   (C) Copyright 2007-2017 Richard W.M. Jones, Red Hat Inc.
    http://libvirt.org/
 
    This program is free software; you can redistribute it and/or modify
@@ -23,6 +23,9 @@ open Curses
 
 open Opt_gettext.Gettext
 open Utils
+open Types
+open Collect
+open Screen
 
 module C = Libvirt.Connect
 module D = Libvirt.Domain
@@ -30,21 +33,11 @@ module N = Libvirt.Network
 
 let rcfile = ".virt-toprc"
 
-(* Hook for XML support (see [opt_xml.ml]). *)
-let parse_device_xml : (int -> [>`R] D.t -> string list * string list) ref =
-  ref (
-    fun _ _ -> [], []
-  )
-
 (* Hooks for CSV support (see [opt_csv.ml]). *)
 let csv_start : (string -> unit) ref =
   ref (
     fun _ -> failwith (s_"virt-top was compiled without support for CSV files")
   )
-let csv_write : (string list -> unit) ref =
-  ref (
-    fun _ -> ()
-  )
 
 (* Hook for calendar support (see [opt_calendar.ml]). *)
 let parse_date_time : (string -> float) ref =
@@ -53,62 +46,6 @@ let parse_date_time : (string -> float) ref =
       failwith (s_"virt-top was compiled without support for dates and times")
   )
 
-(* Sort order. *)
-type sort_order =
-  | DomainID | DomainName | Processor | Memory | Time
-  | NetRX | NetTX | BlockRdRq | BlockWrRq
-let all_sort_fields = [
-  DomainID; DomainName; Processor; Memory; Time;
-  NetRX; NetTX; BlockRdRq; BlockWrRq
-]
-let printable_sort_order = function
-  | Processor -> s_"%CPU"
-  | Memory -> s_"%MEM"
-  | Time -> s_"TIME (CPU time)"
-  | DomainID -> s_"Domain ID"
-  | DomainName -> s_"Domain name"
-  | NetRX -> s_"Net RX bytes"
-  | NetTX -> s_"Net TX bytes"
-  | BlockRdRq -> s_"Block read reqs"
-  | BlockWrRq -> s_"Block write reqs"
-let sort_order_of_cli = function
-  | "cpu" | "processor" -> Processor
-  | "mem" | "memory" -> Memory
-  | "time" -> Time
-  | "id" -> DomainID
-  | "name" -> DomainName
-  | "netrx" -> NetRX | "nettx" -> NetTX
-  | "blockrdrq" -> BlockRdRq | "blockwrrq" -> BlockWrRq
-  | str ->
-      failwithf (f_"%s: sort order should be: %s")
-       str "cpu|mem|time|id|name|netrx|nettx|blockrdrq|blockwrrq"
-let cli_of_sort_order = function
-  | Processor -> "cpu"
-  | Memory -> "mem"
-  | Time -> "time"
-  | DomainID -> "id"
-  | DomainName -> "name"
-  | NetRX -> "netrx"
-  | NetTX -> "nettx"
-  | BlockRdRq -> "blockrdrq"
-  | BlockWrRq -> "blockwrrq"
-
-(* Current major display mode: TaskDisplay is the normal display. *)
-type display = TaskDisplay | PCPUDisplay | BlockDisplay | NetDisplay
-
-let display_of_cli = function
-  | "task" -> TaskDisplay
-  | "pcpu" -> PCPUDisplay
-  | "block" -> BlockDisplay
-  | "net" -> NetDisplay
-  | str ->
-      failwithf (f_"%s: display should be %s") str "task|pcpu|block|net"
-let cli_of_display = function
-  | TaskDisplay -> "task"
-  | PCPUDisplay -> "pcpu"
-  | BlockDisplay -> "block"
-  | NetDisplay -> "net"
-
 (* Init file. *)
 type init_file = NoInitFile | DefaultInitFile | InitFile of string
 
@@ -134,11 +71,6 @@ let script_mode = ref false
 let stream_mode = ref false
 let block_in_bytes = ref false
 
-(* Tuple of never-changing data returned by start_up function. *)
-type setup =
-    Libvirt.ro C.t * bool * bool * bool * bool * C.node_info * string *
-      (int * int * int)
-
 (* Function to read command line arguments and go into curses mode. *)
 let start_up () =
   (* Read command line arguments. *)
@@ -352,16 +284,6 @@ OPTIONS" in
    node_info, hostname, libvirt_version (* info that doesn't change *)
   )
 
-(* Show a domain state (the 'S' column). *)
-let show_state = function
-  | D.InfoNoState -> '?'
-  | D.InfoRunning -> 'R'
-  | D.InfoBlocked -> 'S'
-  | D.InfoPaused -> 'P'
-  | D.InfoShutdown -> 'D'
-  | D.InfoShutoff -> 'O'
-  | D.InfoCrashed -> 'X'
-
 (* Sleep in seconds. *)
 let sleep = Unix.sleep
 
@@ -387,1039 +309,33 @@ let get_string maxlen =
       Not_found -> str (* it is full maxlen bytes *)
   )
 
-(* Line numbers. *)
-let top_lineno = 0
-let summary_lineno = 1 (* this takes 2 lines *)
-let message_lineno = 3
-let header_lineno = 4
-let domains_lineno = 5
-
-(* Easier to use versions of curses functions addstr, mvaddstr, etc. *)
-let move y x = ignore (move y x)
-let refresh () = ignore (refresh ())
-let addch c = ignore (addch (int_of_char c))
-let addstr s = ignore (addstr s)
-let mvaddstr y x s = ignore (mvaddstr y x s)
-
-(* Print in the "message area". *)
-let clear_msg () = move message_lineno 0; clrtoeol ()
-let print_msg str = clear_msg (); mvaddstr message_lineno 0 str
-
-(* Intermediate "domain + stats" structure that we use to collect
- * everything we know about a domain within the collect function.
- *)
-type rd_domain = Inactive | Active of rd_active
-and rd_active = {
-  rd_domid : int;                      (* Domain ID. *)
-  rd_dom : [`R] D.t;                   (* Domain object. *)
-  rd_info : D.info;                    (* Domain CPU info now. *)
-  rd_block_stats : (string * D.block_stats) list;
-                                        (* Domain block stats now. *)
-  rd_interface_stats : (string * D.interface_stats) list;
-                                        (* Domain net stats now. *)
-  rd_prev_info : D.info option;                (* Domain CPU info previously. *)
-  rd_prev_block_stats : (string * D.block_stats) list;
-                                        (* Domain block stats prev. *)
-  rd_prev_interface_stats : (string * D.interface_stats) list;
-                                        (* Domain interface stats prev. *)
-  (* The following are since the last slice, or 0 if cannot be calculated: *)
-  rd_cpu_time : float;                 (* CPU time used in nanoseconds. *)
-  rd_percent_cpu : float;              (* CPU time as percent of total. *)
-  rd_mem_bytes : int64;                        (* Memory usage in bytes *)
-  rd_mem_percent: int64;               (* Memory usage as percent of total *)
-  (* The following are since the last slice, or None if cannot be calc'd: *)
-  rd_block_rd_reqs : int64 option;      (* Number of block device read rqs. *)
-  rd_block_wr_reqs : int64 option;      (* Number of block device write rqs. *)
-  rd_block_rd_bytes : int64 option;   (* Number of bytes block device read *)
-  rd_block_wr_bytes : int64 option;   (* Number of bytes block device write *)
-  (* _info fields includes the number considering --block_in_bytes option *)
-  rd_block_rd_info : int64 option;    (* Block device read info for user *)
-  rd_block_wr_info : int64 option;    (* Block device read info for user *)
-
-  rd_net_rx_bytes : int64 option;      (* Number of bytes received. *)
-  rd_net_tx_bytes : int64 option;      (* Number of bytes transmitted. *)
-}
-
-(* Collect stats. *)
-let collect, clear_pcpu_display_data =
-  (* We cache the list of block devices and interfaces for each domain
-   * here, so we don't need to reparse the XML each time.
-   *)
-  let devices = Hashtbl.create 13 in
-
-  (* Function to get the list of block devices, network interfaces for
-   * a particular domain.  Get it from the devices cache, and if not
-   * there then parse the domain XML.
-   *)
-  let get_devices id dom =
-    try Hashtbl.find devices id
-    with Not_found ->
-      let blkdevs, netifs = (!parse_device_xml) id dom in
-      Hashtbl.replace devices id (blkdevs, netifs);
-      blkdevs, netifs
-  in
-
-  (* We save the state of domains across redraws here, which allows us
-   * to deduce %CPU usage from the running total.
-   *)
-  let last_info = Hashtbl.create 13 in
-  let last_time = ref (Unix.gettimeofday ()) in
-
-  (* Save pcpu_usages structures across redraws too (only for pCPU display). *)
-  let last_pcpu_usages = Hashtbl.create 13 in
-
-  let clear_pcpu_display_data () =
-    (* Clear out pcpu_usages used by PCPUDisplay display_mode
-     * when we switch back to TaskDisplay mode.
-     *)
-    Hashtbl.clear last_pcpu_usages
-  in
-
-  let collect (conn, _, _, _, _, node_info, _, _) =
-    (* Number of physical CPUs (some may be disabled). *)
-    let nr_pcpus = C.maxcpus_of_node_info node_info in
-
-    (* Get the current time. *)
-    let time = Unix.gettimeofday () in
-    let tm = Unix.localtime time in
-    let printable_time =
-      sprintf "%02d:%02d:%02d" tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec in
-
-    (* What's the total CPU time elapsed since we were last called? (ns) *)
-    let total_cpu_per_pcpu = 1_000_000_000. *. (time -. !last_time) in
-    (* Avoid division by zero. *)
-    let total_cpu_per_pcpu =
-      if total_cpu_per_pcpu <= 0. then 1. else total_cpu_per_pcpu in
-    let total_cpu = float node_info.C.cpus *. total_cpu_per_pcpu in
-
-    (* 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
-
-             (* 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 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
-
-             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_block_rd_info = None; rd_block_wr_info = None;
-                     rd_net_rx_bytes = None; rd_net_tx_bytes = None;
-                   })
-           with
-             Libvirt.Virterror _ -> None (* ignore transient error *)
-       ) ids 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
-
-      doms @ doms_inactive in
-
-    (* Calculate the CPU time (ns) and %CPU used by each domain. *)
-    let doms =
-      List.map (
-       function
-       (* We have previous CPU info from which to calculate it? *)
-       | name, Active ({ rd_prev_info = Some prev_info } as rd) ->
-           let cpu_time =
-             Int64.to_float (rd.rd_info.D.cpu_time -^ prev_info.D.cpu_time) in
-           let percent_cpu = 100. *. cpu_time /. total_cpu in
-            let mem_usage = rd.rd_info.D.memory in
-            let mem_percent =
-                100L *^ rd.rd_info.D.memory /^ node_info.C.memory in
-           let rd = { rd with
-                        rd_cpu_time = cpu_time;
-                        rd_percent_cpu = percent_cpu;
-                        rd_mem_bytes = mem_usage;
-                         rd_mem_percent = mem_percent} in
-           name, Active rd
-       (* For all other domains we can't calculate it, so leave as 0 *)
-       | rd -> rd
-      ) doms in
-
-    (* Calculate the number of block device read/write requests across
-     * all block devices attached to a domain.
-     *)
-    let doms =
-      List.map (
-       function
-       (* Do we have stats from the previous slice? *)
-       | name, Active ({ rd_prev_block_stats = ((_::_) as prev_block_stats) }
-                         as rd) ->
-           let block_stats = rd.rd_block_stats in (* stats now *)
-
-           (* Add all the devices together.  Throw away device names. *)
-           let prev_block_stats =
-             sum_block_stats (List.map snd prev_block_stats) in
-           let block_stats =
-             sum_block_stats (List.map snd block_stats) in
-
-           (* Calculate increase in read & write requests. *)
-           let read_reqs =
-             block_stats.D.rd_req -^ prev_block_stats.D.rd_req in
-           let write_reqs =
-             block_stats.D.wr_req -^ prev_block_stats.D.wr_req in
-            let read_bytes =
-              block_stats.D.rd_bytes -^ prev_block_stats.D.rd_bytes in
-            let write_bytes =
-              block_stats.D.wr_bytes -^ prev_block_stats.D.wr_bytes in
-
-           let rd = { rd with
-                        rd_block_rd_reqs = Some read_reqs;
-                        rd_block_wr_reqs = Some write_reqs;
-                         rd_block_rd_bytes = Some read_bytes;
-                         rd_block_wr_bytes = Some write_bytes;
-            } in
-            let rd = { rd with
-                         rd_block_rd_info = if !block_in_bytes then
-                         rd.rd_block_rd_bytes else rd.rd_block_rd_reqs;
-                         rd_block_wr_info = if !block_in_bytes then
-                         rd.rd_block_wr_bytes else rd.rd_block_wr_reqs;
-            } in
-           name, Active rd
-       (* For all other domains we can't calculate it, so leave as None. *)
-       | rd -> rd
-      ) doms in
-
-    (* Calculate the same as above for network interfaces across
-     * all network interfaces attached to a domain.
-     *)
-    let doms =
-      List.map (
-       function
-       (* Do we have stats from the previous slice? *)
-       | name, Active ({ rd_prev_interface_stats =
-                             ((_::_) as prev_interface_stats) }
-                         as rd) ->
-           let interface_stats = rd.rd_interface_stats in (* stats now *)
-
-           (* Add all the devices together.  Throw away device names. *)
-           let prev_interface_stats =
-             sum_interface_stats (List.map snd prev_interface_stats) in
-           let interface_stats =
-             sum_interface_stats (List.map snd interface_stats) in
-
-           (* Calculate increase in rx & tx bytes. *)
-           let rx_bytes =
-             interface_stats.D.rx_bytes -^ prev_interface_stats.D.rx_bytes in
-           let tx_bytes =
-             interface_stats.D.tx_bytes -^ prev_interface_stats.D.tx_bytes in
-
-           let rd = { rd with
-                        rd_net_rx_bytes = Some rx_bytes;
-                        rd_net_tx_bytes = Some tx_bytes } in
-           name, Active rd
-       (* For all other domains we can't calculate it, so leave as None. *)
-       | rd -> rd
-      ) doms in
-
-    (* Collect some extra information in PCPUDisplay display_mode. *)
-    let pcpu_display =
-      if !display_mode = PCPUDisplay then (
-       (* Get the VCPU info and VCPU->PCPU mappings for active domains.
-        * Also cull some data we don't care about.
-        *)
-       let doms = List.filter_map (
-         function
-         | (name, Active rd) ->
-             (try
-                let domid = rd.rd_domid in
-                let maplen = C.cpumaplen nr_pcpus in
-                let cpu_stats = D.get_cpu_stats rd.rd_dom in
-
-                 (* Note the terminology is confusing.
-                  *
-                  * In libvirt, cpu_time is the total time (hypervisor + vCPU).
-                  * vcpu_time is the time only taken by the vCPU,
-                  * excluding time taken inside the hypervisor.
-                  *
-                  * For each pCPU, libvirt may return either "cpu_time"
-                  * or "vcpu_time" or neither or both.  This function
-                  * returns an array pair [|cpu_time, vcpu_time|];
-                  * if either is missing it is returned as 0.
-                  *)
-                let find_cpu_usages params =
-                   let rec find_uint64_field name = function
-                     | (n, D.TypedFieldUInt64 usage) :: _ when n = name -> usage
-                     | _ :: params -> find_uint64_field name params
-                     | [] -> 0L
-                   in
-                   [| find_uint64_field "cpu_time" params;
-                      find_uint64_field "vcpu_time" params |]
-                 in
-
-                let pcpu_usages = Array.map find_cpu_usages cpu_stats in
-                let maxinfo = rd.rd_info.D.nr_virt_cpu in
-                let nr_vcpus, vcpu_infos, cpumaps =
-                  D.get_vcpus rd.rd_dom maxinfo maplen in
-
-                (* Got previous pcpu_usages for this domain? *)
-                let prev_pcpu_usages =
-                  try Some (Hashtbl.find last_pcpu_usages domid)
-                  with Not_found -> None in
-                (* Update last_pcpu_usages. *)
-                Hashtbl.replace last_pcpu_usages domid pcpu_usages;
-
-                (match prev_pcpu_usages with
-                 | Some prev_pcpu_usages
-                     when Array.length prev_pcpu_usages = Array.length pcpu_usages ->
-                     Some (domid, name, nr_vcpus, vcpu_infos, pcpu_usages,
-                           prev_pcpu_usages, cpumaps, maplen)
-                 | _ -> None (* ignore missing / unequal length prev_vcpu_infos *)
-                );
-              with
-                Libvirt.Virterror _ -> None(* ignore transient libvirt errs *)
-             )
-         | (_, Inactive) -> None (* ignore inactive doms *)
-       ) doms in
-       let nr_doms = List.length doms in
-
-       (* Rearrange the data into a matrix.  Major axis (down) is
-        * pCPUs.  Minor axis (right) is domains.  At each node we store:
-        *  cpu_time hypervisor + domain (on this pCPU only, nanosecs),
-        *  vcpu_time domain only (on this pCPU only, nanosecs).
-        *)
-        let make_3d_array dimx dimy dimz e =
-          Array.init dimx (fun _ -> Array.make_matrix dimy dimz e)
-        in
-       let pcpus = make_3d_array nr_pcpus nr_doms 2 0L in
-
-       List.iteri (
-         fun di (domid, name, nr_vcpus, vcpu_infos, pcpu_usages,
-                 prev_pcpu_usages, cpumaps, maplen) ->
-           (* Which pCPUs can this dom run on? *)
-           for p = 0 to Array.length pcpu_usages - 1 do
-             pcpus.(p).(di).(0) <-
-                pcpu_usages.(p).(0) -^ prev_pcpu_usages.(p).(0);
-             pcpus.(p).(di).(1) <-
-                pcpu_usages.(p).(1) -^ prev_pcpu_usages.(p).(1)
-            done
-       ) doms;
-
-       (* Sum the total CPU time used by each pCPU, for the %CPU column. *)
-       let pcpus_cpu_time = Array.map (
-         fun row ->
-           let cpu_time = ref 0L in
-           for di = 0 to Array.length row-1 do
-             let t = row.(di).(0) in
-             cpu_time := !cpu_time +^ t
-           done;
-           Int64.to_float !cpu_time
-       ) pcpus in
-
-       Some (doms, pcpus, pcpus_cpu_time)
-      ) else
-       None in
-
-    (* Calculate totals. *)
-    let totals = List.fold_left (
-      fun (count, running, blocked, paused, shutdown, shutoff,
-          crashed, active, inactive,
-          total_cpu_time, total_memory, total_domU_memory) ->
-       function
-       | (name, Active rd) ->
-           let test state orig =
-             if rd.rd_info.D.state = state then orig+1 else orig
-           in
-           let running = test D.InfoRunning running in
-           let blocked = test D.InfoBlocked blocked in
-           let paused = test D.InfoPaused paused in
-           let shutdown = test D.InfoShutdown shutdown in
-           let shutoff = test D.InfoShutoff shutoff in
-           let crashed = test D.InfoCrashed crashed in
-
-           let total_cpu_time = total_cpu_time +. rd.rd_cpu_time in
-           let total_memory = total_memory +^ rd.rd_info.D.memory in
-           let total_domU_memory = total_domU_memory +^
-             if rd.rd_domid > 0 then rd.rd_info.D.memory else 0L in
-
-           (count+1, running, blocked, paused, shutdown, shutoff,
-            crashed, active+1, inactive,
-            total_cpu_time, total_memory, total_domU_memory)
-
-       | (name, Inactive) -> (* inactive domain *)
-           (count+1, running, blocked, paused, shutdown, shutoff,
-            crashed, active, inactive+1,
-            total_cpu_time, total_memory, total_domU_memory)
-    ) (0,0,0,0,0,0,0,0,0, 0.,0L,0L) doms in
-
-    (* Update last_time, last_info. *)
-    last_time := time;
-    Hashtbl.clear last_info;
-    List.iter (
-      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
-      | _ -> ()
-    ) doms;
-
-    (doms,
-     time, printable_time,
-     nr_pcpus, total_cpu, total_cpu_per_pcpu,
-     totals,
-     pcpu_display)
-  in
-
-  collect, clear_pcpu_display_data
-
-(* Redraw the display. *)
-let redraw =
-  (* Keep a historical list of %CPU usages. *)
-  let historical_cpu = ref [] in
-  let historical_cpu_last_time = ref (Unix.gettimeofday ()) in
-  fun
-  (_, _, _, _, _, node_info, _, _) (* setup *)
-  (doms,
-   time, printable_time,
-   nr_pcpus, total_cpu, total_cpu_per_pcpu,
-   totals,
-   pcpu_display) (* state *) ->
-    clear ();
-
-    (* Get the screen/window size. *)
-    let lines, cols = get_size () in
-
-    (* Time. *)
-    mvaddstr top_lineno 0 (sprintf "virt-top %s - " printable_time);
-
-    (* Basic node_info. *)
-    addstr
-      (sprintf "%s %d/%dCPU %dMHz %LdMB "
-        node_info.C.model node_info.C.cpus nr_pcpus node_info.C.mhz
-        (node_info.C.memory /^ 1024L));
-    (* Save the cursor position for when we come to draw the
-     * historical CPU times (down in this function).
-     *)
-    let stdscr = stdscr () in
-    let historical_cursor = getyx stdscr in
-
-    (match !display_mode with
-     | TaskDisplay -> (*---------- Showing domains ----------*)
-        (* Sort domains on current sort_order. *)
-        let doms =
-          let cmp =
-            match !sort_order with
-            | DomainName ->
-                (fun _ -> 0) (* fallthrough to default name compare *)
-            | Processor ->
-                (function
-                 | Active rd1, Active rd2 ->
-                     compare rd2.rd_percent_cpu rd1.rd_percent_cpu
-                 | Active _, Inactive -> -1
-                 | Inactive, Active _ -> 1
-                 | Inactive, Inactive -> 0)
-            | Memory ->
-                (function
-                 | Active { rd_info = info1 }, Active { rd_info = info2 } ->
-                     compare info2.D.memory info1.D.memory
-                 | Active _, Inactive -> -1
-                 | Inactive, Active _ -> 1
-                 | Inactive, Inactive -> 0)
-            | Time ->
-                (function
-                 | Active { rd_info = info1 }, Active { rd_info = info2 } ->
-                     compare info2.D.cpu_time info1.D.cpu_time
-                 | Active _, Inactive -> -1
-                 | Inactive, Active _ -> 1
-                 | Inactive, Inactive -> 0)
-            | DomainID ->
-                (function
-                 | Active { rd_domid = id1 }, Active { rd_domid = id2 } ->
-                     compare id1 id2
-                 | Active _, Inactive -> -1
-                 | Inactive, Active _ -> 1
-                 | Inactive, Inactive -> 0)
-            | NetRX ->
-                (function
-                 | Active { rd_net_rx_bytes = r1 }, Active { rd_net_rx_bytes = r2 } ->
-                     compare r2 r1
-                 | Active _, Inactive -> -1
-                 | Inactive, Active _ -> 1
-                 | Inactive, Inactive -> 0)
-            | NetTX ->
-                (function
-                 | Active { rd_net_tx_bytes = r1 }, Active { rd_net_tx_bytes = r2 } ->
-                     compare r2 r1
-                 | Active _, Inactive -> -1
-                 | Inactive, Active _ -> 1
-                 | Inactive, Inactive -> 0)
-            | BlockRdRq ->
-                (function
-                 | Active { rd_block_rd_reqs = r1 }, Active { rd_block_rd_reqs = r2 } ->
-                     compare r2 r1
-                 | Active _, Inactive -> -1
-                 | Inactive, Active _ -> 1
-                 | Inactive, Inactive -> 0)
-            | BlockWrRq ->
-                (function
-                 | Active { rd_block_wr_reqs = r1 }, Active { rd_block_wr_reqs = r2 } ->
-                     compare r2 r1
-                 | Active _, Inactive -> -1
-                 | Inactive, Active _ -> 1
-                 | Inactive, Inactive -> 0)
-          in
-          let cmp (name1, dom1) (name2, dom2) =
-            let r = cmp (dom1, dom2) in
-            if r <> 0 then r
-            else compare name1 name2
-          in
-          List.sort ~cmp doms in
-
-        (* Print domains. *)
-        attron A.reverse;
-         let header_string = if !block_in_bytes
-         then "   ID S RDBY WRBY RXBY TXBY %CPU %MEM    TIME   NAME"
-         else "   ID S RDRQ WRRQ RXBY TXBY %CPU %MEM    TIME   NAME"
-         in
-          mvaddstr header_lineno 0
-           (pad cols header_string);
-        attroff A.reverse;
-
-        let rec loop lineno = function
-          | [] -> ()
-          | (name, Active rd) :: doms ->
-              if lineno < lines then (
-                let state = show_state rd.rd_info.D.state in
-                let rd_req = Show.int64_option rd.rd_block_rd_info in
-                let wr_req = Show.int64_option rd.rd_block_wr_info in
-                let rx_bytes = Show.int64_option rd.rd_net_rx_bytes in
-                let tx_bytes = Show.int64_option rd.rd_net_tx_bytes in
-                let percent_cpu = Show.percent rd.rd_percent_cpu in
-                let percent_mem = Int64.to_float rd.rd_mem_percent in
-                let percent_mem = Show.percent percent_mem in
-                let time = Show.time rd.rd_info.D.cpu_time in
-
-                let line = sprintf "%5d %c %s %s %s %s %s %s %s %s"
-                  rd.rd_domid state rd_req wr_req rx_bytes tx_bytes
-                  percent_cpu percent_mem time name in
-                let line = pad cols line in
-                mvaddstr lineno 0 line;
-                loop (lineno+1) doms
-              )
-          | (name, Inactive) :: doms -> (* inactive domain *)
-              if lineno < lines then (
-                let line =
-                  sprintf
-                    "    -                                           (%s)"
-                    name in
-                let line = pad cols line in
-                mvaddstr lineno 0 line;
-                loop (lineno+1) doms
-              )
-        in
-        loop domains_lineno doms
-
-     | PCPUDisplay -> (*---------- Showing physical CPUs ----------*)
-        let doms, pcpus, pcpus_cpu_time =
-          match pcpu_display with
-          | Some p -> p
-          | None -> failwith "internal error: no pcpu_display data" in
-
-        (* Display the pCPUs. *)
-        let dom_names =
-          String.concat "" (
-            List.map (
-              fun (_, name, _, _, _, _, _, _) ->
-                let len = String.length name in
-                let width = max (len+1) 12 in
-                pad width name
-            ) doms
-          ) in
-        attron A.reverse;
-        mvaddstr header_lineno 0 (pad cols ("PHYCPU %CPU " ^ dom_names));
-        attroff A.reverse;
-
-        Array.iteri (
-          fun p row ->
-            mvaddstr (p+domains_lineno) 0 (sprintf "%4d   " p);
-            let cpu_time = pcpus_cpu_time.(p) in (* ns used on this CPU *)
-            let percent_cpu = 100. *. cpu_time /. total_cpu_per_pcpu in
-            addstr (Show.percent percent_cpu);
-            addch ' ';
-
-            List.iteri (
-              fun di (domid, name, _, _, _, _, _, _) ->
-                let t = pcpus.(p).(di).(0) in (* hypervisor + domain *)
-                let t_only = pcpus.(p).(di).(1) in (* domain only *)
-                let len = String.length name in
-                let width = max (len+1) 12 in
-                let str_t =
-                  if t <= 0L then ""
-                  else (
-                    let t = Int64.to_float t in
-                    let percent = 100. *. t /. total_cpu_per_pcpu in
-                    Show.percent percent
-                  ) in
-                 let str_t_only =
-                    if t_only <= 0L then ""
-                    else (
-                      let t_only = Int64.to_float t_only in
-                      let percent = 100. *. t_only /. total_cpu_per_pcpu in
-                      Show.percent percent
-                    ) in
-                 addstr (pad 5 str_t);
-                 addstr (pad 5 str_t_only);
-                 addstr (pad (width-10) " ");
-                ()
-            ) doms
-        ) pcpus;
-
-     | NetDisplay -> (*---------- Showing network interfaces ----------*)
-        (* Only care about active domains. *)
-        let doms = List.filter_map (
-          function
-          | (name, Active rd) -> Some (name, rd)
-          | (_, Inactive) -> None
-        ) doms in
-
-        (* For each domain we have a list of network interfaces seen
-         * this slice, and seen in the previous slice, which we now
-         * match up to get a list of (domain, interface) for which
-         * we have current & previous knowledge.  (And ignore the rest).
-         *)
-        let devs =
-          List.map (
-            fun (name, rd) ->
-              List.filter_map (
-                fun (dev, stats) ->
-                  try
-                    (* Have prev slice stats for this device? *)
-                    let prev_stats =
-                      List.assoc dev rd.rd_prev_interface_stats in
-                    Some (dev, name, rd, stats, prev_stats)
-                  with Not_found -> None
-              ) rd.rd_interface_stats
-          ) doms in
-
-        (* Finally we have a list of:
-         * device name, domain name, rd_* stuff, curr stats, prev stats.
-         *)
-        let devs : (string * string * rd_active *
-                      D.interface_stats * D.interface_stats) list =
-          List.flatten devs in
-
-        (* Difference curr slice & prev slice. *)
-        let devs = List.map (
-          fun (dev, name, rd, curr, prev) ->
-            dev, name, rd, diff_interface_stats curr prev
-        ) devs in
-
-        (* Sort by current sort order, but map some of the standard
-         * sort orders into ones which makes sense here.
-         *)
-        let devs =
-          let cmp =
-            match !sort_order with
-            | DomainName ->
-                (fun _ -> 0) (* fallthrough to default name compare *)
-            | DomainID ->
-                (fun (_, { rd_domid = id1 }, _, { rd_domid = id2 }) ->
-                   compare id1 id2)
-            | Processor | Memory | Time | BlockRdRq | BlockWrRq
-                  (* fallthrough to RXBY comparison. *)
-            | NetRX ->
-                (fun ({ D.rx_bytes = b1 }, _, { D.rx_bytes = b2 }, _) ->
-                   compare b2 b1)
-            | NetTX ->
-                (fun ({ D.tx_bytes = b1 }, _, { D.tx_bytes = b2 }, _) ->
-                   compare b2 b1)
-          in
-          let cmp (dev1, name1, rd1, stats1) (dev2, name2, rd2, stats2) =
-            let r = cmp (stats1, rd1, stats2, rd2) in
-            if r <> 0 then r
-            else compare (dev1, name1) (dev2, name2)
-          in
-          List.sort ~cmp devs in
-
-        (* Print the header for network devices. *)
-        attron A.reverse;
-        mvaddstr header_lineno 0
-          (pad cols "   ID S RXBY TXBY RXPK TXPK DOMAIN       INTERFACE");
-        attroff A.reverse;
-
-        (* Print domains and devices. *)
-        let rec loop lineno = function
-          | [] -> ()
-          | (dev, name, rd, stats) :: devs ->
-              if lineno < lines then (
-                let state = show_state rd.rd_info.D.state in
-                let rx_bytes =
-                  if stats.D.rx_bytes >= 0L
-                  then Show.int64 stats.D.rx_bytes
-                  else "    " in
-                let tx_bytes =
-                  if stats.D.tx_bytes >= 0L
-                  then Show.int64 stats.D.tx_bytes
-                  else "    " in
-                let rx_packets =
-                  if stats.D.rx_packets >= 0L
-                  then Show.int64 stats.D.rx_packets
-                  else "    " in
-                let tx_packets =
-                  if stats.D.tx_packets >= 0L
-                  then Show.int64 stats.D.tx_packets
-                  else "    " in
-
-                let line = sprintf "%5d %c %s %s %s %s %-12s %s"
-                  rd.rd_domid state
-                  rx_bytes tx_bytes
-                  rx_packets tx_packets
-                  (pad 12 name) dev in
-                let line = pad cols line in
-                mvaddstr lineno 0 line;
-                loop (lineno+1) devs
-              )
-        in
-        loop domains_lineno devs
-
-     | BlockDisplay -> (*---------- Showing block devices ----------*)
-        (* Only care about active domains. *)
-        let doms = List.filter_map (
-          function
-          | (name, Active rd) -> Some (name, rd)
-          | (_, Inactive) -> None
-        ) doms in
-
-        (* For each domain we have a list of block devices seen
-         * this slice, and seen in the previous slice, which we now
-         * match up to get a list of (domain, device) for which
-         * we have current & previous knowledge.  (And ignore the rest).
-         *)
-        let devs =
-          List.map (
-            fun (name, rd) ->
-              List.filter_map (
-                fun (dev, stats) ->
-                  try
-                    (* Have prev slice stats for this device? *)
-                    let prev_stats =
-                      List.assoc dev rd.rd_prev_block_stats in
-                    Some (dev, name, rd, stats, prev_stats)
-                  with Not_found -> None
-              ) rd.rd_block_stats
-          ) doms in
-
-        (* Finally we have a list of:
-         * device name, domain name, rd_* stuff, curr stats, prev stats.
-         *)
-        let devs : (string * string * rd_active *
-                      D.block_stats * D.block_stats) list =
-          List.flatten devs in
-
-        (* Difference curr slice & prev slice. *)
-        let devs = List.map (
-          fun (dev, name, rd, curr, prev) ->
-            dev, name, rd, diff_block_stats curr prev
-        ) devs in
-
-        (* Sort by current sort order, but map some of the standard
-         * sort orders into ones which makes sense here.
-         *)
-        let devs =
-          let cmp =
-            match !sort_order with
-            | DomainName ->
-                (fun _ -> 0) (* fallthrough to default name compare *)
-            | DomainID ->
-                (fun (_, { rd_domid = id1 }, _, { rd_domid = id2 }) ->
-                   compare id1 id2)
-            | Processor | Memory | Time | NetRX | NetTX
-                  (* fallthrough to RDRQ comparison. *)
-            | BlockRdRq ->
-                (fun ({ D.rd_req = b1 }, _, { D.rd_req = b2 }, _) ->
-                   compare b2 b1)
-            | BlockWrRq ->
-                (fun ({ D.wr_req = b1 }, _, { D.wr_req = b2 }, _) ->
-                   compare b2 b1)
-          in
-          let cmp (dev1, name1, rd1, stats1) (dev2, name2, rd2, stats2) =
-            let r = cmp (stats1, rd1, stats2, rd2) in
-            if r <> 0 then r
-            else compare (dev1, name1) (dev2, name2)
-          in
-          List.sort ~cmp devs in
-
-        (* Print the header for block devices. *)
-        attron A.reverse;
-        mvaddstr header_lineno 0
-          (pad cols "   ID S RDBY WRBY RDRQ WRRQ DOMAIN       DEVICE");
-        attroff A.reverse;
-
-        (* Print domains and devices. *)
-        let rec loop lineno = function
-          | [] -> ()
-          | (dev, name, rd, stats) :: devs ->
-              if lineno < lines then (
-                let state = show_state rd.rd_info.D.state in
-                let rd_bytes =
-                  if stats.D.rd_bytes >= 0L
-                  then Show.int64 stats.D.rd_bytes
-                  else "    " in
-                let wr_bytes =
-                  if stats.D.wr_bytes >= 0L
-                  then Show.int64 stats.D.wr_bytes
-                  else "    " in
-                let rd_req =
-                  if stats.D.rd_req >= 0L
-                  then Show.int64 stats.D.rd_req
-                  else "    " in
-                let wr_req =
-                  if stats.D.wr_req >= 0L
-                  then Show.int64 stats.D.wr_req
-                  else "    " in
-
-                let line = sprintf "%5d %c %s %s %s %s %-12s %s"
-                  rd.rd_domid state
-                  rd_bytes wr_bytes
-                  rd_req wr_req
-                  (pad 12 name) dev in
-                let line = pad cols line in
-                mvaddstr lineno 0 line;
-                loop (lineno+1) devs
-              )
-        in
-        loop domains_lineno devs
-    ); (* end of display_mode conditional section *)
-
-    let (count, running, blocked, paused, shutdown, shutoff,
-        crashed, active, inactive,
-        total_cpu_time, total_memory, total_domU_memory) = totals in
-
-    mvaddstr summary_lineno 0
-      (sprintf
-        (f_"%d domains, %d active, %d running, %d sleeping, %d paused, %d inactive D:%d O:%d X:%d")
-        count active running blocked paused inactive shutdown shutoff crashed);
-
-    (* Total %CPU used, and memory summary. *)
-    let percent_cpu = 100. *. total_cpu_time /. total_cpu in
-    mvaddstr (summary_lineno+1) 0
-      (sprintf
-        (f_"CPU: %2.1f%%  Mem: %Ld MB (%Ld MB by guests)")
-        percent_cpu (total_memory /^ 1024L) (total_domU_memory /^ 1024L));
-
-    (* Time to grab another historical %CPU for the list? *)
-    if time >= !historical_cpu_last_time +. float !historical_cpu_delay
-    then (
-      historical_cpu := percent_cpu :: List.take 10 !historical_cpu;
-      historical_cpu_last_time := time
-    );
-
-    (* Display historical CPU time. *)
-    let () =
-      let y, x = historical_cursor in
-      let maxwidth = cols - x in
-      let line =
-       String.concat " "
-         (List.map (sprintf "%2.1f%%") !historical_cpu) in
-      let line = pad maxwidth line in
-      mvaddstr y x line;
-      () in
-
-    move message_lineno 0; (* Park cursor in message area, as with top. *)
-    refresh ()            (* Refresh the display. *)
-
-(* Write CSV header row. *)
-let write_csv_header () =
-  (!csv_write) (
-    [ "Hostname"; "Time"; "Arch"; "Physical CPUs";
-      "Count"; "Running"; "Blocked"; "Paused"; "Shutdown";
-      "Shutoff"; "Crashed"; "Active"; "Inactive";
-      "%CPU";
-      "Total hardware memory (KB)";
-      "Total memory (KB)"; "Total guest memory (KB)";
-      "Total CPU time (ns)" ] @
-      (* These fields are repeated for each domain: *)
-    [ "Domain ID"; "Domain name"; ] @
-    (if !csv_cpu then [ "CPU (ns)"; "%CPU"; ] else []) @
-    (if !csv_mem then [ "Mem (bytes)"; "%Mem";] else []) @
-    (if !csv_block && not !block_in_bytes
-       then [ "Block RDRQ"; "Block WRRQ"; ] else []) @
-    (if !csv_block && !block_in_bytes
-       then [ "Block RDBY"; "Block WRBY"; ] else []) @
-    (if !csv_net then [ "Net RXBY"; "Net TXBY" ] else [])
-  )
-
-(* Write summary data to CSV file. *)
-let append_csv
-    (_, _, _, _, _, node_info, hostname, _) (* setup *)
-    (doms,
-     _, printable_time,
-     nr_pcpus, total_cpu, _,
-     totals,
-     _) (* state *) =
-
-  (* The totals / summary fields. *)
-  let (count, running, blocked, paused, shutdown, shutoff,
-       crashed, active, inactive,
-       total_cpu_time, total_memory, total_domU_memory) = totals in
-
-  let percent_cpu = 100. *. total_cpu_time /. total_cpu in
-
-  let summary_fields = [
-    hostname; printable_time; node_info.C.model; string_of_int nr_pcpus;
-    string_of_int count; string_of_int running; string_of_int blocked;
-    string_of_int paused; string_of_int shutdown; string_of_int shutoff;
-    string_of_int crashed; string_of_int active; string_of_int inactive;
-    sprintf "%2.1f" percent_cpu;
-    Int64.to_string node_info.C.memory;
-    Int64.to_string total_memory; Int64.to_string total_domU_memory;
-    Int64.to_string (Int64.of_float total_cpu_time)
-  ] in
-
-  (* The domains.
-   *
-   * Sort them by ID so that the list of relatively stable.  Ignore
-   * inactive domains.
-   *)
-  let doms = List.filter_map (
-    function
-    | _, Inactive -> None              (* Ignore inactive domains. *)
-    | name, Active rd -> Some (name, rd)
-  ) doms in
-  let cmp (_, { rd_domid = rd_domid1 }) (_, { rd_domid = rd_domid2 }) =
-    compare rd_domid1 rd_domid2
-  in
-  let doms = List.sort ~cmp doms in
-
-  let string_of_int64_option = Option.map_default Int64.to_string "" in
-
-  let domain_fields = List.map (
-    fun (domname, rd) ->
-      [ string_of_int rd.rd_domid; domname ] @
-       (if !csv_cpu then [
-          string_of_float rd.rd_cpu_time; string_of_float rd.rd_percent_cpu
-        ] else []) @
-        (if !csv_mem then [
-            Int64.to_string rd.rd_mem_bytes; Int64.to_string rd.rd_mem_percent
-         ] else []) @
-       (if !csv_block then [
-          string_of_int64_option rd.rd_block_rd_info;
-          string_of_int64_option rd.rd_block_wr_info;
-        ] else []) @
-       (if !csv_net then [
-          string_of_int64_option rd.rd_net_rx_bytes;
-          string_of_int64_option rd.rd_net_tx_bytes;
-        ] else [])
-  ) doms in
-  let domain_fields = List.flatten domain_fields in
-
-  (!csv_write) (summary_fields @ domain_fields)
-
-let dump_stdout
-    (_, _, _, _, _, node_info, hostname, _) (* setup *)
-    (doms,
-     _, printable_time,
-     nr_pcpus, total_cpu, _,
-     totals,
-     _) (* state *) =
-
-  (* Header for this iteration *)
-  printf "virt-top time  %s Host %s %s %d/%dCPU %dMHz %LdMB \n"
-    printable_time hostname node_info.C.model node_info.C.cpus nr_pcpus
-    node_info.C.mhz (node_info.C.memory /^ 1024L);
-  (* dump domain information one by one *)
-   let rd, wr = if !block_in_bytes then "RDBY", "WRBY" else "RDRQ", "WRRQ"
-   in
-     printf "   ID S %s %s RXBY TXBY %%CPU %%MEM   TIME    NAME\n" rd wr;
-
-  (* sort by ID *)
-  let doms =
-    let compare =
-      (function
-       | Active {rd_domid = id1 }, Active {rd_domid = id2} ->
-           compare id1 id2
-       | Active _, Inactive -> -1
-       | Inactive, Active _ -> 1
-       | Inactive, Inactive -> 0)
-    in
-    let cmp  (name1, dom1) (name2, dom2) = compare(dom1, dom2) in
-    List.sort ~cmp doms in
-  (*Print domains *)
-  let dump_domain = fun name rd
-  -> begin
-    let state = show_state rd.rd_info.D.state in
-         let rd_req = if rd.rd_block_rd_info = None then "   0"
-                      else Show.int64_option rd.rd_block_rd_info in
-         let wr_req = if rd.rd_block_wr_info = None then "   0"
-                      else Show.int64_option rd.rd_block_wr_info in
-    let rx_bytes = if rd.rd_net_rx_bytes = None then "   0"
-    else Show.int64_option rd.rd_net_rx_bytes in
-    let tx_bytes = if rd.rd_net_tx_bytes = None then "   0"
-    else Show.int64_option rd.rd_net_tx_bytes in
-    let percent_cpu = Show.percent rd.rd_percent_cpu in
-    let percent_mem = Int64.to_float rd.rd_mem_percent in
-    let percent_mem = Show.percent percent_mem in
-    let time = Show.time rd.rd_info.D.cpu_time in
-    printf "%5d %c %s %s %s %s %s %s %s %s\n"
-      rd.rd_domid state rd_req wr_req rx_bytes tx_bytes
-      percent_cpu percent_mem time name;
-  end
-  in
-  List.iter (
-    function
-    | name, Active dom -> dump_domain name dom
-    | name, Inactive -> ()
-  ) doms;
-  flush stdout
-
 (* Main loop. *)
 let rec main_loop ((_, batch_mode, script_mode, csv_enabled, stream_mode, _, _, _)
                     as setup) =
-  if csv_enabled then write_csv_header ();
+  let csv_flags = !csv_cpu, !csv_mem, !csv_block, !csv_net in
+
+  if csv_enabled then
+    Csv_output.write_csv_header csv_flags !block_in_bytes;
 
   while not !quit do
-    let state = collect setup in               (* Collect stats. *)
+    (* Collect stats. *)
+    let state = collect setup !block_in_bytes in
+    let pcpu_display =
+      if !display_mode = PCPUDisplay then Some (collect_pcpu state)
+      else None in
     (* Redraw display. *)
-    if not script_mode && not stream_mode then redraw setup state;
-    if csv_enabled then append_csv setup state; (* Update CSV file. *)
-    if stream_mode then dump_stdout setup state; (* dump to stdout *)
+    if not script_mode && not stream_mode then
+      Redraw.redraw !display_mode !sort_order
+                    setup !block_in_bytes !historical_cpu_delay
+                    state pcpu_display;
+
+    (* Update CSV file. *)
+    if csv_enabled then
+      Csv_output.append_csv setup csv_flags state;
+
+    (* Append to stream output file. *)
+    if stream_mode then
+      Stream_output.append_stream setup !block_in_bytes state;
 
     (* Clear up unused virDomainPtr objects. *)
     Gc.compact ();
@@ -1440,11 +356,10 @@ let rec main_loop ((_, batch_mode, script_mode, csv_enabled, stream_mode, _, _,
           (* No --end-time option, so use the current delay. *)
           !delay
       | Some end_time ->
-         let (_, time, _, _, _, _, _, _) = state in
          let delay_secs = float !delay /. 1000. in
-         if end_time <= time +. delay_secs then (
+         if end_time <= state.rd_time +. delay_secs then (
             quit := true;
-            let delay = int_of_float (1000. *. (end_time -. time)) in
+            let delay = int_of_float (1000. *. (end_time -. state.rd_time)) in
             if delay >= 0 then delay else 0
           ) else
             !delay in
index b0953dd..b625910 100644 (file)
@@ -1,5 +1,5 @@
 (* 'top'-like tool for libvirt domains.
-   (C) Copyright 2007-2009 Richard W.M. Jones, Red Hat Inc.
+   (C) Copyright 2007-2017 Richard W.M. Jones, Red Hat Inc.
    http://libvirt.org/
 
    This program is free software; you can redistribute it and/or modify
    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 *)
 
-(* Hook for [Opt_xml] to override (if present). *)
-val parse_device_xml :
-  (int -> [ `R ] Libvirt.Domain.t -> string list * string list) ref
-
-(* Hooks for [Opt_csv] to override (if present). *)
+(* Hook for [Opt_csv] to override (if present). *)
 val csv_start : (string -> unit) ref
-val csv_write : (string list -> unit) ref
 
 (* Hook for [Opt_calendar] to override (if present). *)
 val parse_date_time : (string -> float) ref
 
-type setup =
-    Libvirt.ro Libvirt.Connect.t       (* connection *)
-    * bool * bool * bool * bool                (* batch, script, csv, stream mode *)
-    * Libvirt.Connect.node_info                (* node_info *)
-    * string                           (* hostname *)
-    * (int * int * int)                        (* libvirt version *)
-
-val start_up : unit -> setup
-val main_loop : setup -> unit
+val start_up : unit -> Types.setup
+val main_loop : Types.setup -> unit
diff --git a/src/types.ml b/src/types.ml
new file mode 100644 (file)
index 0000000..2fdd49b
--- /dev/null
@@ -0,0 +1,147 @@
+(* 'top'-like tool for libvirt domains.
+   (C) Copyright 2007-2017 Richard W.M. Jones, Red Hat Inc.
+   http://libvirt.org/
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU General Public License as published by
+   the Free Software Foundation; either version 2 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   along with this program; if not, write to the Free Software
+   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+*)
+
+open Opt_gettext.Gettext
+open Utils
+
+module C = Libvirt.Connect
+module D = Libvirt.Domain
+
+(* XXX We should get rid of this type. *)
+type setup =
+    Libvirt.ro C.t              (* connection *)
+    * bool * bool * bool * bool (* batch, script, csv, stream mode *)
+    * C.node_info              (* node_info *)
+    * string                    (* hostname *)
+    * (int * int * int)         (* libvirt version *)
+
+(* Sort order. *)
+type sort_order =
+  | DomainID | DomainName | Processor | Memory | Time
+  | NetRX | NetTX | BlockRdRq | BlockWrRq
+let all_sort_fields = [
+  DomainID; DomainName; Processor; Memory; Time;
+  NetRX; NetTX; BlockRdRq; BlockWrRq
+]
+let printable_sort_order = function
+  | Processor -> s_"%CPU"
+  | Memory -> s_"%MEM"
+  | Time -> s_"TIME (CPU time)"
+  | DomainID -> s_"Domain ID"
+  | DomainName -> s_"Domain name"
+  | NetRX -> s_"Net RX bytes"
+  | NetTX -> s_"Net TX bytes"
+  | BlockRdRq -> s_"Block read reqs"
+  | BlockWrRq -> s_"Block write reqs"
+let sort_order_of_cli = function
+  | "cpu" | "processor" -> Processor
+  | "mem" | "memory" -> Memory
+  | "time" -> Time
+  | "id" -> DomainID
+  | "name" -> DomainName
+  | "netrx" -> NetRX | "nettx" -> NetTX
+  | "blockrdrq" -> BlockRdRq | "blockwrrq" -> BlockWrRq
+  | str ->
+      failwithf (f_"%s: sort order should be: %s")
+       str "cpu|mem|time|id|name|netrx|nettx|blockrdrq|blockwrrq"
+let cli_of_sort_order = function
+  | Processor -> "cpu"
+  | Memory -> "mem"
+  | Time -> "time"
+  | DomainID -> "id"
+  | DomainName -> "name"
+  | NetRX -> "netrx"
+  | NetTX -> "nettx"
+  | BlockRdRq -> "blockrdrq"
+  | BlockWrRq -> "blockwrrq"
+
+(* Current major display mode: TaskDisplay is the normal display. *)
+type display = TaskDisplay | PCPUDisplay | BlockDisplay | NetDisplay
+
+let display_of_cli = function
+  | "task" -> TaskDisplay
+  | "pcpu" -> PCPUDisplay
+  | "block" -> BlockDisplay
+  | "net" -> NetDisplay
+  | str ->
+      failwithf (f_"%s: display should be %s") str "task|pcpu|block|net"
+let cli_of_display = function
+  | TaskDisplay -> "task"
+  | PCPUDisplay -> "pcpu"
+  | BlockDisplay -> "block"
+  | NetDisplay -> "net"
+
+(* Sum Domain.block_stats structures together.  Missing fields
+ * get forced to 0.  Empty list returns all 0.
+ *)
+let zero_block_stats =
+  { D.rd_req = 0L; rd_bytes = 0L; wr_req = 0L; wr_bytes = 0L; errs = 0L }
+let add_block_stats bs1 bs2 =
+  let add f1 f2 = if f1 >= 0L && f2 >= 0L then f1 +^ f2 else 0L in
+  { D.rd_req = add bs1.D.rd_req   bs2.D.rd_req;
+    rd_bytes = add bs1.D.rd_bytes bs2.D.rd_bytes;
+    wr_req   = add bs1.D.wr_req   bs2.D.wr_req;
+    wr_bytes = add bs1.D.wr_bytes bs2.D.wr_bytes;
+    errs     = add bs1.D.errs     bs2.D.errs }
+let sum_block_stats =
+  List.fold_left add_block_stats zero_block_stats
+
+(* Get the difference between two block_stats structures.  Missing data
+ * forces the difference to -1.
+ *)
+let diff_block_stats curr prev =
+  let sub f1 f2 = if f1 >= 0L && f2 >= 0L then f1 -^ f2 else -1L in
+  { D.rd_req = sub curr.D.rd_req   prev.D.rd_req;
+    rd_bytes = sub curr.D.rd_bytes prev.D.rd_bytes;
+    wr_req   = sub curr.D.wr_req   prev.D.wr_req;
+    wr_bytes = sub curr.D.wr_bytes prev.D.wr_bytes;
+    errs     = sub curr.D.errs     prev.D.errs }
+
+(* Sum Domain.interface_stats structures together.  Missing fields
+ * get forced to 0.  Empty list returns all 0.
+ *)
+let zero_interface_stats =
+  { D.rx_bytes = 0L; rx_packets = 0L; rx_errs = 0L; rx_drop = 0L;
+    tx_bytes = 0L; tx_packets = 0L; tx_errs = 0L; tx_drop = 0L }
+let add_interface_stats is1 is2 =
+  let add f1 f2 = if f1 >= 0L && f2 >= 0L then f1 +^ f2 else 0L in
+  { D.rx_bytes = add is1.D.rx_bytes   is2.D.rx_bytes;
+    rx_packets = add is1.D.rx_packets is2.D.rx_packets;
+    rx_errs    = add is1.D.rx_errs    is2.D.rx_errs;
+    rx_drop    = add is1.D.rx_drop    is2.D.rx_drop;
+    tx_bytes   = add is1.D.tx_bytes   is2.D.tx_bytes;
+    tx_packets = add is1.D.tx_packets is2.D.tx_packets;
+    tx_errs    = add is1.D.tx_errs    is2.D.tx_errs;
+    tx_drop    = add is1.D.tx_drop    is2.D.tx_drop }
+let sum_interface_stats =
+  List.fold_left add_interface_stats zero_interface_stats
+
+(* Get the difference between two interface_stats structures.
+ * Missing data forces the difference to -1.
+ *)
+let diff_interface_stats curr prev =
+  let sub f1 f2 = if f1 >= 0L && f2 >= 0L then f1 -^ f2 else -1L in
+  { D.rx_bytes = sub curr.D.rx_bytes   prev.D.rx_bytes;
+    rx_packets = sub curr.D.rx_packets prev.D.rx_packets;
+    rx_errs    = sub curr.D.rx_errs    prev.D.rx_errs;
+    rx_drop    = sub curr.D.rx_drop    prev.D.rx_drop;
+    tx_bytes   = sub curr.D.tx_bytes   prev.D.tx_bytes;
+    tx_packets = sub curr.D.tx_packets prev.D.tx_packets;
+    tx_errs    = sub curr.D.tx_errs    prev.D.tx_errs;
+    tx_drop    = sub curr.D.tx_drop    prev.D.tx_drop }
diff --git a/src/types.mli b/src/types.mli
new file mode 100644 (file)
index 0000000..6297482
--- /dev/null
@@ -0,0 +1,49 @@
+(* 'top'-like tool for libvirt domains.
+   (C) Copyright 2007-2017 Richard W.M. Jones, Red Hat Inc.
+   http://libvirt.org/
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU General Public License as published by
+   the Free Software Foundation; either version 2 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   along with this program; if not, write to the Free Software
+   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+*)
+
+(* XXX We should get rid of this type. *)
+type setup =
+    Libvirt.ro Libvirt.Connect.t       (* connection *)
+    * bool * bool * bool * bool                (* batch, script, csv, stream mode *)
+    * Libvirt.Connect.node_info                (* node_info *)
+    * string                           (* hostname *)
+    * (int * int * int)                        (* libvirt version *)
+
+(* Sort order. *)
+type sort_order =
+  | DomainID | DomainName | Processor | Memory | Time
+  | NetRX | NetTX | BlockRdRq | BlockWrRq
+
+val all_sort_fields : sort_order list
+val printable_sort_order : sort_order -> string
+val sort_order_of_cli : string -> sort_order
+val cli_of_sort_order : sort_order -> string
+
+(* Current major display mode: TaskDisplay is the normal display. *)
+type display = TaskDisplay | PCPUDisplay | BlockDisplay | NetDisplay
+
+val display_of_cli : string -> display
+val cli_of_display : display -> string
+
+(* Helpers for manipulating block_stats & interface_stats. *)
+val sum_block_stats : Libvirt.Domain.block_stats list -> Libvirt.Domain.block_stats
+val diff_block_stats : Libvirt.Domain.block_stats -> Libvirt.Domain.block_stats -> Libvirt.Domain.block_stats
+
+val sum_interface_stats : Libvirt.Domain.interface_stats list -> Libvirt.Domain.interface_stats
+val diff_interface_stats : Libvirt.Domain.interface_stats -> Libvirt.Domain.interface_stats -> Libvirt.Domain.interface_stats
index 3dc637d..5fcc905 100644 (file)
 
 open Printf
 
-open Opt_gettext.Gettext
-
-module C = Libvirt.Connect
-module D = Libvirt.Domain
-module N = Libvirt.Network
-
 let (//) = Filename.concat
 
 (* Int64 operators for convenience. *)
@@ -166,62 +160,3 @@ module Show = struct
       sprintf "%3Ldd%02Ld:%02Ld" days hours mins
     )
 end
-
-(* Sum Domain.block_stats structures together.  Missing fields
- * get forced to 0.  Empty list returns all 0.
- *)
-let zero_block_stats =
-  { D.rd_req = 0L; rd_bytes = 0L; wr_req = 0L; wr_bytes = 0L; errs = 0L }
-let add_block_stats bs1 bs2 =
-  let add f1 f2 = if f1 >= 0L && f2 >= 0L then f1 +^ f2 else 0L in
-  { D.rd_req = add bs1.D.rd_req   bs2.D.rd_req;
-    rd_bytes = add bs1.D.rd_bytes bs2.D.rd_bytes;
-    wr_req   = add bs1.D.wr_req   bs2.D.wr_req;
-    wr_bytes = add bs1.D.wr_bytes bs2.D.wr_bytes;
-    errs     = add bs1.D.errs     bs2.D.errs }
-let sum_block_stats =
-  List.fold_left add_block_stats zero_block_stats
-
-(* Get the difference between two block_stats structures.  Missing data
- * forces the difference to -1.
- *)
-let diff_block_stats curr prev =
-  let sub f1 f2 = if f1 >= 0L && f2 >= 0L then f1 -^ f2 else -1L in
-  { D.rd_req = sub curr.D.rd_req   prev.D.rd_req;
-    rd_bytes = sub curr.D.rd_bytes prev.D.rd_bytes;
-    wr_req   = sub curr.D.wr_req   prev.D.wr_req;
-    wr_bytes = sub curr.D.wr_bytes prev.D.wr_bytes;
-    errs     = sub curr.D.errs     prev.D.errs }
-
-(* Sum Domain.interface_stats structures together.  Missing fields
- * get forced to 0.  Empty list returns all 0.
- *)
-let zero_interface_stats =
-  { D.rx_bytes = 0L; rx_packets = 0L; rx_errs = 0L; rx_drop = 0L;
-    tx_bytes = 0L; tx_packets = 0L; tx_errs = 0L; tx_drop = 0L }
-let add_interface_stats is1 is2 =
-  let add f1 f2 = if f1 >= 0L && f2 >= 0L then f1 +^ f2 else 0L in
-  { D.rx_bytes = add is1.D.rx_bytes   is2.D.rx_bytes;
-    rx_packets = add is1.D.rx_packets is2.D.rx_packets;
-    rx_errs    = add is1.D.rx_errs    is2.D.rx_errs;
-    rx_drop    = add is1.D.rx_drop    is2.D.rx_drop;
-    tx_bytes   = add is1.D.tx_bytes   is2.D.tx_bytes;
-    tx_packets = add is1.D.tx_packets is2.D.tx_packets;
-    tx_errs    = add is1.D.tx_errs    is2.D.tx_errs;
-    tx_drop    = add is1.D.tx_drop    is2.D.tx_drop }
-let sum_interface_stats =
-  List.fold_left add_interface_stats zero_interface_stats
-
-(* Get the difference between two interface_stats structures.
- * Missing data forces the difference to -1.
- *)
-let diff_interface_stats curr prev =
-  let sub f1 f2 = if f1 >= 0L && f2 >= 0L then f1 -^ f2 else -1L in
-  { D.rx_bytes = sub curr.D.rx_bytes   prev.D.rx_bytes;
-    rx_packets = sub curr.D.rx_packets prev.D.rx_packets;
-    rx_errs    = sub curr.D.rx_errs    prev.D.rx_errs;
-    rx_drop    = sub curr.D.rx_drop    prev.D.rx_drop;
-    tx_bytes   = sub curr.D.tx_bytes   prev.D.tx_bytes;
-    tx_packets = sub curr.D.tx_packets prev.D.tx_packets;
-    tx_errs    = sub curr.D.tx_errs    prev.D.tx_errs;
-    tx_drop    = sub curr.D.tx_drop    prev.D.tx_drop }
index 5b71b31..6e81215 100644 (file)
@@ -46,12 +46,3 @@ module Show : sig
   val int64 : int64 -> string
   val time : int64 -> string
 end
-
-(* Helpers for manipulating block_stats & interface_stats. *)
-open Libvirt.Domain
-
-val sum_block_stats : block_stats list -> block_stats
-val diff_block_stats : block_stats -> block_stats -> block_stats
-
-val sum_interface_stats : interface_stats list -> interface_stats
-val diff_interface_stats : interface_stats -> interface_stats -> interface_stats