src/redraw.ml

   1 (* 'top'-like tool for libvirt domains.
   2    (C) Copyright 2007-2017 Richard W.M. Jones, Red Hat Inc.
   3    http://libvirt.org/
   4
   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.
   9
  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.
  14
  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.
  18 *)
  19
  20 open Curses
  21 open Printf
  22
  23 open Opt_gettext.Gettext
  24 open Utils
  25 open Types
  26 open Screen
  27 open Collect
  28
  29 module C = Libvirt.Connect
  30 module D = Libvirt.Domain
  31
  32 (* Keep a historical list of %CPU usages. *)
  33 let historical_cpu = ref []
  34 let historical_cpu_last_time = ref (Unix.gettimeofday ())
  35
  36 (* Redraw the display. *)
  37 let redraw display_mode sort_order
  38            (_, _, _, _, _, node_info, _, _) (* setup *)
  39            block_in_bytes
  40            historical_cpu_delay
  41            { rd_doms = doms;
  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 *)
  47            pcpu_display =
  48   clear ();
  49
  50   (* Get the screen/window size. *)
  51   let lines, cols = get_size () in
  52
  53   (* Time. *)
  54   mvaddstr top_lineno 0 (sprintf "virt-top %s - " printable_time);
  55
  56   (* Basic node_info. *)
  57   addstr
  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).
  63    *)
  64   let stdscr = stdscr () in
  65   let historical_cursor = getyx stdscr in
  66
  67   (match display_mode with
  68
  69    (*---------- Showing domains ----------*)
  70    | TaskDisplay ->
  71       (* Sort domains on current sort_order. *)
  72       let doms =
  73         let cmp =
  74           match sort_order with
  75           | DomainName ->
  76              (fun _ -> 0) (* fallthrough to default name compare *)
  77           | Processor ->
  78              (function
  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)
  84           | Memory ->
  85              (function
  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)
  91           | Time ->
  92              (function
  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)
  98           | DomainID ->
  99              (function
 100                | Active { rd_domid = id1 }, Active { rd_domid = id2 } ->
 101                   compare id1 id2
 102                | Active _, Inactive -> -1
 103                | Inactive, Active _ -> 1
 104                | Inactive, Inactive -> 0)
 105           | NetRX ->
 106              (function
 107                | Active { rd_net_rx_bytes = r1 }, Active { rd_net_rx_bytes = r2 } ->
 108                   compare r2 r1
 109                | Active _, Inactive -> -1
 110                | Inactive, Active _ -> 1
 111                | Inactive, Inactive -> 0)
 112           | NetTX ->
 113              (function
 114                | Active { rd_net_tx_bytes = r1 }, Active { rd_net_tx_bytes = r2 } ->
 115                   compare r2 r1
 116                | Active _, Inactive -> -1
 117                | Inactive, Active _ -> 1
 118                | Inactive, Inactive -> 0)
 119           | BlockRdRq ->
 120              (function
 121                | Active { rd_block_rd_reqs = r1 }, Active { rd_block_rd_reqs = r2 } ->
 122                   compare r2 r1
 123                | Active _, Inactive -> -1
 124                | Inactive, Active _ -> 1
 125                | Inactive, Inactive -> 0)
 126           | BlockWrRq ->
 127              (function
 128                | Active { rd_block_wr_reqs = r1 }, Active { rd_block_wr_reqs = r2 } ->
 129                   compare r2 r1
 130                | Active _, Inactive -> -1
 131                | Inactive, Active _ -> 1
 132                | Inactive, Inactive -> 0)
 133         in
 134         let cmp (name1, dom1) (name2, dom2) =
 135           let r = cmp (dom1, dom2) in
 136           if r <> 0 then r
 137           else compare name1 name2
 138         in
 139         List.sort cmp doms in
 140
 141       (* Print domains. *)
 142       attron A.reverse;
 143       let header_string =
 144         if block_in_bytes
 145         then "   ID S RDBY WRBY RXBY TXBY %CPU %MEM    TIME   NAME"
 146         else "   ID S RDRQ WRRQ RXBY TXBY %CPU %MEM    TIME   NAME"
 147       in
 148       mvaddstr header_lineno 0
 149                (pad cols header_string);
 150       attroff A.reverse;
 151
 152       let rec loop lineno = function
 153         | [] -> ()
 154         | (name, Active rd) :: doms ->
 155            if lineno < lines then (
 156              let state = show_state rd.rd_info.D.state in
 157              let rd_info =
 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
 160              let wr_info =
 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
 169
 170              let line =
 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;
 176              loop (lineno+1) doms
 177            )
 178         | (name, Inactive) :: doms -> (* inactive domain *)
 179            if lineno < lines then (
 180              let line =
 181                sprintf
 182                  "    -                                           (%s)"
 183                  name in
 184              let line = pad cols line in
 185              mvaddstr lineno 0 line;
 186              loop (lineno+1) doms
 187            )
 188       in
 189       loop domains_lineno doms
 190
 191    (*---------- Showing physical CPUs ----------*)
 192    | PCPUDisplay ->
 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
 197         | Some p -> p
 198         | None -> failwith "internal error: no pcpu_display data" in
 199
 200       (* Display the pCPUs. *)
 201       let dom_names =
 202         String.concat "" (
 203                         List.map (
 204                             fun (_, name, _, _, _, _, _, _) ->
 205                             let len = String.length name in
 206                             let width = max (len+1) 12 in
 207                             pad width name
 208                           ) doms
 209                       ) in
 210       attron A.reverse;
 211       mvaddstr header_lineno 0 (pad cols ("PHYCPU %CPU " ^ dom_names));
 212       attroff A.reverse;
 213
 214       Array.iteri (
 215         fun p row ->
 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);
 220           addch ' ';
 221
 222           List.iteri (
 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
 228               let str_t =
 229                 if t <= 0L then ""
 230                 else (
 231                   let t = Int64.to_float t in
 232                   let percent = 100. *. t /. total_cpu_per_pcpu in
 233                   Show.percent percent
 234                 ) in
 235               let str_t_only =
 236                 if t_only <= 0L then ""
 237                 else (
 238                   let t_only = Int64.to_float t_only in
 239                   let percent = 100. *. t_only /. total_cpu_per_pcpu in
 240                   Show.percent percent
 241                 ) in
 242               addstr (pad 5 str_t);
 243               addstr (pad 5 str_t_only);
 244               addstr (pad (width-10) " ");
 245               ()
 246           ) doms
 247       ) pcpus;
 248
 249    (*---------- Showing network interfaces ----------*)
 250    | NetDisplay ->
 251       (* Only care about active domains. *)
 252       let doms =
 253         List.filter_map (
 254             function
 255             | (name, Active rd) -> Some (name, rd)
 256             | (_, Inactive) -> None
 257         ) doms in
 258
 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).
 263        *)
 264       let devs =
 265         List.map (
 266           fun (name, rd) ->
 267             List.filter_map (
 268               fun (dev, stats) ->
 269                 try
 270                   (* Have prev slice stats for this device? *)
 271                   let prev_stats =
 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
 276           ) doms in
 277
 278       (* Finally we have a list of:
 279        * device name, domain name, rd_* stuff, curr stats, prev stats.
 280        *)
 281       let devs : (string * string * rd_active *
 282                     D.interface_stats * D.interface_stats) list =
 283         List.flatten devs in
 284
 285       (* Difference curr slice & prev slice. *)
 286       let devs =
 287         List.map (
 288           fun (dev, name, rd, curr, prev) ->
 289             dev, name, rd, diff_interface_stats curr prev
 290           ) devs in
 291
 292       (* Sort by current sort order, but map some of the standard
 293        * sort orders into ones which makes sense here.
 294        *)
 295       let devs =
 296         let cmp =
 297           match sort_order with
 298           | DomainName ->
 299              (fun _ -> 0) (* fallthrough to default name compare *)
 300           | DomainID ->
 301              (fun (_, { rd_domid = id1 }, _, { rd_domid = id2 }) ->
 302               compare id1 id2)
 303           | Processor | Memory | Time
 304           | BlockRdRq | BlockWrRq
 305              (* fallthrough to RXBY comparison. *)
 306           | NetRX ->
 307              (fun ({ D.rx_bytes = b1 }, _, { D.rx_bytes = b2 }, _) ->
 308               compare b2 b1)
 309           | NetTX ->
 310              (fun ({ D.tx_bytes = b1 }, _, { D.tx_bytes = b2 }, _) ->
 311               compare b2 b1)
 312         in
 313         let cmp (dev1, name1, rd1, stats1) (dev2, name2, rd2, stats2) =
 314           let r = cmp (stats1, rd1, stats2, rd2) in
 315           if r <> 0 then r
 316           else compare (dev1, name1) (dev2, name2)
 317         in
 318         List.sort cmp devs in
 319
 320       (* Print the header for network devices. *)
 321       attron A.reverse;
 322       mvaddstr header_lineno 0
 323                (pad cols "   ID S RXBY TXBY RXPK TXPK DOMAIN       INTERFACE");
 324       attroff A.reverse;
 325
 326       (* Print domains and devices. *)
 327       let rec loop lineno = function
 328         | [] -> ()
 329         | (dev, name, rd, stats) :: devs ->
 330            if lineno < lines then (
 331              let state = show_state rd.rd_info.D.state in
 332              let rx_bytes =
 333                if stats.D.rx_bytes >= 0L
 334                then Show.int64 stats.D.rx_bytes
 335                else "    " in
 336              let tx_bytes =
 337                if stats.D.tx_bytes >= 0L
 338                then Show.int64 stats.D.tx_bytes
 339                else "    " in
 340              let rx_packets =
 341                if stats.D.rx_packets >= 0L
 342                then Show.int64 stats.D.rx_packets
 343                else "    " in
 344              let tx_packets =
 345                if stats.D.tx_packets >= 0L
 346                then Show.int64 stats.D.tx_packets
 347                else "    " in
 348
 349              let line = sprintf "%5d %c %s %s %s %s %-12s %s"
 350                                 rd.rd_domid state
 351                                 rx_bytes tx_bytes
 352                                 rx_packets tx_packets
 353                                 (pad 12 name) dev in
 354              let line = pad cols line in
 355              mvaddstr lineno 0 line;
 356              loop (lineno+1) devs
 357            )
 358       in
 359       loop domains_lineno devs
 360
 361    (*---------- Showing block devices ----------*)
 362    | BlockDisplay ->
 363       (* Only care about active domains. *)
 364       let doms =
 365         List.filter_map (
 366             function
 367             | (name, Active rd) -> Some (name, rd)
 368             | (_, Inactive) -> None
 369         ) doms in
 370
 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).
 375        *)
 376       let devs =
 377         List.map (
 378           fun (name, rd) ->
 379             List.filter_map (
 380               fun (dev, stats) ->
 381                 try
 382                   (* Have prev slice stats for this device? *)
 383                   let prev_stats =
 384                     List.assoc dev rd.rd_prev_block_stats in
 385                   Some (dev, name, rd, stats, prev_stats)
 386                 with Not_found -> None
 387             ) rd.rd_block_stats
 388         ) doms in
 389
 390       (* Finally we have a list of:
 391        * device name, domain name, rd_* stuff, curr stats, prev stats.
 392        *)
 393       let devs : (string * string * rd_active *
 394                     D.block_stats * D.block_stats) list =
 395         List.flatten devs in
 396
 397       (* Difference curr slice & prev slice. *)
 398       let devs =
 399         List.map (
 400           fun (dev, name, rd, curr, prev) ->
 401             dev, name, rd, diff_block_stats curr prev
 402         ) devs in
 403
 404       (* Sort by current sort order, but map some of the standard
 405        * sort orders into ones which makes sense here.
 406        *)
 407       let devs =
 408         let cmp =
 409           match sort_order with
 410           | DomainName ->
 411              (fun _ -> 0) (* fallthrough to default name compare *)
 412           | DomainID ->
 413              (fun (_, { rd_domid = id1 }, _, { rd_domid = id2 }) ->
 414               compare id1 id2)
 415           | Processor | Memory | Time
 416           | NetRX | NetTX
 417              (* fallthrough to RDRQ comparison. *)
 418           | BlockRdRq ->
 419              (fun ({ D.rd_req = b1 }, _, { D.rd_req = b2 }, _) ->
 420               compare b2 b1)
 421           | BlockWrRq ->
 422              (fun ({ D.wr_req = b1 }, _, { D.wr_req = b2 }, _) ->
 423               compare b2 b1)
 424         in
 425         let cmp (dev1, name1, rd1, stats1) (dev2, name2, rd2, stats2) =
 426           let r = cmp (stats1, rd1, stats2, rd2) in
 427           if r <> 0 then r
 428           else compare (dev1, name1) (dev2, name2)
 429         in
 430         List.sort cmp devs in
 431
 432       (* Print the header for block devices. *)
 433       attron A.reverse;
 434       mvaddstr header_lineno 0
 435                (pad cols "   ID S RDBY WRBY RDRQ WRRQ DOMAIN       DEVICE");
 436       attroff A.reverse;
 437
 438       (* Print domains and devices. *)
 439       let rec loop lineno = function
 440         | [] -> ()
 441         | (dev, name, rd, stats) :: devs ->
 442            if lineno < lines then (
 443              let state = show_state rd.rd_info.D.state in
 444              let rd_bytes =
 445                if stats.D.rd_bytes >= 0L
 446                then Show.int64 stats.D.rd_bytes
 447                else "    " in
 448              let wr_bytes =
 449                if stats.D.wr_bytes >= 0L
 450                then Show.int64 stats.D.wr_bytes
 451                else "    " in
 452              let rd_req =
 453                if stats.D.rd_req >= 0L
 454                then Show.int64 stats.D.rd_req
 455                else "    " in
 456              let wr_req =
 457                if stats.D.wr_req >= 0L
 458                then Show.int64 stats.D.wr_req
 459                else "    " in
 460
 461              let line = sprintf "%5d %c %s %s %s %s %-12s %s"
 462                                 rd.rd_domid state
 463                                 rd_bytes wr_bytes
 464                                 rd_req wr_req
 465                                 (pad 12 name) dev in
 466              let line = pad cols line in
 467              mvaddstr lineno 0 line;
 468              loop (lineno+1) devs
 469            )
 470       in
 471       loop domains_lineno devs
 472   ); (* end of display_mode conditional section *)
 473
 474   let (count, running, blocked, paused, shutdown, shutoff,
 475        crashed, active, inactive,
 476        total_cpu_time, total_memory, total_domU_memory) = totals in
 477
 478   mvaddstr summary_lineno 0
 479            (sprintf
 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);
 482
 483   (* Total %CPU used, and memory summary. *)
 484   let percent_cpu = 100. *. total_cpu_time /. total_cpu in
 485   mvaddstr (summary_lineno+1) 0
 486            (sprintf
 487               (f_"CPU: %2.1f%%  Mem: %Ld MB (%Ld MB by guests)")
 488               percent_cpu (total_memory /^ 1024L) (total_domU_memory /^ 1024L));
 489
 490   (* Time to grab another historical %CPU for the list? *)
 491   if time >= !historical_cpu_last_time +. float historical_cpu_delay
 492   then (
 493     historical_cpu := percent_cpu :: list_take 10 !historical_cpu;
 494     historical_cpu_last_time := time
 495   );
 496
 497   (* Display historical CPU time. *)
 498   let () =
 499     let y, x = historical_cursor in
 500     let maxwidth = cols - x in
 501     let line =
 502       String.concat " "
 503                     (List.map (sprintf "%2.1f%%") !historical_cpu) in
 504     let line = pad maxwidth line in
 505     mvaddstr y x line;
 506     () in
 507
 508   move message_lineno 0; (* Park cursor in message area, as with top. *)
 509   refresh ()             (* Refresh the display. *)