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