1 (* 'top'-like tool for libvirt domains.
2 (C) Copyright 2007-2017 Richard W.M. Jones, Red Hat Inc.
5 This program is free software; you can redistribute it and/or modify
6 it under the terms of the GNU General Public License as published by
7 the Free Software Foundation; either version 2 of the License, or
8 (at your option) any later version.
10 This program is distributed in the hope that it will be useful,
11 but WITHOUT ANY WARRANTY; without even the implied warranty of
12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 GNU General Public License for more details.
15 You should have received a copy of the GNU General Public License
16 along with this program; if not, write to the Free Software
17 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
23 open Opt_gettext.Gettext
29 module C = Libvirt.Connect
30 module D = Libvirt.Domain
32 (* Keep a historical list of %CPU usages. *)
33 let historical_cpu = ref []
34 let historical_cpu_last_time = ref (Unix.gettimeofday ())
36 (* Redraw the display. *)
37 let redraw display_mode sort_order
38 (_, _, _, _, _, node_info, _, _) (* setup *)
42 rd_time = time; rd_printable_time = printable_time;
43 rd_nr_pcpus = nr_pcpus;
44 rd_total_cpu = total_cpu;
45 rd_total_cpu_per_pcpu = total_cpu_per_pcpu;
46 rd_totals = totals } (* state *)
50 (* Get the screen/window size. *)
51 let lines, cols = get_size () in
54 mvaddstr top_lineno 0 (sprintf "virt-top %s - " printable_time);
56 (* Basic node_info. *)
58 (sprintf "%s %d/%dCPU %dMHz %LdMB "
59 node_info.C.model node_info.C.cpus nr_pcpus node_info.C.mhz
60 (node_info.C.memory /^ 1024L));
61 (* Save the cursor position for when we come to draw the
62 * historical CPU times (down in this function).
64 let stdscr = stdscr () in
65 let historical_cursor = getyx stdscr in
67 (match display_mode with
69 (*---------- Showing domains ----------*)
71 (* Sort domains on current sort_order. *)
76 (fun _ -> 0) (* fallthrough to default name compare *)
79 | Active rd1, Active rd2 ->
80 compare rd2.rd_percent_cpu rd1.rd_percent_cpu
81 | Active _, Inactive -> -1
82 | Inactive, Active _ -> 1
83 | Inactive, Inactive -> 0)
86 | Active { rd_info = info1 }, Active { rd_info = info2 } ->
87 compare info2.D.memory info1.D.memory
88 | Active _, Inactive -> -1
89 | Inactive, Active _ -> 1
90 | Inactive, Inactive -> 0)
93 | Active { rd_info = info1 }, Active { rd_info = info2 } ->
94 compare info2.D.cpu_time info1.D.cpu_time
95 | Active _, Inactive -> -1
96 | Inactive, Active _ -> 1
97 | Inactive, Inactive -> 0)
100 | Active { rd_domid = id1 }, Active { rd_domid = id2 } ->
102 | Active _, Inactive -> -1
103 | Inactive, Active _ -> 1
104 | Inactive, Inactive -> 0)
107 | Active { rd_net_rx_bytes = r1 }, Active { rd_net_rx_bytes = r2 } ->
109 | Active _, Inactive -> -1
110 | Inactive, Active _ -> 1
111 | Inactive, Inactive -> 0)
114 | Active { rd_net_tx_bytes = r1 }, Active { rd_net_tx_bytes = r2 } ->
116 | Active _, Inactive -> -1
117 | Inactive, Active _ -> 1
118 | Inactive, Inactive -> 0)
121 | Active { rd_block_rd_reqs = r1 }, Active { rd_block_rd_reqs = r2 } ->
123 | Active _, Inactive -> -1
124 | Inactive, Active _ -> 1
125 | Inactive, Inactive -> 0)
128 | Active { rd_block_wr_reqs = r1 }, Active { rd_block_wr_reqs = r2 } ->
130 | Active _, Inactive -> -1
131 | Inactive, Active _ -> 1
132 | Inactive, Inactive -> 0)
134 let cmp (name1, dom1) (name2, dom2) =
135 let r = cmp (dom1, dom2) in
137 else compare name1 name2
139 List.sort cmp doms in
145 then " ID S RDBY WRBY RXBY TXBY %CPU %MEM TIME NAME"
146 else " ID S RDRQ WRRQ RXBY TXBY %CPU %MEM TIME NAME"
148 mvaddstr header_lineno 0
149 (pad cols header_string);
152 let rec loop lineno = function
154 | (name, Active rd) :: doms ->
155 if lineno < lines then (
156 let state = show_state rd.rd_info.D.state in
158 if block_in_bytes then Show.int64_option rd.rd_block_rd_bytes
159 else Show.int64_option rd.rd_block_rd_reqs in
161 if block_in_bytes then Show.int64_option rd.rd_block_wr_bytes
162 else Show.int64_option rd.rd_block_wr_reqs in
163 let rx_bytes = Show.int64_option rd.rd_net_rx_bytes in
164 let tx_bytes = Show.int64_option rd.rd_net_tx_bytes in
165 let percent_cpu = Show.percent rd.rd_percent_cpu in
166 let percent_mem = Int64.to_float rd.rd_mem_percent in
167 let percent_mem = Show.percent percent_mem in
168 let time = Show.time rd.rd_info.D.cpu_time in
171 sprintf "%5d %c %s %s %s %s %s %s %s %s"
172 rd.rd_domid state rd_info wr_info rx_bytes tx_bytes
173 percent_cpu percent_mem time name in
174 let line = pad cols line in
175 mvaddstr lineno 0 line;
178 | (name, Inactive) :: doms -> (* inactive domain *)
179 if lineno < lines then (
184 let line = pad cols line in
185 mvaddstr lineno 0 line;
189 loop domains_lineno doms
191 (*---------- Showing physical CPUs ----------*)
193 let { rd_pcpu_doms = doms;
194 rd_pcpu_pcpus = pcpus;
195 rd_pcpu_pcpus_cpu_time = pcpus_cpu_time } =
196 match pcpu_display with
198 | None -> failwith "internal error: no pcpu_display data" in
200 (* Display the pCPUs. *)
204 fun (_, name, _, _, _, _, _, _) ->
205 let len = String.length name in
206 let width = max (len+1) 12 in
211 mvaddstr header_lineno 0 (pad cols ("PHYCPU %CPU " ^ dom_names));
216 mvaddstr (p+domains_lineno) 0 (sprintf "%4d " p);
217 let cpu_time = pcpus_cpu_time.(p) in (* ns used on this CPU *)
218 let percent_cpu = 100. *. cpu_time /. total_cpu_per_pcpu in
219 addstr (Show.percent percent_cpu);
223 fun di (domid, name, _, _, _, _, _, _) ->
224 let t = pcpus.(p).(di).(0) in (* hypervisor + domain *)
225 let t_only = pcpus.(p).(di).(1) in (* domain only *)
226 let len = String.length name in
227 let width = max (len+1) 12 in
231 let t = Int64.to_float t in
232 let percent = 100. *. t /. total_cpu_per_pcpu in
236 if t_only <= 0L then ""
238 let t_only = Int64.to_float t_only in
239 let percent = 100. *. t_only /. total_cpu_per_pcpu in
242 addstr (pad 5 str_t);
243 addstr (pad 5 str_t_only);
244 addstr (pad (width-10) " ");
249 (*---------- Showing network interfaces ----------*)
251 (* Only care about active domains. *)
255 | (name, Active rd) -> Some (name, rd)
256 | (_, Inactive) -> None
259 (* For each domain we have a list of network interfaces seen
260 * this slice, and seen in the previous slice, which we now
261 * match up to get a list of (domain, interface) for which
262 * we have current & previous knowledge. (And ignore the rest).
270 (* Have prev slice stats for this device? *)
272 List.assoc dev rd.rd_prev_interface_stats in
273 Some (dev, name, rd, stats, prev_stats)
274 with Not_found -> None
275 ) rd.rd_interface_stats
278 (* Finally we have a list of:
279 * device name, domain name, rd_* stuff, curr stats, prev stats.
281 let devs : (string * string * rd_active *
282 D.interface_stats * D.interface_stats) list =
285 (* Difference curr slice & prev slice. *)
288 fun (dev, name, rd, curr, prev) ->
289 dev, name, rd, diff_interface_stats curr prev
292 (* Sort by current sort order, but map some of the standard
293 * sort orders into ones which makes sense here.
297 match sort_order with
299 (fun _ -> 0) (* fallthrough to default name compare *)
301 (fun (_, { rd_domid = id1 }, _, { rd_domid = id2 }) ->
303 | Processor | Memory | Time
304 | BlockRdRq | BlockWrRq
305 (* fallthrough to RXBY comparison. *)
307 (fun ({ D.rx_bytes = b1 }, _, { D.rx_bytes = b2 }, _) ->
310 (fun ({ D.tx_bytes = b1 }, _, { D.tx_bytes = b2 }, _) ->
313 let cmp (dev1, name1, rd1, stats1) (dev2, name2, rd2, stats2) =
314 let r = cmp (stats1, rd1, stats2, rd2) in
316 else compare (dev1, name1) (dev2, name2)
318 List.sort cmp devs in
320 (* Print the header for network devices. *)
322 mvaddstr header_lineno 0
323 (pad cols " ID S RXBY TXBY RXPK TXPK DOMAIN INTERFACE");
326 (* Print domains and devices. *)
327 let rec loop lineno = function
329 | (dev, name, rd, stats) :: devs ->
330 if lineno < lines then (
331 let state = show_state rd.rd_info.D.state in
333 if stats.D.rx_bytes >= 0L
334 then Show.int64 stats.D.rx_bytes
337 if stats.D.tx_bytes >= 0L
338 then Show.int64 stats.D.tx_bytes
341 if stats.D.rx_packets >= 0L
342 then Show.int64 stats.D.rx_packets
345 if stats.D.tx_packets >= 0L
346 then Show.int64 stats.D.tx_packets
349 let line = sprintf "%5d %c %s %s %s %s %-12s %s"
352 rx_packets tx_packets
354 let line = pad cols line in
355 mvaddstr lineno 0 line;
359 loop domains_lineno devs
361 (*---------- Showing block devices ----------*)
363 (* Only care about active domains. *)
367 | (name, Active rd) -> Some (name, rd)
368 | (_, Inactive) -> None
371 (* For each domain we have a list of block devices seen
372 * this slice, and seen in the previous slice, which we now
373 * match up to get a list of (domain, device) for which
374 * we have current & previous knowledge. (And ignore the rest).
382 (* Have prev slice stats for this device? *)
384 List.assoc dev rd.rd_prev_block_stats in
385 Some (dev, name, rd, stats, prev_stats)
386 with Not_found -> None
390 (* Finally we have a list of:
391 * device name, domain name, rd_* stuff, curr stats, prev stats.
393 let devs : (string * string * rd_active *
394 D.block_stats * D.block_stats) list =
397 (* Difference curr slice & prev slice. *)
400 fun (dev, name, rd, curr, prev) ->
401 dev, name, rd, diff_block_stats curr prev
404 (* Sort by current sort order, but map some of the standard
405 * sort orders into ones which makes sense here.
409 match sort_order with
411 (fun _ -> 0) (* fallthrough to default name compare *)
413 (fun (_, { rd_domid = id1 }, _, { rd_domid = id2 }) ->
415 | Processor | Memory | Time
417 (* fallthrough to RDRQ comparison. *)
419 (fun ({ D.rd_req = b1 }, _, { D.rd_req = b2 }, _) ->
422 (fun ({ D.wr_req = b1 }, _, { D.wr_req = b2 }, _) ->
425 let cmp (dev1, name1, rd1, stats1) (dev2, name2, rd2, stats2) =
426 let r = cmp (stats1, rd1, stats2, rd2) in
428 else compare (dev1, name1) (dev2, name2)
430 List.sort cmp devs in
432 (* Print the header for block devices. *)
434 mvaddstr header_lineno 0
435 (pad cols " ID S RDBY WRBY RDRQ WRRQ DOMAIN DEVICE");
438 (* Print domains and devices. *)
439 let rec loop lineno = function
441 | (dev, name, rd, stats) :: devs ->
442 if lineno < lines then (
443 let state = show_state rd.rd_info.D.state in
445 if stats.D.rd_bytes >= 0L
446 then Show.int64 stats.D.rd_bytes
449 if stats.D.wr_bytes >= 0L
450 then Show.int64 stats.D.wr_bytes
453 if stats.D.rd_req >= 0L
454 then Show.int64 stats.D.rd_req
457 if stats.D.wr_req >= 0L
458 then Show.int64 stats.D.wr_req
461 let line = sprintf "%5d %c %s %s %s %s %-12s %s"
466 let line = pad cols line in
467 mvaddstr lineno 0 line;
471 loop domains_lineno devs
472 ); (* end of display_mode conditional section *)
474 let (count, running, blocked, paused, shutdown, shutoff,
475 crashed, active, inactive,
476 total_cpu_time, total_memory, total_domU_memory) = totals in
478 mvaddstr summary_lineno 0
480 (f_"%d domains, %d active, %d running, %d sleeping, %d paused, %d inactive D:%d O:%d X:%d")
481 count active running blocked paused inactive shutdown shutoff crashed);
483 (* Total %CPU used, and memory summary. *)
484 let percent_cpu = 100. *. total_cpu_time /. total_cpu in
485 mvaddstr (summary_lineno+1) 0
487 (f_"CPU: %2.1f%% Mem: %Ld MB (%Ld MB by guests)")
488 percent_cpu (total_memory /^ 1024L) (total_domU_memory /^ 1024L));
490 (* Time to grab another historical %CPU for the list? *)
491 if time >= !historical_cpu_last_time +. float historical_cpu_delay
493 historical_cpu := percent_cpu :: list_take 10 !historical_cpu;
494 historical_cpu_last_time := time
497 (* Display historical CPU time. *)
499 let y, x = historical_cursor in
500 let maxwidth = cols - x in
503 (List.map (sprintf "%2.1f%%") !historical_cpu) in
504 let line = pad maxwidth line in
508 move message_lineno 0; (* Park cursor in message area, as with top. *)
509 refresh () (* Refresh the display. *)