X-Git-Url: http://git.annexia.org/?p=virt-top.git;a=blobdiff_plain;f=virt-top%2Fvirt_top.ml;h=121c12ed0fb36b083e6a4661f674949c01623cbb;hp=e2a743588a7f05273658a24d61d22f64274858f1;hb=3d742c162cbcb38663da580f1dff58db992f1a22;hpb=f1f314e84bd2daef18b983eb1c2e10a7614c57bb diff --git a/virt-top/virt_top.ml b/virt-top/virt_top.ml index e2a7435..121c12e 100644 --- a/virt-top/virt_top.ml +++ b/virt-top/virt_top.ml @@ -6,6 +6,8 @@ open Printf open ExtList open Curses +open Virt_top_utils + module C = Libvirt.Connect module D = Libvirt.Domain module N = Libvirt.Network @@ -32,6 +34,7 @@ let (-^) = Int64.sub let ( *^ ) = Int64.mul let (/^) = Int64.div +(* Sort order. *) type sort_order = | DomainID | DomainName | Processor | Memory | Time | NetRX | NetTX | BlockRdRq | BlockWrRq @@ -49,10 +52,44 @@ let printable_sort_order = function | 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 *) @@ -65,6 +102,7 @@ let display_mode = ref TaskDisplay 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 () = @@ -74,22 +112,15 @@ 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)"; @@ -102,6 +133,8 @@ let start_up () = "-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"; @@ -115,6 +148,37 @@ SUMMARY 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. *) @@ -137,6 +201,9 @@ OPTIONS" in let hostname = try C.get_hostname conn with + (* qemu:/// and other URIs didn't support virConnectGetHostname until + * libvirt 0.3.3. Before that they'd throw a virterror. *) + | Libvirt.Virterror _ | Invalid_argument "virConnectGetHostname not supported" -> "unknown" in let libvirt_version = @@ -486,11 +553,18 @@ let redraw, clear_pcpu_display_data = ) ids in (* Inactive domains. *) - let n = C.num_of_defined_domains conn in - let names = - if n > 0 then Array.to_list (C.list_defined_domains conn n) - else [] in - let doms_inactive = List.map (fun name -> name, Inactive) names in + let doms_inactive = + try + let n = C.num_of_defined_domains conn in + let names = + if n > 0 then Array.to_list (C.list_defined_domains conn n) + else [] in + List.map (fun name -> name, Inactive) names + with + (* Ignore transient errors, in particular errors from + * num_of_defined_domains if it cannot contact xend. + *) + | Libvirt.Virterror _ -> [] in doms @ doms_inactive in @@ -1177,6 +1251,7 @@ and get_key_press state = 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 ) @@ -1317,6 +1392,77 @@ and toggle_block_display () = (* key 3 *) | 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 ();