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.
24 open Opt_gettext.Gettext
30 module C = Libvirt.Connect
31 module D = Libvirt.Domain
33 (* Keep a historical list of %CPU usages. *)
34 let historical_cpu = ref []
35 let historical_cpu_last_time = ref (Unix.gettimeofday ())
37 (* Redraw the display. *)
38 let redraw display_mode sort_order
39 (_, _, _, _, _, node_info, _, _) (* setup *)
43 rd_time = time; rd_printable_time = printable_time;
44 rd_nr_pcpus = nr_pcpus;
45 rd_total_cpu = total_cpu;
46 rd_total_cpu_per_pcpu = total_cpu_per_pcpu;
47 rd_totals = totals } (* state *)
51 (* Get the screen/window size. *)
52 let lines, cols = get_size () in
55 mvaddstr top_lineno 0 (sprintf "virt-top %s - " printable_time);
57 (* Basic node_info. *)
59 (sprintf "%s %d/%dCPU %dMHz %LdMB "
60 node_info.C.model node_info.C.cpus nr_pcpus node_info.C.mhz
61 (node_info.C.memory /^ 1024L));
62 (* Save the cursor position for when we come to draw the
63 * historical CPU times (down in this function).
65 let stdscr = stdscr () in
66 let historical_cursor = getyx stdscr in
68 (match display_mode with
70 (*---------- Showing domains ----------*)
72 (* Sort domains on current sort_order. *)
77 (fun _ -> 0) (* fallthrough to default name compare *)
80 | Active rd1, Active rd2 ->
81 compare rd2.rd_percent_cpu rd1.rd_percent_cpu
82 | Active _, Inactive -> -1
83 | Inactive, Active _ -> 1
84 | Inactive, Inactive -> 0)
87 | Active { rd_info = info1 }, Active { rd_info = info2 } ->
88 compare info2.D.memory info1.D.memory
89 | Active _, Inactive -> -1
90 | Inactive, Active _ -> 1
91 | Inactive, Inactive -> 0)
94 | Active { rd_info = info1 }, Active { rd_info = info2 } ->
95 compare info2.D.cpu_time info1.D.cpu_time
96 | Active _, Inactive -> -1
97 | Inactive, Active _ -> 1
98 | Inactive, Inactive -> 0)
101 | Active { rd_domid = id1 }, Active { rd_domid = id2 } ->
103 | Active _, Inactive -> -1
104 | Inactive, Active _ -> 1
105 | Inactive, Inactive -> 0)
108 | Active { rd_net_rx_bytes = r1 }, Active { rd_net_rx_bytes = r2 } ->
110 | Active _, Inactive -> -1
111 | Inactive, Active _ -> 1
112 | Inactive, Inactive -> 0)
115 | Active { rd_net_tx_bytes = r1 }, Active { rd_net_tx_bytes = r2 } ->
117 | Active _, Inactive -> -1
118 | Inactive, Active _ -> 1
119 | Inactive, Inactive -> 0)
122 | Active { rd_block_rd_reqs = r1 }, Active { rd_block_rd_reqs = r2 } ->
124 | Active _, Inactive -> -1
125 | Inactive, Active _ -> 1
126 | Inactive, Inactive -> 0)
129 | Active { rd_block_wr_reqs = r1 }, Active { rd_block_wr_reqs = r2 } ->
131 | Active _, Inactive -> -1
132 | Inactive, Active _ -> 1
133 | Inactive, Inactive -> 0)
135 let cmp (name1, dom1) (name2, dom2) =
136 let r = cmp (dom1, dom2) in
138 else compare name1 name2
140 List.sort ~cmp doms in
146 then " ID S RDBY WRBY RXBY TXBY %CPU %MEM TIME NAME"
147 else " ID S RDRQ WRRQ RXBY TXBY %CPU %MEM TIME NAME"
149 mvaddstr header_lineno 0
150 (pad cols header_string);
153 let rec loop lineno = function
155 | (name, Active rd) :: doms ->
156 if lineno < lines then (
157 let state = show_state rd.rd_info.D.state in
159 if block_in_bytes then Show.int64_option rd.rd_block_rd_bytes
160 else Show.int64_option rd.rd_block_rd_reqs in
162 if block_in_bytes then Show.int64_option rd.rd_block_wr_bytes
163 else Show.int64_option rd.rd_block_wr_reqs in
164 let rx_bytes = Show.int64_option rd.rd_net_rx_bytes in
165 let tx_bytes = Show.int64_option rd.rd_net_tx_bytes in
166 let percent_cpu = Show.percent rd.rd_percent_cpu in
167 let percent_mem = Int64.to_float rd.rd_mem_percent in
168 let percent_mem = Show.percent percent_mem in
169 let time = Show.time rd.rd_info.D.cpu_time in
172 sprintf "%5d %c %s %s %s %s %s %s %s %s"
173 rd.rd_domid state rd_info wr_info rx_bytes tx_bytes
174 percent_cpu percent_mem time name in
175 let line = pad cols line in
176 mvaddstr lineno 0 line;
179 | (name, Inactive) :: doms -> (* inactive domain *)
180 if lineno < lines then (
185 let line = pad cols line in
186 mvaddstr lineno 0 line;
190 loop domains_lineno doms
192 (*---------- Showing physical CPUs ----------*)
194 let { rd_pcpu_doms = doms;
195 rd_pcpu_pcpus = pcpus;
196 rd_pcpu_pcpus_cpu_time = pcpus_cpu_time } =
197 match pcpu_display with
199 | None -> failwith "internal error: no pcpu_display data" in
201 (* Display the pCPUs. *)
205 fun (_, name, _, _, _, _, _, _) ->
206 let len = String.length name in
207 let width = max (len+1) 12 in
212 mvaddstr header_lineno 0 (pad cols ("PHYCPU %CPU " ^ dom_names));
217 mvaddstr (p+domains_lineno) 0 (sprintf "%4d " p);
218 let cpu_time = pcpus_cpu_time.(p) in (* ns used on this CPU *)
219 let percent_cpu = 100. *. cpu_time /. total_cpu_per_pcpu in
220 addstr (Show.percent percent_cpu);
224 fun di (domid, name, _, _, _, _, _, _) ->
225 let t = pcpus.(p).(di).(0) in (* hypervisor + domain *)
226 let t_only = pcpus.(p).(di).(1) in (* domain only *)
227 let len = String.length name in
228 let width = max (len+1) 12 in
232 let t = Int64.to_float t in
233 let percent = 100. *. t /. total_cpu_per_pcpu in
237 if t_only <= 0L then ""
239 let t_only = Int64.to_float t_only in
240 let percent = 100. *. t_only /. total_cpu_per_pcpu in
243 addstr (pad 5 str_t);
244 addstr (pad 5 str_t_only);
245 addstr (pad (width-10) " ");
250 (*---------- Showing network interfaces ----------*)
252 (* Only care about active domains. *)
256 | (name, Active rd) -> Some (name, rd)
257 | (_, Inactive) -> None
260 (* For each domain we have a list of network interfaces seen
261 * this slice, and seen in the previous slice, which we now
262 * match up to get a list of (domain, interface) for which
263 * we have current & previous knowledge. (And ignore the rest).
271 (* Have prev slice stats for this device? *)
273 List.assoc dev rd.rd_prev_interface_stats in
274 Some (dev, name, rd, stats, prev_stats)
275 with Not_found -> None
276 ) rd.rd_interface_stats
279 (* Finally we have a list of:
280 * device name, domain name, rd_* stuff, curr stats, prev stats.
282 let devs : (string * string * rd_active *
283 D.interface_stats * D.interface_stats) list =
286 (* Difference curr slice & prev slice. *)
289 fun (dev, name, rd, curr, prev) ->
290 dev, name, rd, diff_interface_stats curr prev
293 (* Sort by current sort order, but map some of the standard
294 * sort orders into ones which makes sense here.
298 match sort_order with
300 (fun _ -> 0) (* fallthrough to default name compare *)
302 (fun (_, { rd_domid = id1 }, _, { rd_domid = id2 }) ->
304 | Processor | Memory | Time
305 | BlockRdRq | BlockWrRq
306 (* fallthrough to RXBY comparison. *)
308 (fun ({ D.rx_bytes = b1 }, _, { D.rx_bytes = b2 }, _) ->
311 (fun ({ D.tx_bytes = b1 }, _, { D.tx_bytes = b2 }, _) ->
314 let cmp (dev1, name1, rd1, stats1) (dev2, name2, rd2, stats2) =
315 let r = cmp (stats1, rd1, stats2, rd2) in
317 else compare (dev1, name1) (dev2, name2)
319 List.sort ~cmp devs in
321 (* Print the header for network devices. *)
323 mvaddstr header_lineno 0
324 (pad cols " ID S RXBY TXBY RXPK TXPK DOMAIN INTERFACE");
327 (* Print domains and devices. *)
328 let rec loop lineno = function
330 | (dev, name, rd, stats) :: devs ->
331 if lineno < lines then (
332 let state = show_state rd.rd_info.D.state in
334 if stats.D.rx_bytes >= 0L
335 then Show.int64 stats.D.rx_bytes
338 if stats.D.tx_bytes >= 0L
339 then Show.int64 stats.D.tx_bytes
342 if stats.D.rx_packets >= 0L
343 then Show.int64 stats.D.rx_packets
346 if stats.D.tx_packets >= 0L
347 then Show.int64 stats.D.tx_packets
350 let line = sprintf "%5d %c %s %s %s %s %-12s %s"
353 rx_packets tx_packets
355 let line = pad cols line in
356 mvaddstr lineno 0 line;
360 loop domains_lineno devs
362 (*---------- Showing block devices ----------*)
364 (* Only care about active domains. *)
368 | (name, Active rd) -> Some (name, rd)
369 | (_, Inactive) -> None
372 (* For each domain we have a list of block devices seen
373 * this slice, and seen in the previous slice, which we now
374 * match up to get a list of (domain, device) for which
375 * we have current & previous knowledge. (And ignore the rest).
383 (* Have prev slice stats for this device? *)
385 List.assoc dev rd.rd_prev_block_stats in
386 Some (dev, name, rd, stats, prev_stats)
387 with Not_found -> None
391 (* Finally we have a list of:
392 * device name, domain name, rd_* stuff, curr stats, prev stats.
394 let devs : (string * string * rd_active *
395 D.block_stats * D.block_stats) list =
398 (* Difference curr slice & prev slice. *)
401 fun (dev, name, rd, curr, prev) ->
402 dev, name, rd, diff_block_stats curr prev
405 (* Sort by current sort order, but map some of the standard
406 * sort orders into ones which makes sense here.
410 match sort_order with
412 (fun _ -> 0) (* fallthrough to default name compare *)
414 (fun (_, { rd_domid = id1 }, _, { rd_domid = id2 }) ->
416 | Processor | Memory | Time
418 (* fallthrough to RDRQ comparison. *)
420 (fun ({ D.rd_req = b1 }, _, { D.rd_req = b2 }, _) ->
423 (fun ({ D.wr_req = b1 }, _, { D.wr_req = b2 }, _) ->
426 let cmp (dev1, name1, rd1, stats1) (dev2, name2, rd2, stats2) =
427 let r = cmp (stats1, rd1, stats2, rd2) in
429 else compare (dev1, name1) (dev2, name2)
431 List.sort ~cmp devs in
433 (* Print the header for block devices. *)
435 mvaddstr header_lineno 0
436 (pad cols " ID S RDBY WRBY RDRQ WRRQ DOMAIN DEVICE");
439 (* Print domains and devices. *)
440 let rec loop lineno = function
442 | (dev, name, rd, stats) :: devs ->
443 if lineno < lines then (
444 let state = show_state rd.rd_info.D.state in
446 if stats.D.rd_bytes >= 0L
447 then Show.int64 stats.D.rd_bytes
450 if stats.D.wr_bytes >= 0L
451 then Show.int64 stats.D.wr_bytes
454 if stats.D.rd_req >= 0L
455 then Show.int64 stats.D.rd_req
458 if stats.D.wr_req >= 0L
459 then Show.int64 stats.D.wr_req
462 let line = sprintf "%5d %c %s %s %s %s %-12s %s"
467 let line = pad cols line in
468 mvaddstr lineno 0 line;
472 loop domains_lineno devs
473 ); (* end of display_mode conditional section *)
475 let (count, running, blocked, paused, shutdown, shutoff,
476 crashed, active, inactive,
477 total_cpu_time, total_memory, total_domU_memory) = totals in
479 mvaddstr summary_lineno 0
481 (f_"%d domains, %d active, %d running, %d sleeping, %d paused, %d inactive D:%d O:%d X:%d")
482 count active running blocked paused inactive shutdown shutoff crashed);
484 (* Total %CPU used, and memory summary. *)
485 let percent_cpu = 100. *. total_cpu_time /. total_cpu in
486 mvaddstr (summary_lineno+1) 0
488 (f_"CPU: %2.1f%% Mem: %Ld MB (%Ld MB by guests)")
489 percent_cpu (total_memory /^ 1024L) (total_domU_memory /^ 1024L));
491 (* Time to grab another historical %CPU for the list? *)
492 if time >= !historical_cpu_last_time +. float historical_cpu_delay
494 historical_cpu := percent_cpu :: List.take 10 !historical_cpu;
495 historical_cpu_last_time := time
498 (* Display historical CPU time. *)
500 let y, x = historical_cursor in
501 let maxwidth = cols - x in
504 (List.map (sprintf "%2.1f%%") !historical_cpu) in
505 let line = pad maxwidth line in
509 move message_lineno 0; (* Park cursor in message area, as with top. *)
510 refresh () (* Refresh the display. *)