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