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_info =
 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
 161              let wr_info =
 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
 170
 171              let line =
 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;
 177              loop (lineno+1) doms
 178            )
 179         | (name, Inactive) :: doms -> (* inactive domain *)
 180            if lineno < lines then (
 181              let line =
 182                sprintf
 183                  "    -                                           (%s)"
 184                  name in
 185              let line = pad cols line in
 186              mvaddstr lineno 0 line;
 187              loop (lineno+1) doms
 188            )
 189       in
 190       loop domains_lineno doms
 191
 192    (*---------- Showing physical CPUs ----------*)
 193    | PCPUDisplay ->
 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
 198         | Some p -> p
 199         | None -> failwith "internal error: no pcpu_display data" in
 200
 201       (* Display the pCPUs. *)
 202       let dom_names =
 203         String.concat "" (
 204                         List.map (
 205                             fun (_, name, _, _, _, _, _, _) ->
 206                             let len = String.length name in
 207                             let width = max (len+1) 12 in
 208                             pad width name
 209                           ) doms
 210                       ) in
 211       attron A.reverse;
 212       mvaddstr header_lineno 0 (pad cols ("PHYCPU %CPU " ^ dom_names));
 213       attroff A.reverse;
 214
 215       Array.iteri (
 216         fun p row ->
 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);
 221           addch ' ';
 222
 223           List.iteri (
 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
 229               let str_t =
 230                 if t <= 0L then ""
 231                 else (
 232                   let t = Int64.to_float t in
 233                   let percent = 100. *. t /. total_cpu_per_pcpu in
 234                   Show.percent percent
 235                 ) in
 236               let str_t_only =
 237                 if t_only <= 0L then ""
 238                 else (
 239                   let t_only = Int64.to_float t_only in
 240                   let percent = 100. *. t_only /. total_cpu_per_pcpu in
 241                   Show.percent percent
 242                 ) in
 243               addstr (pad 5 str_t);
 244               addstr (pad 5 str_t_only);
 245               addstr (pad (width-10) " ");
 246               ()
 247           ) doms
 248       ) pcpus;
 249
 250    (*---------- Showing network interfaces ----------*)
 251    | NetDisplay ->
 252       (* Only care about active domains. *)
 253       let doms =
 254         List.filter_map (
 255             function
 256             | (name, Active rd) -> Some (name, rd)
 257             | (_, Inactive) -> None
 258         ) doms in
 259
 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).
 264        *)
 265       let devs =
 266         List.map (
 267           fun (name, rd) ->
 268             List.filter_map (
 269               fun (dev, stats) ->
 270                 try
 271                   (* Have prev slice stats for this device? *)
 272                   let prev_stats =
 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
 277           ) doms in
 278
 279       (* Finally we have a list of:
 280        * device name, domain name, rd_* stuff, curr stats, prev stats.
 281        *)
 282       let devs : (string * string * rd_active *
 283                     D.interface_stats * D.interface_stats) list =
 284         List.flatten devs in
 285
 286       (* Difference curr slice & prev slice. *)
 287       let devs =
 288         List.map (
 289           fun (dev, name, rd, curr, prev) ->
 290             dev, name, rd, diff_interface_stats curr prev
 291           ) devs in
 292
 293       (* Sort by current sort order, but map some of the standard
 294        * sort orders into ones which makes sense here.
 295        *)
 296       let devs =
 297         let cmp =
 298           match sort_order with
 299           | DomainName ->
 300              (fun _ -> 0) (* fallthrough to default name compare *)
 301           | DomainID ->
 302              (fun (_, { rd_domid = id1 }, _, { rd_domid = id2 }) ->
 303               compare id1 id2)
 304           | Processor | Memory | Time
 305           | BlockRdRq | BlockWrRq
 306              (* fallthrough to RXBY comparison. *)
 307           | NetRX ->
 308              (fun ({ D.rx_bytes = b1 }, _, { D.rx_bytes = b2 }, _) ->
 309               compare b2 b1)
 310           | NetTX ->
 311              (fun ({ D.tx_bytes = b1 }, _, { D.tx_bytes = b2 }, _) ->
 312               compare b2 b1)
 313         in
 314         let cmp (dev1, name1, rd1, stats1) (dev2, name2, rd2, stats2) =
 315           let r = cmp (stats1, rd1, stats2, rd2) in
 316           if r <> 0 then r
 317           else compare (dev1, name1) (dev2, name2)
 318         in
 319         List.sort ~cmp devs in
 320
 321       (* Print the header for network devices. *)
 322       attron A.reverse;
 323       mvaddstr header_lineno 0
 324                (pad cols "   ID S RXBY TXBY RXPK TXPK DOMAIN       INTERFACE");
 325       attroff A.reverse;
 326
 327       (* Print domains and devices. *)
 328       let rec loop lineno = function
 329         | [] -> ()
 330         | (dev, name, rd, stats) :: devs ->
 331            if lineno < lines then (
 332              let state = show_state rd.rd_info.D.state in
 333              let rx_bytes =
 334                if stats.D.rx_bytes >= 0L
 335                then Show.int64 stats.D.rx_bytes
 336                else "    " in
 337              let tx_bytes =
 338                if stats.D.tx_bytes >= 0L
 339                then Show.int64 stats.D.tx_bytes
 340                else "    " in
 341              let rx_packets =
 342                if stats.D.rx_packets >= 0L
 343                then Show.int64 stats.D.rx_packets
 344                else "    " in
 345              let tx_packets =
 346                if stats.D.tx_packets >= 0L
 347                then Show.int64 stats.D.tx_packets
 348                else "    " in
 349
 350              let line = sprintf "%5d %c %s %s %s %s %-12s %s"
 351                                 rd.rd_domid state
 352                                 rx_bytes tx_bytes
 353                                 rx_packets tx_packets
 354                                 (pad 12 name) dev in
 355              let line = pad cols line in
 356              mvaddstr lineno 0 line;
 357              loop (lineno+1) devs
 358            )
 359       in
 360       loop domains_lineno devs
 361
 362    (*---------- Showing block devices ----------*)
 363    | BlockDisplay ->
 364       (* Only care about active domains. *)
 365       let doms =
 366         List.filter_map (
 367             function
 368             | (name, Active rd) -> Some (name, rd)
 369             | (_, Inactive) -> None
 370         ) doms in
 371
 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).
 376        *)
 377       let devs =
 378         List.map (
 379           fun (name, rd) ->
 380             List.filter_map (
 381               fun (dev, stats) ->
 382                 try
 383                   (* Have prev slice stats for this device? *)
 384                   let prev_stats =
 385                     List.assoc dev rd.rd_prev_block_stats in
 386                   Some (dev, name, rd, stats, prev_stats)
 387                 with Not_found -> None
 388             ) rd.rd_block_stats
 389         ) doms in
 390
 391       (* Finally we have a list of:
 392        * device name, domain name, rd_* stuff, curr stats, prev stats.
 393        *)
 394       let devs : (string * string * rd_active *
 395                     D.block_stats * D.block_stats) list =
 396         List.flatten devs in
 397
 398       (* Difference curr slice & prev slice. *)
 399       let devs =
 400         List.map (
 401           fun (dev, name, rd, curr, prev) ->
 402             dev, name, rd, diff_block_stats curr prev
 403         ) devs in
 404
 405       (* Sort by current sort order, but map some of the standard
 406        * sort orders into ones which makes sense here.
 407        *)
 408       let devs =
 409         let cmp =
 410           match sort_order with
 411           | DomainName ->
 412              (fun _ -> 0) (* fallthrough to default name compare *)
 413           | DomainID ->
 414              (fun (_, { rd_domid = id1 }, _, { rd_domid = id2 }) ->
 415               compare id1 id2)
 416           | Processor | Memory | Time
 417           | NetRX | NetTX
 418              (* fallthrough to RDRQ comparison. *)
 419           | BlockRdRq ->
 420              (fun ({ D.rd_req = b1 }, _, { D.rd_req = b2 }, _) ->
 421               compare b2 b1)
 422           | BlockWrRq ->
 423              (fun ({ D.wr_req = b1 }, _, { D.wr_req = b2 }, _) ->
 424               compare b2 b1)
 425         in
 426         let cmp (dev1, name1, rd1, stats1) (dev2, name2, rd2, stats2) =
 427           let r = cmp (stats1, rd1, stats2, rd2) in
 428           if r <> 0 then r
 429           else compare (dev1, name1) (dev2, name2)
 430         in
 431         List.sort ~cmp devs in
 432
 433       (* Print the header for block devices. *)
 434       attron A.reverse;
 435       mvaddstr header_lineno 0
 436                (pad cols "   ID S RDBY WRBY RDRQ WRRQ DOMAIN       DEVICE");
 437       attroff A.reverse;
 438
 439       (* Print domains and devices. *)
 440       let rec loop lineno = function
 441         | [] -> ()
 442         | (dev, name, rd, stats) :: devs ->
 443            if lineno < lines then (
 444              let state = show_state rd.rd_info.D.state in
 445              let rd_bytes =
 446                if stats.D.rd_bytes >= 0L
 447                then Show.int64 stats.D.rd_bytes
 448                else "    " in
 449              let wr_bytes =
 450                if stats.D.wr_bytes >= 0L
 451                then Show.int64 stats.D.wr_bytes
 452                else "    " in
 453              let rd_req =
 454                if stats.D.rd_req >= 0L
 455                then Show.int64 stats.D.rd_req
 456                else "    " in
 457              let wr_req =
 458                if stats.D.wr_req >= 0L
 459                then Show.int64 stats.D.wr_req
 460                else "    " in
 461
 462              let line = sprintf "%5d %c %s %s %s %s %-12s %s"
 463                                 rd.rd_domid state
 464                                 rd_bytes wr_bytes
 465                                 rd_req wr_req
 466                                 (pad 12 name) dev in
 467              let line = pad cols line in
 468              mvaddstr lineno 0 line;
 469              loop (lineno+1) devs
 470            )
 471       in
 472       loop domains_lineno devs
 473   ); (* end of display_mode conditional section *)
 474
 475   let (count, running, blocked, paused, shutdown, shutoff,
 476        crashed, active, inactive,
 477        total_cpu_time, total_memory, total_domU_memory) = totals in
 478
 479   mvaddstr summary_lineno 0
 480            (sprintf
 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);
 483
 484   (* Total %CPU used, and memory summary. *)
 485   let percent_cpu = 100. *. total_cpu_time /. total_cpu in
 486   mvaddstr (summary_lineno+1) 0
 487            (sprintf
 488               (f_"CPU: %2.1f%%  Mem: %Ld MB (%Ld MB by guests)")
 489               percent_cpu (total_memory /^ 1024L) (total_domU_memory /^ 1024L));
 490
 491   (* Time to grab another historical %CPU for the list? *)
 492   if time >= !historical_cpu_last_time +. float historical_cpu_delay
 493   then (
 494     historical_cpu := percent_cpu :: List.take 10 !historical_cpu;
 495     historical_cpu_last_time := time
 496   );
 497
 498   (* Display historical CPU time. *)
 499   let () =
 500     let y, x = historical_cursor in
 501     let maxwidth = cols - x in
 502     let line =
 503       String.concat " "
 504                     (List.map (sprintf "%2.1f%%") !historical_cpu) in
 505     let line = pad maxwidth line in
 506     mvaddstr y x line;
 507     () in
 508
 509   move message_lineno 0; (* Park cursor in message area, as with top. *)
 510   refresh ()             (* Refresh the display. *)