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
158 let rd_req = Show.int64_option rd.rd_block_rd_info in
159 let wr_req = Show.int64_option rd.rd_block_wr_info in
160 let rx_bytes = Show.int64_option rd.rd_net_rx_bytes in
161 let tx_bytes = Show.int64_option rd.rd_net_tx_bytes in
162 let percent_cpu = Show.percent rd.rd_percent_cpu in
163 let percent_mem = Int64.to_float rd.rd_mem_percent in
164 let percent_mem = Show.percent percent_mem in
165 let time = Show.time rd.rd_info.D.cpu_time in
168 sprintf "%5d %c %s %s %s %s %s %s %s %s"
169 rd.rd_domid state rd_req wr_req rx_bytes tx_bytes
170 percent_cpu percent_mem time name in
171 let line = pad cols line in
172 mvaddstr lineno 0 line;
175 | (name, Inactive) :: doms -> (* inactive domain *)
176 if lineno < lines then (
181 let line = pad cols line in
182 mvaddstr lineno 0 line;
186 loop domains_lineno doms
188 (*---------- Showing physical CPUs ----------*)
190 let { rd_pcpu_doms = doms;
191 rd_pcpu_pcpus = pcpus;
192 rd_pcpu_pcpus_cpu_time = pcpus_cpu_time } =
193 match pcpu_display with
195 | None -> failwith "internal error: no pcpu_display data" in
197 (* Display the pCPUs. *)
201 fun (_, name, _, _, _, _, _, _) ->
202 let len = String.length name in
203 let width = max (len+1) 12 in
208 mvaddstr header_lineno 0 (pad cols ("PHYCPU %CPU " ^ dom_names));
213 mvaddstr (p+domains_lineno) 0 (sprintf "%4d " p);
214 let cpu_time = pcpus_cpu_time.(p) in (* ns used on this CPU *)
215 let percent_cpu = 100. *. cpu_time /. total_cpu_per_pcpu in
216 addstr (Show.percent percent_cpu);
220 fun di (domid, name, _, _, _, _, _, _) ->
221 let t = pcpus.(p).(di).(0) in (* hypervisor + domain *)
222 let t_only = pcpus.(p).(di).(1) in (* domain only *)
223 let len = String.length name in
224 let width = max (len+1) 12 in
228 let t = Int64.to_float t in
229 let percent = 100. *. t /. total_cpu_per_pcpu in
233 if t_only <= 0L then ""
235 let t_only = Int64.to_float t_only in
236 let percent = 100. *. t_only /. total_cpu_per_pcpu in
239 addstr (pad 5 str_t);
240 addstr (pad 5 str_t_only);
241 addstr (pad (width-10) " ");
246 (*---------- Showing network interfaces ----------*)
248 (* Only care about active domains. *)
252 | (name, Active rd) -> Some (name, rd)
253 | (_, Inactive) -> None
256 (* For each domain we have a list of network interfaces seen
257 * this slice, and seen in the previous slice, which we now
258 * match up to get a list of (domain, interface) for which
259 * we have current & previous knowledge. (And ignore the rest).
267 (* Have prev slice stats for this device? *)
269 List.assoc dev rd.rd_prev_interface_stats in
270 Some (dev, name, rd, stats, prev_stats)
271 with Not_found -> None
272 ) rd.rd_interface_stats
275 (* Finally we have a list of:
276 * device name, domain name, rd_* stuff, curr stats, prev stats.
278 let devs : (string * string * rd_active *
279 D.interface_stats * D.interface_stats) list =
282 (* Difference curr slice & prev slice. *)
285 fun (dev, name, rd, curr, prev) ->
286 dev, name, rd, diff_interface_stats curr prev
289 (* Sort by current sort order, but map some of the standard
290 * sort orders into ones which makes sense here.
294 match sort_order with
296 (fun _ -> 0) (* fallthrough to default name compare *)
298 (fun (_, { rd_domid = id1 }, _, { rd_domid = id2 }) ->
300 | Processor | Memory | Time
301 | BlockRdRq | BlockWrRq
302 (* fallthrough to RXBY comparison. *)
304 (fun ({ D.rx_bytes = b1 }, _, { D.rx_bytes = b2 }, _) ->
307 (fun ({ D.tx_bytes = b1 }, _, { D.tx_bytes = b2 }, _) ->
310 let cmp (dev1, name1, rd1, stats1) (dev2, name2, rd2, stats2) =
311 let r = cmp (stats1, rd1, stats2, rd2) in
313 else compare (dev1, name1) (dev2, name2)
315 List.sort ~cmp devs in
317 (* Print the header for network devices. *)
319 mvaddstr header_lineno 0
320 (pad cols " ID S RXBY TXBY RXPK TXPK DOMAIN INTERFACE");
323 (* Print domains and devices. *)
324 let rec loop lineno = function
326 | (dev, name, rd, stats) :: devs ->
327 if lineno < lines then (
328 let state = show_state rd.rd_info.D.state in
330 if stats.D.rx_bytes >= 0L
331 then Show.int64 stats.D.rx_bytes
334 if stats.D.tx_bytes >= 0L
335 then Show.int64 stats.D.tx_bytes
338 if stats.D.rx_packets >= 0L
339 then Show.int64 stats.D.rx_packets
342 if stats.D.tx_packets >= 0L
343 then Show.int64 stats.D.tx_packets
346 let line = sprintf "%5d %c %s %s %s %s %-12s %s"
349 rx_packets tx_packets
351 let line = pad cols line in
352 mvaddstr lineno 0 line;
356 loop domains_lineno devs
358 (*---------- Showing block devices ----------*)
360 (* Only care about active domains. *)
364 | (name, Active rd) -> Some (name, rd)
365 | (_, Inactive) -> None
368 (* For each domain we have a list of block devices seen
369 * this slice, and seen in the previous slice, which we now
370 * match up to get a list of (domain, device) for which
371 * we have current & previous knowledge. (And ignore the rest).
379 (* Have prev slice stats for this device? *)
381 List.assoc dev rd.rd_prev_block_stats in
382 Some (dev, name, rd, stats, prev_stats)
383 with Not_found -> None
387 (* Finally we have a list of:
388 * device name, domain name, rd_* stuff, curr stats, prev stats.
390 let devs : (string * string * rd_active *
391 D.block_stats * D.block_stats) list =
394 (* Difference curr slice & prev slice. *)
397 fun (dev, name, rd, curr, prev) ->
398 dev, name, rd, diff_block_stats curr prev
401 (* Sort by current sort order, but map some of the standard
402 * sort orders into ones which makes sense here.
406 match sort_order with
408 (fun _ -> 0) (* fallthrough to default name compare *)
410 (fun (_, { rd_domid = id1 }, _, { rd_domid = id2 }) ->
412 | Processor | Memory | Time
414 (* fallthrough to RDRQ comparison. *)
416 (fun ({ D.rd_req = b1 }, _, { D.rd_req = b2 }, _) ->
419 (fun ({ D.wr_req = b1 }, _, { D.wr_req = b2 }, _) ->
422 let cmp (dev1, name1, rd1, stats1) (dev2, name2, rd2, stats2) =
423 let r = cmp (stats1, rd1, stats2, rd2) in
425 else compare (dev1, name1) (dev2, name2)
427 List.sort ~cmp devs in
429 (* Print the header for block devices. *)
431 mvaddstr header_lineno 0
432 (pad cols " ID S RDBY WRBY RDRQ WRRQ DOMAIN DEVICE");
435 (* Print domains and devices. *)
436 let rec loop lineno = function
438 | (dev, name, rd, stats) :: devs ->
439 if lineno < lines then (
440 let state = show_state rd.rd_info.D.state in
442 if stats.D.rd_bytes >= 0L
443 then Show.int64 stats.D.rd_bytes
446 if stats.D.wr_bytes >= 0L
447 then Show.int64 stats.D.wr_bytes
450 if stats.D.rd_req >= 0L
451 then Show.int64 stats.D.rd_req
454 if stats.D.wr_req >= 0L
455 then Show.int64 stats.D.wr_req
458 let line = sprintf "%5d %c %s %s %s %s %-12s %s"
463 let line = pad cols line in
464 mvaddstr lineno 0 line;
468 loop domains_lineno devs
469 ); (* end of display_mode conditional section *)
471 let (count, running, blocked, paused, shutdown, shutoff,
472 crashed, active, inactive,
473 total_cpu_time, total_memory, total_domU_memory) = totals in
475 mvaddstr summary_lineno 0
477 (f_"%d domains, %d active, %d running, %d sleeping, %d paused, %d inactive D:%d O:%d X:%d")
478 count active running blocked paused inactive shutdown shutoff crashed);
480 (* Total %CPU used, and memory summary. *)
481 let percent_cpu = 100. *. total_cpu_time /. total_cpu in
482 mvaddstr (summary_lineno+1) 0
484 (f_"CPU: %2.1f%% Mem: %Ld MB (%Ld MB by guests)")
485 percent_cpu (total_memory /^ 1024L) (total_domU_memory /^ 1024L));
487 (* Time to grab another historical %CPU for the list? *)
488 if time >= !historical_cpu_last_time +. float historical_cpu_delay
490 historical_cpu := percent_cpu :: List.take 10 !historical_cpu;
491 historical_cpu_last_time := time
494 (* Display historical CPU time. *)
496 let y, x = historical_cursor in
497 let maxwidth = cols - x in
500 (List.map (sprintf "%2.1f%%") !historical_cpu) in
501 let line = pad maxwidth line in
505 move message_lineno 0; (* Park cursor in message area, as with top. *)
506 refresh () (* Refresh the display. *)