src/top.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 Printf
  21 open ExtList
  22 open Curses
  23
  24 open Opt_gettext.Gettext
  25 open Utils
  26 open Types
  27 open Collect
  28 open Screen
  29
  30 module C = Libvirt.Connect
  31 module D = Libvirt.Domain
  32 module N = Libvirt.Network
  33
  34 let rcfile = ".virt-toprc"
  35
  36 (* Hooks for CSV support (see [opt_csv.ml]). *)
  37 let csv_start : (string -> unit) ref =
  38   ref (
  39     fun _ -> failwith (s_"virt-top was compiled without support for CSV files")
  40   )
  41
  42 (* Hook for calendar support (see [opt_calendar.ml]). *)
  43 let parse_date_time : (string -> float) ref =
  44   ref (
  45     fun _ ->
  46       failwith (s_"virt-top was compiled without support for dates and times")
  47   )
  48
  49 (* Init file. *)
  50 type init_file = NoInitFile | DefaultInitFile | InitFile of string
  51
  52 (* Settings. *)
  53 let quit = ref false
  54 let delay = ref 3000 (* milliseconds *)
  55 let historical_cpu_delay = ref 20 (* secs *)
  56 let iterations = ref (-1)
  57 let end_time = ref None
  58 let batch_mode = ref false
  59 let secure_mode = ref false
  60 let sort_order = ref Processor
  61 let display_mode = ref TaskDisplay
  62 let uri = ref None
  63 let debug_file = ref ""
  64 let csv_enabled = ref false
  65 let csv_cpu = ref true
  66 let csv_mem = ref true
  67 let csv_block = ref true
  68 let csv_net = ref true
  69 let init_file = ref DefaultInitFile
  70 let script_mode = ref false
  71 let stream_mode = ref false
  72 let block_in_bytes = ref false
  73
  74 (* Function to read command line arguments and go into curses mode. *)
  75 let start_up () =
  76   (* Read command line arguments. *)
  77   let rec set_delay newdelay =
  78     if newdelay <= 0. then
  79       failwith (s_"-d: cannot set a negative delay");
  80     delay := int_of_float (newdelay *. 1000.)
  81   and set_uri = function "" -> uri := None | u -> uri := Some u
  82   and set_sort order = sort_order := sort_order_of_cli order
  83   and set_pcpu_mode () = display_mode := PCPUDisplay
  84   and set_net_mode () = display_mode := NetDisplay
  85   and set_block_mode () = display_mode := BlockDisplay
  86   and set_csv filename =
  87     (!csv_start) filename;
  88     csv_enabled := true
  89   and no_init_file () = init_file := NoInitFile
  90   and set_init_file filename = init_file := InitFile filename
  91   and set_end_time time = end_time := Some ((!parse_date_time) time)
  92   and display_version () =
  93     printf "virt-top %s ocaml-libvirt %s\n"
  94       Version.version Libvirt_version.version;
  95     exit 0
  96   in
  97   let argspec = Arg.align [
  98     "-1", Arg.Unit set_pcpu_mode,
  99       " " ^ s_"Start by displaying pCPUs (default: tasks)";
 100     "-2", Arg.Unit set_net_mode,
 101       " " ^ s_"Start by displaying network interfaces";
 102     "-3", Arg.Unit set_block_mode,
 103       " " ^ s_"Start by displaying block devices";
 104     "-b", Arg.Set batch_mode,
 105       " " ^ s_"Batch mode";
 106     "-c", Arg.String set_uri,
 107       "uri " ^ s_"Connect to libvirt URI";
 108     "--connect", Arg.String set_uri,
 109       "uri " ^ s_"Connect to libvirt URI";
 110     "--csv", Arg.String set_csv,
 111       "file " ^ s_"Log statistics to CSV file";
 112     "--no-csv-cpu", Arg.Clear csv_cpu,
 113       " " ^ s_"Disable CPU stats in CSV";
 114     "--no-csv-mem", Arg.Clear csv_mem,
 115       " " ^ s_"Disable memory stats in CSV";
 116     "--no-csv-block", Arg.Clear csv_block,
 117       " " ^ s_"Disable block device stats in CSV";
 118     "--no-csv-net", Arg.Clear csv_net,
 119       " " ^ s_"Disable net stats in CSV";
 120     "-d", Arg.Float set_delay,
 121       "delay " ^ s_"Delay time interval (seconds)";
 122     "--debug", Arg.Set_string debug_file,
 123       "file " ^ s_"Send debug messages to file";
 124     "--end-time", Arg.String set_end_time,
 125       "time " ^ s_"Exit at given time";
 126     "--hist-cpu", Arg.Set_int historical_cpu_delay,
 127       "secs " ^ s_"Historical CPU delay";
 128     "--init-file", Arg.String set_init_file,
 129       "file " ^ s_"Set name of init file";
 130     "--no-init-file", Arg.Unit no_init_file,
 131       " " ^ s_"Do not read init file";
 132     "-n", Arg.Set_int iterations,
 133       "iterations " ^ s_"Number of iterations to run";
 134     "-o", Arg.String set_sort,
 135       "sort " ^ sprintf (f_"Set sort order (%s)")
 136         "cpu|mem|time|id|name|netrx|nettx|blockrdrq|blockwrrq";
 137     "-s", Arg.Set secure_mode,
 138       " " ^ s_"Secure (\"kiosk\") mode";
 139     "--script", Arg.Set script_mode,
 140       " " ^ s_"Run from a script (no user interface)";
 141     "--stream", Arg.Set stream_mode,
 142       " " ^ s_"dump output to stdout (no userinterface)";
 143     "--block-in-bytes", Arg.Set block_in_bytes,
 144       " " ^ s_"show block device load in bytes rather than reqs";
 145     "--version", Arg.Unit display_version,
 146       " " ^ s_"Display version number and exit";
 147   ] in
 148   let anon_fun str =
 149     raise (Arg.Bad (sprintf (f_"%s: unknown parameter") str)) in
 150   let usage_msg = s_"virt-top : a 'top'-like utility for virtualization
 151
 152 SUMMARY
 153   virt-top [-options]
 154
 155 OPTIONS" in
 156   Arg.parse argspec anon_fun usage_msg;
 157
 158   (* Read the init file. *)
 159   let try_to_read_init_file filename =
 160     let config = read_config_file filename in
 161     (* Replacement functions that raise better errors when
 162      * parsing the init file.
 163      *)
 164     let int_of_string s =
 165       try int_of_string s
 166       with Invalid_argument _ ->
 167         failwithf (f_"%s: could not parse '%s' in init file: expecting an integer")
 168           filename s in
 169     let float_of_string s =
 170       try float_of_string s
 171       with Invalid_argument _ ->
 172         failwithf (f_"%s: could not parse '%s' in init file: expecting a number")
 173           filename s in
 174     let bool_of_string s =
 175       try bool_of_string s
 176       with Invalid_argument _ ->
 177         failwithf (f_"%s: could not parse '%s' in init file: expecting %s")
 178           filename s "true|false" in
 179     List.iter (
 180       function
 181       | _, "display", mode -> display_mode := display_of_cli mode
 182       | _, "delay", secs -> set_delay (float_of_string secs)
 183       | _, "hist-cpu", secs -> historical_cpu_delay := int_of_string secs
 184       | _, "iterations", n -> iterations := int_of_string n
 185       | _, "sort", order -> set_sort order
 186       | _, "connect", uri -> set_uri uri
 187       | _, "debug", filename -> debug_file := filename
 188       | _, "csv", filename -> set_csv filename
 189       | _, "csv-cpu", b -> csv_cpu := bool_of_string b
 190       | _, "csv-mem", b -> csv_mem := bool_of_string b
 191       | _, "csv-block", b -> csv_block := bool_of_string b
 192       | _, "csv-net", b -> csv_net := bool_of_string b
 193       | _, "batch", b -> batch_mode := bool_of_string b
 194       | _, "secure", b -> secure_mode := bool_of_string b
 195       | _, "script", b -> script_mode := bool_of_string b
 196       | _, "stream", b -> stream_mode := bool_of_string b
 197       | _, "block-in-bytes", b -> block_in_bytes := bool_of_string b
 198       | _, "end-time", t -> set_end_time t
 199       | _, "overwrite-init-file", "false" -> no_init_file ()
 200       | lineno, key, _ ->
 201           eprintf (f_"%s:%d: configuration item ``%s'' ignored\n%!")
 202             filename lineno key
 203     ) config
 204   in
 205   (match !init_file with
 206    | NoInitFile -> ()
 207    | DefaultInitFile ->
 208        let home = try Sys.getenv "HOME" with Not_found -> "/" in
 209        let filename = home // rcfile in
 210        try_to_read_init_file filename
 211    | InitFile filename ->
 212        try_to_read_init_file filename
 213   );
 214
 215   (* Connect to the hypervisor before going into curses mode, since
 216    * this is the most likely thing to fail.
 217    *)
 218   let conn =
 219     let name = !uri in
 220     try C.connect_readonly ?name ()
 221     with
 222       Libvirt.Virterror err ->
 223         prerr_endline (Libvirt.Virterror.to_string err);
 224         (* If non-root and no explicit connection URI, print a warning. *)
 225         if Unix.geteuid () <> 0 && name = None then (
 226           print_endline (s_"NB: If you want to monitor a local hypervisor, you usually need to be root");
 227         );
 228         exit 1 in
 229
 230   (* Get the node_info.  This never changes, right?  So we get it just once. *)
 231   let node_info = C.get_node_info conn in
 232
 233   (* Hostname and libvirt library version also don't change. *)
 234   let hostname =
 235     try C.get_hostname conn
 236     with
 237     (* qemu:/// and other URIs didn't support virConnectGetHostname until
 238      * libvirt 0.3.3.  Before that they'd throw a virterror. *)
 239     | Libvirt.Virterror _
 240     | Libvirt.Not_supported "virConnectGetHostname" -> "unknown" in
 241
 242   let libvirt_version =
 243     let v, _ = Libvirt.get_version () in
 244     v / 1_000_000, (v / 1_000) mod 1_000, v mod 1_000 in
 245
 246   (* Open debug file if specified.
 247    * NB: Do this just before jumping into curses mode.
 248    *)
 249   (match !debug_file with
 250    | "" -> (* No debug file specified, send stderr to /dev/null unless
 251             * we're in script mode.
 252             *)
 253        if not !script_mode && not !stream_mode then (
 254          let fd = Unix.openfile "/dev/null" [Unix.O_WRONLY] 0o644 in
 255          Unix.dup2 fd Unix.stderr;
 256          Unix.close fd
 257        )
 258    | filename -> (* Send stderr to the named file. *)
 259        let fd =
 260          Unix.openfile filename [Unix.O_WRONLY;Unix.O_CREAT;Unix.O_TRUNC]
 261            0o644 in
 262        Unix.dup2 fd Unix.stderr;
 263        Unix.close fd
 264   );
 265
 266   (* Curses voodoo (see ncurses(3)). *)
 267   if not !script_mode && not !stream_mode then (
 268     ignore (initscr ());
 269     ignore (cbreak ());
 270     ignore (noecho ());
 271     nonl ();
 272     let stdscr = stdscr () in
 273     ignore (intrflush stdscr false);
 274     ignore (keypad stdscr true);
 275     ()
 276   );
 277
 278   (* This tuple of static information is called 'setup' in other parts
 279    * of this program, and is passed to other functions such as redraw and
 280    * main_loop.  See [main.ml].
 281    *)
 282   (conn,
 283    !batch_mode, !script_mode, !csv_enabled, !stream_mode, (* immutable modes *)
 284    node_info, hostname, libvirt_version (* info that doesn't change *)
 285   )
 286
 287 (* Sleep in seconds. *)
 288 let sleep = Unix.sleep
 289
 290 (* Sleep in milliseconds. *)
 291 let millisleep n =
 292   ignore (Unix.select [] [] [] (float n /. 1000.))
 293
 294 (* The curses getstr/getnstr functions are just weird.
 295  * This helper function also enables echo temporarily.
 296  *)
 297 let get_string maxlen =
 298   ignore (echo ());
 299   let str = Bytes.create maxlen in
 300   (* Safe because binding calls getnstr.  However the unsafe cast
 301    * to string is required because ocaml-curses needs to be fixed.
 302    *)
 303   let ok = getstr (Obj.magic str) in
 304   ignore (noecho ());
 305   if not ok then ""
 306   else (
 307     (* Chop at first '\0'. *)
 308     try
 309       let i = Bytes.index str '\000' in
 310       Bytes.sub_string str 0 i
 311     with
 312       Not_found -> Bytes.to_string str (* it is full maxlen bytes *)
 313   )
 314
 315 (* Main loop. *)
 316 let rec main_loop ((_, batch_mode, script_mode, csv_enabled, stream_mode, _, _, _)
 317                      as setup) =
 318   let csv_flags = !csv_cpu, !csv_mem, !csv_block, !csv_net in
 319
 320   if csv_enabled then
 321     Csv_output.write_csv_header csv_flags !block_in_bytes;
 322
 323   while not !quit do
 324     (* Collect stats. *)
 325     let state = collect setup in
 326     let pcpu_display =
 327       if !display_mode = PCPUDisplay then Some (collect_pcpu state)
 328       else None in
 329     (* Redraw display. *)
 330     if not script_mode && not stream_mode then
 331       Redraw.redraw !display_mode !sort_order
 332                     setup !block_in_bytes !historical_cpu_delay
 333                     state pcpu_display;
 334
 335     (* Update CSV file. *)
 336     if csv_enabled then
 337       Csv_output.append_csv setup csv_flags !block_in_bytes state;
 338
 339     (* Append to stream output file. *)
 340     if stream_mode then
 341       Stream_output.append_stream setup !block_in_bytes state;
 342
 343     (* Clear up unused virDomainPtr objects. *)
 344     Gc.compact ();
 345
 346     (* Max iterations? *)
 347     if !iterations >= 0 then (
 348       decr iterations;
 349       if !iterations = 0 then quit := true
 350     );
 351
 352     (* End time?  We might need to adjust the precise delay down if
 353      * the delay would be longer than the end time (RHBZ#637964).  Note
 354      * 'delay' is in milliseconds.
 355      *)
 356     let delay =
 357       match !end_time with
 358       | None ->
 359           (* No --end-time option, so use the current delay. *)
 360           !delay
 361       | Some end_time ->
 362           let delay_secs = float !delay /. 1000. in
 363           if end_time <= state.rd_time +. delay_secs then (
 364             quit := true;
 365             let delay = int_of_float (1000. *. (end_time -. state.rd_time)) in
 366             if delay >= 0 then delay else 0
 367           ) else
 368             !delay in
 369     (*eprintf "adjusted delay = %d\n%!" delay;*)
 370
 371     (* Get next key.  This does the sleep. *)
 372     if not batch_mode && not script_mode && not stream_mode then
 373       get_key_press setup delay
 374     else (
 375       (* Batch mode, script mode, stream mode.  We didn't call
 376        * get_key_press, so we didn't sleep.  Sleep now, unless we are
 377        * about to quit.
 378        *)
 379       if not !quit || !end_time <> None then
 380         millisleep delay
 381     )
 382   done
 383
 384 and get_key_press setup delay =
 385   (* Read the next key, waiting up to 'delay' milliseconds. *)
 386   timeout delay;
 387   let k = getch () in
 388   timeout (-1); (* Reset to blocking mode. *)
 389
 390   if k >= 0 && k <> 32 (* ' ' *) && k <> 12 (* ^L *) && k <> Key.resize
 391   then (
 392     if k = Char.code 'q' then quit := true
 393     else if k = Char.code 'h' then show_help setup
 394     else if k = Char.code 's' || k = Char.code 'd' then change_delay ()
 395     else if k = Char.code 'M' then sort_order := Memory
 396     else if k = Char.code 'P' then sort_order := Processor
 397     else if k = Char.code 'T' then sort_order := Time
 398     else if k = Char.code 'N' then sort_order := DomainID
 399     else if k = Char.code 'F' then change_sort_order ()
 400     else if k = Char.code '0' then set_tasks_display ()
 401     else if k = Char.code '1' then toggle_pcpu_display ()
 402     else if k = Char.code '2' then toggle_net_display ()
 403     else if k = Char.code '3' then toggle_block_display ()
 404     else if k = Char.code 'W' then write_init_file ()
 405     else if k = Char.code 'B' then toggle_block_in_bytes_mode ()
 406     else unknown_command k
 407   )
 408
 409 and change_delay () =
 410   print_msg
 411     (sprintf (f_"Change delay from %.1f to: ") (float !delay /. 1000.));
 412   let str = get_string 16 in
 413   (* Try to parse the number. *)
 414   let error =
 415     try
 416       let newdelay = float_of_string str in
 417       if newdelay <= 0. then (
 418         print_msg (s_"Delay must be > 0"); true
 419       ) else (
 420         delay := int_of_float (newdelay *. 1000.); false
 421       )
 422     with
 423       Failure _ ->
 424         print_msg (s_"Not a valid number"); true in
 425   refresh ();
 426   sleep (if error then 2 else 1)
 427
 428 and change_sort_order () =
 429   clear ();
 430   let lines, cols = get_size () in
 431
 432   mvaddstr top_lineno 0 (s_"Set sort order for main display");
 433   mvaddstr summary_lineno 0 (s_"Type key or use up and down cursor keys.");
 434
 435   attron A.reverse;
 436   mvaddstr header_lineno 0 (pad cols "KEY   Sort field");
 437   attroff A.reverse;
 438
 439   let accelerator_key = function
 440     | Memory -> "(key: M)"
 441     | Processor -> "(key: P)"
 442     | Time -> "(key: T)"
 443     | DomainID -> "(key: N)"
 444     | _ -> (* all others have to be changed from here *) ""
 445   in
 446
 447   let rec key_of_int = function
 448     | i when i < 10 -> Char.chr (i + Char.code '0')
 449     | i when i < 20 -> Char.chr (i + Char.code 'a')
 450     | _ -> assert false
 451   and int_of_key = function
 452     | k when k >= 0x30 && k <= 0x39 (* '0' - '9' *) -> k - 0x30
 453     | k when k >= 0x61 && k <= 0x7a (* 'a' - 'j' *) -> k - 0x61 + 10
 454     | k when k >= 0x41 && k <= 0x6a (* 'A' - 'J' *) -> k - 0x41 + 10
 455     | _ -> -1
 456   in
 457
 458   (* Display possible sort fields. *)
 459   let selected_index = ref 0 in
 460   List.iteri (
 461     fun i ord ->
 462       let selected = !sort_order = ord in
 463       if selected then selected_index := i;
 464       mvaddstr (domains_lineno+i) 0
 465         (sprintf "  %c %s %s %s"
 466            (key_of_int i) (if selected then "*" else " ")
 467            (printable_sort_order ord)
 468            (accelerator_key ord))
 469   ) all_sort_fields;
 470
 471   move message_lineno 0;
 472   refresh ();
 473   let k = getch () in
 474   if k >= 0 && k <> 32 && k <> Char.code 'q' && k <> 13 then (
 475     let new_order, loop =
 476       (* Redraw the display. *)
 477       if k = 12 (* ^L *) then None, true
 478       (* Make the UP and DOWN arrow keys do something useful. *)
 479       else if k = Key.up then (
 480         if !selected_index > 0 then
 481           Some (List.nth all_sort_fields (!selected_index-1)), true
 482         else
 483           None, true
 484       )
 485       else if k = Key.down then (
 486         if !selected_index < List.length all_sort_fields - 1 then
 487           Some (List.nth all_sort_fields (!selected_index+1)), true
 488         else
 489           None, true
 490       )
 491       (* Also understand the regular accelerator keys. *)
 492       else if k = Char.code 'M' then
 493         Some Memory, false
 494       else if k = Char.code 'P' then
 495         Some Processor, false
 496       else if k = Char.code 'T' then
 497         Some Time, false
 498       else if k = Char.code 'N' then
 499         Some DomainID, false
 500       else (
 501         (* It's one of the KEYs. *)
 502         let i = int_of_key k in
 503         if i >= 0 && i < List.length all_sort_fields then
 504           Some (List.nth all_sort_fields i), false
 505         else
 506           None, true
 507       ) in
 508
 509     (match new_order with
 510      | None -> ()
 511      | Some new_order ->
 512          sort_order := new_order;
 513          print_msg (sprintf "Sort order changed to: %s"
 514                       (printable_sort_order new_order));
 515          if not loop then (
 516            refresh ();
 517            sleep 1
 518          )
 519     );
 520
 521     if loop then change_sort_order ()
 522   )
 523
 524 (* Note: We need to clear_pcpu_display_data every time
 525  * we _leave_ PCPUDisplay mode.
 526  *)
 527 and set_tasks_display () =              (* key 0 *)
 528   if !display_mode = PCPUDisplay then clear_pcpu_display_data ();
 529   display_mode := TaskDisplay
 530
 531 and toggle_pcpu_display () =            (* key 1 *)
 532   display_mode :=
 533     match !display_mode with
 534     | TaskDisplay | NetDisplay | BlockDisplay -> PCPUDisplay
 535     | PCPUDisplay -> clear_pcpu_display_data (); TaskDisplay
 536
 537 and toggle_net_display () =             (* key 2 *)
 538   display_mode :=
 539     match !display_mode with
 540     | PCPUDisplay -> clear_pcpu_display_data (); NetDisplay
 541     | TaskDisplay | BlockDisplay -> NetDisplay
 542     | NetDisplay -> TaskDisplay
 543
 544 and toggle_block_display () =           (* key 3 *)
 545   display_mode :=
 546     match !display_mode with
 547     | PCPUDisplay -> clear_pcpu_display_data (); BlockDisplay
 548     | TaskDisplay | NetDisplay -> BlockDisplay
 549     | BlockDisplay -> TaskDisplay
 550
 551 and toggle_block_in_bytes_mode () =      (* key B *)
 552   block_in_bytes :=
 553     match !block_in_bytes with
 554     | false -> true
 555     | true  -> false
 556
 557 (* Write an init file. *)
 558 and write_init_file () =
 559   match !init_file with
 560   | NoInitFile -> ()                    (* Do nothing if --no-init-file *)
 561   | DefaultInitFile ->
 562       let home = try Sys.getenv "HOME" with Not_found -> "/" in
 563       let filename = home // rcfile in
 564       _write_init_file filename
 565   | InitFile filename ->
 566       _write_init_file filename
 567
 568 and _write_init_file filename =
 569   try
 570     (* Create the new file as filename.new. *)
 571     let chan = open_out (filename ^ ".new") in
 572
 573     let time = Unix.gettimeofday () in
 574     let tm = Unix.localtime time in
 575     let printable_date_time =
 576       sprintf "%04d-%02d-%02d %02d:%02d:%02d"
 577         (tm.Unix.tm_year + 1900) (tm.Unix.tm_mon+1) tm.Unix.tm_mday
 578         tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec in
 579     let username =
 580       try
 581         let uid = Unix.geteuid () in
 582         (Unix.getpwuid uid).Unix.pw_name
 583       with
 584         Not_found -> "unknown" in
 585
 586     let fp = fprintf in
 587     let nl () = fp chan "\n" in
 588     let () = fp chan (f_"# %s virt-top configuration file\n") rcfile in
 589     let () = fp chan (f_"# generated on %s by %s\n") printable_date_time username in
 590     nl ();
 591     fp chan "display %s\n" (cli_of_display !display_mode);
 592     fp chan "delay %g\n" (float !delay /. 1000.);
 593     fp chan "hist-cpu %d\n" !historical_cpu_delay;
 594     if !iterations <> -1 then fp chan "iterations %d\n" !iterations;
 595     fp chan "sort %s\n" (cli_of_sort_order !sort_order);
 596     (match !uri with
 597      | None -> ()
 598      | Some uri -> fp chan "connect %s\n" uri
 599     );
 600     if !batch_mode = true then fp chan "batch true\n";
 601     if !secure_mode = true then fp chan "secure true\n";
 602     nl ();
 603     output_string chan (s_"# To send debug and error messages to a file, uncomment next line\n");
 604     fp chan "#debug virt-top.out\n";
 605     nl ();
 606     output_string chan (s_"# Enable CSV output to the named file\n");
 607     fp chan "#csv virt-top.csv\n";
 608     nl ();
 609     output_string chan (s_"# To protect this file from being overwritten, uncomment next line\n");
 610     fp chan "#overwrite-init-file false\n";
 611
 612     close_out chan;
 613
 614     (* If the file exists, rename it as filename.old. *)
 615     (try Unix.rename filename (filename ^ ".old")
 616      with Unix.Unix_error _ -> ());
 617
 618     (* Rename filename.new to filename. *)
 619     Unix.rename (filename ^ ".new") filename;
 620
 621     print_msg (sprintf (f_"Wrote settings to %s") filename);
 622     refresh ();
 623     sleep 2
 624   with
 625   | Sys_error err ->
 626       print_msg (s_"Error" ^ ": " ^ err);
 627       refresh (); sleep 2
 628   | Unix.Unix_error (err, fn, str) ->
 629       print_msg (s_"Error" ^ ": " ^
 630                    (Unix.error_message err) ^ " " ^ fn ^ " " ^ str);
 631       refresh ();
 632       sleep 2
 633
 634 and show_help (_, _, _, _, _, _, hostname,
 635                (libvirt_major, libvirt_minor, libvirt_release)) =
 636   clear ();
 637
 638   (* Get the screen/window size. *)
 639   let lines, cols = get_size () in
 640
 641   (* Banner at the top of the screen. *)
 642   let banner =
 643     sprintf (f_"virt-top %s ocaml-libvirt %s libvirt %d.%d.%d by Red Hat")
 644       Version.version
 645       Libvirt_version.version
 646       libvirt_major libvirt_minor libvirt_release in
 647   let banner = pad cols banner in
 648   attron A.reverse;
 649   mvaddstr 0 0 banner;
 650   attroff A.reverse;
 651
 652   (* Status. *)
 653   mvaddstr 1 0
 654     (sprintf
 655        (f_"Delay: %.1f secs; Batch: %s; Secure: %s; Sort: %s")
 656        (float !delay /. 1000.)
 657        (if !batch_mode then s_"On" else s_"Off")
 658        (if !secure_mode then s_"On" else s_"Off")
 659        (printable_sort_order !sort_order));
 660   mvaddstr 2 0
 661     (sprintf
 662        (f_"Connect: %s; Hostname: %s")
 663        (match !uri with None -> s_"default" | Some s -> s)
 664        hostname);
 665
 666   (* Misc keys on left. *)
 667   let banner = pad 38 (s_"MAIN KEYS") in
 668   attron A.reverse;
 669   mvaddstr header_lineno 1 banner;
 670   attroff A.reverse;
 671
 672   let get_lineno =
 673     let lineno = ref domains_lineno in
 674     fun () -> let i = !lineno in incr lineno; i
 675   in
 676   let key keys description =
 677     let lineno = get_lineno () in
 678     move lineno 1; attron A.bold; addstr keys; attroff A.bold;
 679     move lineno 10; addstr description
 680   in
 681   key "space ^L" (s_"Update display");
 682   key "q"        (s_"Quit");
 683   key "d s"      (s_"Set update interval");
 684   key "h"        (s_"Help");
 685   key "B"        (s_"toggle block info req/bytes");
 686
 687   (* Sort order. *)
 688   ignore (get_lineno ());
 689   let banner = pad 38 (s_"SORTING") in
 690   attron A.reverse;
 691   mvaddstr (get_lineno ()) 1 banner;
 692   attroff A.reverse;
 693
 694   key "P" (s_"Sort by %CPU");
 695   key "M" (s_"Sort by %MEM");
 696   key "T" (s_"Sort by TIME");
 697   key "N" (s_"Sort by ID");
 698   key "F" (s_"Select sort field");
 699
 700   (* Display modes on right. *)
 701   let banner = pad 39 (s_"DISPLAY MODES") in
 702   attron A.reverse;
 703   mvaddstr header_lineno 40 banner;
 704   attroff A.reverse;
 705
 706   let get_lineno =
 707     let lineno = ref domains_lineno in
 708     fun () -> let i = !lineno in incr lineno; i
 709   in
 710   let key keys description =
 711     let lineno = get_lineno () in
 712     move lineno 40; attron A.bold; addstr keys; attroff A.bold;
 713     move lineno 49; addstr description
 714   in
 715   key "0" (s_"Domains display");
 716   key "1" (s_"Toggle physical CPUs");
 717   key "2" (s_"Toggle network interfaces");
 718   key "3" (s_"Toggle block devices");
 719
 720   (* Update screen and wait for key press. *)
 721   mvaddstr (lines-1) 0
 722     (s_"More help in virt-top(1) man page. Press any key to return.");
 723   refresh ();
 724   ignore (getch ())
 725
 726 and unknown_command k =
 727   print_msg (s_"Unknown command - try 'h' for help");
 728   refresh ();
 729   sleep 1