Added support for init files.
virt-top/virt_top.ml
virt-top/virt_top_csv.ml
virt-top/virt_top_main.ml
+virt-top/virt_top_utils.ml
virt-top/virt_top_xml.ml
dnl Process this file with autoconf to produce a configure script.
-AC_INIT(ocaml-libvirt,0.3.2.7)
+AC_INIT(ocaml-libvirt,0.3.2.8)
dnl Check for basic C environment.
AC_PROG_CC
virt_top_csv.cmx: virt_top.cmx ../libvirt/libvirt.cmx
virt_top_main.cmo: virt_top.cmo ../libvirt/libvirt.cmi
virt_top_main.cmx: virt_top.cmx ../libvirt/libvirt.cmx
-virt_top.cmo: ../libvirt/libvirt_version.cmi ../libvirt/libvirt.cmi
-virt_top.cmx: ../libvirt/libvirt_version.cmx ../libvirt/libvirt.cmx
+virt_top.cmo: virt_top_utils.cmo ../libvirt/libvirt_version.cmi \
+ ../libvirt/libvirt.cmi
+virt_top.cmx: virt_top_utils.cmx ../libvirt/libvirt_version.cmx \
+ ../libvirt/libvirt.cmx
virt_top_xml.cmo: virt_top.cmo ../libvirt/libvirt.cmi
virt_top_xml.cmx: virt_top.cmx ../libvirt/libvirt.cmx
pkg_xml_light = @pkg_xml_light@
pkg_csv = @pkg_csv@
-OCAMLCPACKAGES := -package unix,extlib,curses
+OCAMLCPACKAGES := -package unix,extlib,curses,str
-OBJS := virt_top.cmo
+OBJS := virt_top_utils.cmo virt_top.cmo
ifeq ($(pkg_xml_light),yes)
OBJS += virt_top_xml.cmo
OCAMLCPACKAGES := $(OCAMLCPACKAGES),xml-light
.\" ========================================================================
.\"
.IX Title "VIRT-TOP 1"
-.TH VIRT-TOP 1 "2007-08-30" "ocaml-libvirt-0.3.2.6" "Virtualization Support"
+.TH VIRT-TOP 1 "2007-09-24" "ocaml-libvirt-0.3.2.8" "Virtualization Support"
.SH "NAME"
virt\-top \- 'top'\-like utility for virtualization stats
.SH "SUMMARY"
.Ve
.Sp
See also \s-1REPORTING\s0 \s-1BUGS\s0 below.
+.IP "\fB\-\-init\-file filename\fR" 4
+.IX Item "--init-file filename"
+Read \fIfilename\fR as the init file instead of the default which is
+\&\fI$HOME/.virt\-toprc\fR. See also \s-1INIT\s0 \s-1FILE\s0 below.
+.IP "\fB\-\-no\-init\-file\fR" 4
+.IX Item "--no-init-file"
+Do not read any init file.
.IP "\fB\-\-help\fR" 4
.IX Item "--help"
Display usage summary.
.IX Item "F"
Select the sort field interactively (there are other
sort fields you can choose using this key).
+.IP "\fIW\fR" 4
+.IX Item "W"
+This creates or overwrites the init file with the current settings.
+.Sp
+This key is disabled if \fI\-\-no\-init\-file\fR was specified on the
+command line or if \fIoverwrite-init-file false\fR is given in
+the init file.
+.SH "INIT FILE"
+.IX Header "INIT FILE"
+When virt-top starts up, it reads initial settings from the
+file \fI.virt\-toprc\fR in the user's home directory.
+.PP
+The name of this file may be overridden using the \fI\-\-init\-file
+filename\fR command line option or may be disabled entirely using
+\&\fI\-\-no\-init\-file\fR.
+.PP
+The init file has a simple format. Blank lines and comments
+beginning with \fI#\fR are ignored. Everything else is a set of
+\&\fIkey value\fR pairs, described below.
+.IP "\fBdisplay\fR \fItask|pcpu|block|net\fR" 4
+.IX Item "display task|pcpu|block|net"
+Sets the major display mode to one of \fItask\fR (tasks, the
+default), \fIpcpu\fR (physical CPUs), \fIblock\fR (block devices),
+or \fInet\fR (network interfaces).
+.IP "\fBdelay\fR \fIsecs\fR" 4
+.IX Item "delay secs"
+Sets the delay between display updates in seconds.
+.IP "\fBhist-cpu\fR \fIsecs\fR" 4
+.IX Item "hist-cpu secs"
+Sets the historical \s-1CPU\s0 delay in seconds.
+.IP "\fBiterations\fR \fIn\fR" 4
+.IX Item "iterations n"
+Sets the number of iterations to run before we exit. Setting
+this to \fI\-1\fR means to run continuously.
+.IP "\fBsort\fR \fIcpu|mem|time|id|name|...\fR" 4
+.IX Item "sort cpu|mem|time|id|name|..."
+Sets the sort order. The option names are the same as for
+the command line \fI\-o\fR option.
+.IP "\fBconnect\fR \fIuri\fR" 4
+.IX Item "connect uri"
+Sets the default connection \s-1URI\s0.
+.IP "\fBdebug\fR \fIfilename\fR" 4
+.IX Item "debug filename"
+Sets the default filename to use for debug and error messages.
+.IP "\fBcsv\fR \fIfilename\fR" 4
+.IX Item "csv filename"
+Enables \s-1CSV\s0 output to the named file.
+.IP "\fBbatch\fR \fItrue|false\fR" 4
+.IX Item "batch true|false"
+Sets batch mode.
+.IP "\fBsecure\fR \fItrue|false\fR" 4
+.IX Item "secure true|false"
+Sets secure mode.
+.IP "\fBoverwrite-init-file\fR \fIfalse\fR" 4
+.IX Item "overwrite-init-file false"
+If set to \fIfalse\fR then the \fIW\fR key will not overwrite the
+init file.
+.PP
+Note that in the current implementation, options specified in
+the init file override options specified on the command line.
+This is a bug and this behaviour may change in the future.
.SH "SEE ALSO"
.IX Header "SEE ALSO"
\&\fItop\fR\|(1),
See also REPORTING BUGS below.
+=item B<--init-file filename>
+
+Read I<filename> as the init file instead of the default which is
+I<$HOME/.virt-toprc>. See also INIT FILE below.
+
+=item B<--no-init-file>
+
+Do not read any init file.
+
=item B<--help>
Display usage summary.
Select the sort field interactively (there are other
sort fields you can choose using this key).
+=item I<W>
+
+This creates or overwrites the init file with the current settings.
+
+This key is disabled if I<--no-init-file> was specified on the
+command line or if I<overwrite-init-file false> is given in
+the init file.
+
=back
+=head1 INIT FILE
+
+When virt-top starts up, it reads initial settings from the
+file I<.virt-toprc> in the user's home directory.
+
+The name of this file may be overridden using the I<--init-file
+filename> command line option or may be disabled entirely using
+I<--no-init-file>.
+
+The init file has a simple format. Blank lines and comments
+beginning with I<#> are ignored. Everything else is a set of
+I<key value> pairs, described below.
+
+=over 4
+
+=item B<display> I<task|pcpu|block|net>
+
+Sets the major display mode to one of I<task> (tasks, the
+default), I<pcpu> (physical CPUs), I<block> (block devices),
+or I<net> (network interfaces).
+
+=item B<delay> I<secs>
+
+Sets the delay between display updates in seconds.
+
+=item B<hist-cpu> I<secs>
+
+Sets the historical CPU delay in seconds.
+
+=item B<iterations> I<n>
+
+Sets the number of iterations to run before we exit. Setting
+this to I<-1> means to run continuously.
+
+=item B<sort> I<cpu|mem|time|id|name|...>
+
+Sets the sort order. The option names are the same as for
+the command line I<-o> option.
+
+=item B<connect> I<uri>
+
+Sets the default connection URI.
+
+=item B<debug> I<filename>
+
+Sets the default filename to use for debug and error messages.
+
+=item B<csv> I<filename>
+
+Enables CSV output to the named file.
+
+=item B<batch> I<true|false>
+
+Sets batch mode.
+
+=item B<secure> I<true|false>
+
+Sets secure mode.
+
+=item B<overwrite-init-file> I<false>
+
+If set to I<false> then the I<W> key will not overwrite the
+init file.
+
+=back
+
+
+Note that in the current implementation, options specified in
+the init file override options specified on the command line.
+This is a bug and this behaviour may change in the future.
+
=head1 SEE ALSO
L<top(1)>,
See also REPORTING BUGS below.
+ --init-file filename
+ Read *filename* as the init file instead of the default which is
+ *$HOME/.virt-toprc*. See also INIT FILE below.
+
+ --no-init-file
+ Do not read any init file.
+
--help
Display usage summary.
*F* Select the sort field interactively (there are other sort fields you
can choose using this key).
+ *W* This creates or overwrites the init file with the current settings.
+
+ This key is disabled if *--no-init-file* was specified on the
+ command line or if *overwrite-init-file false* is given in the init
+ file.
+
+INIT FILE
+ When virt-top starts up, it reads initial settings from the file
+ *.virt-toprc* in the user's home directory.
+
+ The name of this file may be overridden using the *--init-file filename*
+ command line option or may be disabled entirely using *--no-init-file*.
+
+ The init file has a simple format. Blank lines and comments beginning
+ with *#* are ignored. Everything else is a set of *key value* pairs,
+ described below.
+
+ display *task|pcpu|block|net*
+ Sets the major display mode to one of *task* (tasks, the default),
+ *pcpu* (physical CPUs), *block* (block devices), or *net* (network
+ interfaces).
+
+ delay *secs*
+ Sets the delay between display updates in seconds.
+
+ hist-cpu *secs*
+ Sets the historical CPU delay in seconds.
+
+ iterations *n*
+ Sets the number of iterations to run before we exit. Setting this to
+ *-1* means to run continuously.
+
+ sort *cpu|mem|time|id|name|...*
+ Sets the sort order. The option names are the same as for the
+ command line *-o* option.
+
+ connect *uri*
+ Sets the default connection URI.
+
+ debug *filename*
+ Sets the default filename to use for debug and error messages.
+
+ csv *filename*
+ Enables CSV output to the named file.
+
+ batch *true|false*
+ Sets batch mode.
+
+ secure *true|false*
+ Sets secure mode.
+
+ overwrite-init-file *false*
+ If set to *false* then the *W* key will not overwrite the init file.
+
+ Note that in the current implementation, options specified in the init
+ file override options specified on the command line. This is a bug and
+ this behaviour may change in the future.
+
SEE ALSO
top(1), virsh(1), xm(1), xentop(1), <http://www.libvirt.org/>,
<http://et.redhat.com/~rjones/>, <http://caml.inria.fr/>
open ExtList
open Curses
+open Virt_top_utils
+
module C = Libvirt.Connect
module D = Libvirt.Domain
module N = Libvirt.Network
let ( *^ ) = Int64.mul
let (/^) = Int64.div
+(* Sort order. *)
type sort_order =
| DomainID | DomainName | Processor | Memory | Time
| NetRX | NetTX | BlockRdRq | BlockWrRq
| NetTX -> "Net TX bytes"
| BlockRdRq -> "Block read reqs"
| BlockWrRq -> "Block write reqs"
+let sort_order_of_cli = function
+ | "cpu" | "processor" -> Processor
+ | "mem" | "memory" -> Memory
+ | "time" -> Time
+ | "id" -> DomainID
+ | "name" -> DomainName
+ | "netrx" -> NetRX | "nettx" -> NetTX
+ | "blockrdrq" -> BlockRdRq | "blockwrrq" -> BlockWrRq
+ | str -> failwith (str ^ ": sort order should be: cpu|mem|time|id|name|netrx|nettx|blockrdrq|blockwrrq")
+let cli_of_sort_order = function
+ | Processor -> "cpu"
+ | Memory -> "mem"
+ | Time -> "time"
+ | DomainID -> "id"
+ | DomainName -> "name"
+ | NetRX -> "netrx"
+ | NetTX -> "nettx"
+ | BlockRdRq -> "blockrdrq"
+ | BlockWrRq -> "blockwrrq"
(* Current major display mode: TaskDisplay is the normal display. *)
type display = TaskDisplay | PCPUDisplay | BlockDisplay | NetDisplay
+let display_of_cli = function
+ | "task" -> TaskDisplay
+ | "pcpu" -> PCPUDisplay
+ | "block" -> BlockDisplay
+ | "net" -> NetDisplay
+ | str -> failwith (str ^ ": display should be task|pcpu|block|net")
+let cli_of_display = function
+ | TaskDisplay -> "task"
+ | PCPUDisplay -> "pcpu"
+ | BlockDisplay -> "block"
+ | NetDisplay -> "net"
+
+(* Init file. *)
+type init_file = NoInitFile | DefaultInitFile | InitFile of string
+
(* Settings. *)
let quit = ref false
let delay = ref 3000 (* milliseconds *)
let uri = ref None
let debug_file = ref ""
let csv_enabled = ref false
+let init_file = ref DefaultInitFile
(* Function to read command line arguments and go into curses mode. *)
let start_up () =
failwith "-d: cannot set a negative delay";
delay := int_of_float (newdelay *. 1000.)
and set_uri = function "" -> uri := None | u -> uri := Some u
- and set_sort = function
- | "cpu" | "processor" -> sort_order := Processor
- | "mem" | "memory" -> sort_order := Memory
- | "time" -> sort_order := Time
- | "id" -> sort_order := DomainID
- | "name" -> sort_order := DomainName
- | "netrx" -> sort_order := NetRX | "nettx" -> sort_order := NetTX
- | "blockrdrq" -> sort_order := BlockRdRq
- | "blockwrrq" -> sort_order := BlockWrRq
- | str -> failwith (str ^ ": sort order should be: cpu|mem|time|id|name|netrx|nettx|blockrdrq|blockwrrq")
+ and set_sort order = sort_order := sort_order_of_cli order
and set_pcpu_mode () = display_mode := PCPUDisplay
and set_net_mode () = display_mode := NetDisplay
and set_block_mode () = display_mode := BlockDisplay
and set_csv filename =
(!csv_start) filename;
csv_enabled := true
+ and no_init_file () = init_file := NoInitFile
+ and set_init_file filename = init_file := InitFile filename
in
let argspec = Arg.align [
"-1", Arg.Unit set_pcpu_mode, " Start by displaying pCPUs (default: tasks)";
"-d", Arg.Float set_delay, "delay Delay time interval (seconds)";
"--debug", Arg.Set_string debug_file, "file Send debug messages to file";
"--hist-cpu", Arg.Set_int historical_cpu_delay, "secs Historical CPU delay";
+ "--init-file", Arg.String set_init_file, "file Set name of init file";
+ "--no-init-file", Arg.Unit no_init_file, " Do not read init file";
"-n", Arg.Set_int iterations, "iterations Number of iterations to run";
"-o", Arg.String set_sort, "sort Set sort order (cpu|mem|time|id|name)";
"-s", Arg.Set secure_mode, " Secure (\"kiosk\") mode";
OPTIONS" in
Arg.parse argspec anon_fun usage_msg;
+ (* Read the init file. *)
+ let try_to_read_init_file filename =
+ let config = read_config_file filename in
+ List.iter (
+ function
+ | _, "display", mode -> display_mode := display_of_cli mode
+ | _, "delay", secs -> set_delay (float_of_string secs)
+ | _, "hist-cpu", secs -> historical_cpu_delay := int_of_string secs
+ | _, "iterations", n -> iterations := int_of_string n
+ | _, "sort", order -> set_sort order
+ | _, "connect", uri -> set_uri uri
+ | _, "debug", filename -> debug_file := filename
+ | _, "csv", filename -> set_csv filename
+ | _, "batch", b -> batch_mode := bool_of_string b
+ | _, "secure", b -> secure_mode := bool_of_string b
+ | _, "overwrite-init-file", "false" -> no_init_file ()
+ | lineno, key, _ ->
+ eprintf "%s:%d: configuration item ``%s'' ignored\n%!"
+ filename lineno key
+ ) config
+ in
+ (match !init_file with
+ | NoInitFile -> ()
+ | DefaultInitFile ->
+ let home = try Sys.getenv "HOME" with Not_found -> "/" in
+ let filename = home // ".virt-toprc" in
+ try_to_read_init_file filename
+ | InitFile filename ->
+ try_to_read_init_file filename
+ );
+
(* Connect to the hypervisor before going into curses mode, since
* this is the most likely thing to fail.
*)
else if k = Char.code '1' then toggle_pcpu_display ()
else if k = Char.code '2' then toggle_net_display ()
else if k = Char.code '3' then toggle_block_display ()
+ else if k = Char.code 'W' then write_init_file ()
else unknown_command k
)
| TaskDisplay | NetDisplay -> BlockDisplay
| BlockDisplay -> TaskDisplay
+(* Write an init file. *)
+and write_init_file () =
+ match !init_file with
+ | NoInitFile -> () (* Do nothing if --no-init-file *)
+ | DefaultInitFile ->
+ let home = try Sys.getenv "HOME" with Not_found -> "/" in
+ let filename = home // ".virt-toprc" in
+ _write_init_file filename
+ | InitFile filename ->
+ _write_init_file filename
+
+and _write_init_file filename =
+ try
+ (* Create the new file as filename.new. *)
+ let chan = open_out (filename ^ ".new") in
+
+ let time = Unix.gettimeofday () in
+ let tm = Unix.localtime time in
+ let printable_date_time =
+ sprintf "%04d-%02d-%02d %02d:%02d:%02d"
+ (tm.Unix.tm_year + 1900) (tm.Unix.tm_mon+1) tm.Unix.tm_mday
+ tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec in
+ let username =
+ try
+ let uid = Unix.geteuid () in
+ (Unix.getpwuid uid).Unix.pw_name
+ with
+ Not_found -> "unknown" in
+
+ let fp = fprintf in
+ let nl () = fp chan "\n" in
+ fp chan "# .virt-toprc virt-top configuration file\n";
+ fp chan "# generated on %s by %s\n" printable_date_time username;
+ nl ();
+ fp chan "display %s\n" (cli_of_display !display_mode);
+ fp chan "delay %g\n" (float !delay /. 1000.);
+ fp chan "hist-cpu %d\n" !historical_cpu_delay;
+ if !iterations <> -1 then fp chan "iterations %d\n" !iterations;
+ fp chan "sort %s\n" (cli_of_sort_order !sort_order);
+ (match !uri with
+ | None -> ()
+ | Some uri -> fp chan "connect %s\n" uri
+ );
+ if !batch_mode = true then fp chan "batch true\n";
+ if !secure_mode = true then fp chan "secure true\n";
+ nl ();
+ fp chan "# To send debug and error messages to a file, uncomment next line\n";
+ fp chan "#debug virt-top.out\n";
+ nl ();
+ fp chan "# Enable CSV output to the named file\n";
+ fp chan "#csv virt-top.csv\n";
+ nl ();
+ fp chan "# To protect this file from being overwritten, uncomment next line\n";
+ fp chan "#overwrite-init-file false\n";
+
+ close_out chan;
+
+ (* If the file exists, rename it as filename.old. *)
+ (try Unix.rename filename (filename ^ ".old")
+ with Unix.Unix_error _ -> ());
+
+ (* Rename filename.new to filename. *)
+ Unix.rename (filename ^ ".new") filename;
+
+ print_msg (sprintf "Wrote settings to %s" filename); sleep 2
+ with
+ | Sys_error err -> print_msg "Error: %s"; sleep 2
+ | Unix.Unix_error (err, fn, str) ->
+ print_msg (sprintf "Error: %s %s %s" (Unix.error_message err) fn str);
+ sleep 2
+
and show_help (_, _, _, hostname,
(libvirt_major, libvirt_minor, libvirt_release)) =
clear ();
--- /dev/null
+(* 'top'-like tool for libvirt domains.
+ * $Id: virt_top.ml,v 1.5 2007/08/30 13:52:40 rjones Exp $
+ *)
+
+let (//) = Filename.concat
+
+(* Input a whole file as a list of lines. *)
+let input_all_lines chan =
+ let lines = ref [] in
+ (try
+ while true; do
+ lines := input_line chan :: !lines
+ done
+ with
+ End_of_file -> ());
+ List.rev !lines
+
+(* Trim whitespace from the beginning and end of strings. *)
+let isspace c =
+ c = ' '
+ (* || c = '\f' *) || c = '\n' || c = '\r' || c = '\t' (* || c = '\v' *)
+
+let triml ?(test = isspace) str =
+ let i = ref 0 in
+ let n = ref (String.length str) in
+ while !n > 0 && test str.[!i]; do
+ decr n;
+ incr i
+ done;
+ if !i = 0 then str
+ else String.sub str !i !n
+
+let trimr ?(test = isspace) str =
+ let n = ref (String.length str) in
+ while !n > 0 && test str.[!n-1]; do
+ decr n
+ done;
+ if !n = String.length str then str
+ else String.sub str 0 !n
+
+let trim ?(test = isspace) str =
+ trimr (triml str)
+
+(* Read a configuration file as a list of (key, value) pairs.
+ * If the config file is missing this returns an empty list.
+ *)
+let blanks_and_comments = Str.regexp "^[ \t]*\\(#.*\\)?$"
+
+let read_config_file filename =
+ let lines =
+ try
+ let chan = open_in filename in
+ let lines = input_all_lines chan in
+ close_in chan;
+ lines
+ with
+ Sys_error _ -> [] in (* Ignore errors opening file. *)
+
+ (* Line numbers. *)
+ let lines =
+ let i = ref 0 in List.map (fun line -> (incr i; !i), line) lines in
+
+ (* Remove blank lines and comment lines. *)
+ let lines =
+ List.filter
+ (fun (lineno, line) ->
+ not (Str.string_match blanks_and_comments line 0)) lines in
+
+ (* Convert to key, value pairs. *)
+ List.map (
+ fun (lineno, line) ->
+ let key, value = ExtString.String.split line " " in
+ lineno, trim key, trim value
+ ) lines
git.annexia.org / virt-top.git / commitdiff