X-Git-Url: http://git.annexia.org/?p=virt-top.git;a=blobdiff_plain;f=src%2Ftop.ml;fp=src%2Ftop.ml;h=204f3b68393753c48477410506e1c0bbc43ecd5c;hp=f50e6a83ffd90d408463f16174274a519430c934;hb=90d14bc151e488972d33eefaac2242d9a6e07578;hpb=3e9ed9c0fe49c3d4e4a8e467d521f676769c485a diff --git a/src/top.ml b/src/top.ml index f50e6a8..204f3b6 100644 --- a/src/top.ml +++ b/src/top.ml @@ -1,5 +1,5 @@ (* 'top'-like tool for libvirt domains. - (C) Copyright 2007-2009 Richard W.M. Jones, Red Hat Inc. + (C) Copyright 2007-2017 Richard W.M. Jones, Red Hat Inc. http://libvirt.org/ This program is free software; you can redistribute it and/or modify @@ -23,6 +23,9 @@ open Curses open Opt_gettext.Gettext open Utils +open Types +open Collect +open Screen module C = Libvirt.Connect module D = Libvirt.Domain @@ -30,21 +33,11 @@ module N = Libvirt.Network let rcfile = ".virt-toprc" -(* Hook for XML support (see [opt_xml.ml]). *) -let parse_device_xml : (int -> [>`R] D.t -> string list * string list) ref = - ref ( - fun _ _ -> [], [] - ) - (* Hooks for CSV support (see [opt_csv.ml]). *) let csv_start : (string -> unit) ref = ref ( fun _ -> failwith (s_"virt-top was compiled without support for CSV files") ) -let csv_write : (string list -> unit) ref = - ref ( - fun _ -> () - ) (* Hook for calendar support (see [opt_calendar.ml]). *) let parse_date_time : (string -> float) ref = @@ -53,62 +46,6 @@ let parse_date_time : (string -> float) ref = failwith (s_"virt-top was compiled without support for dates and times") ) -(* Sort order. *) -type sort_order = - | DomainID | DomainName | Processor | Memory | Time - | NetRX | NetTX | BlockRdRq | BlockWrRq -let all_sort_fields = [ - DomainID; DomainName; Processor; Memory; Time; - NetRX; NetTX; BlockRdRq; BlockWrRq -] -let printable_sort_order = function - | Processor -> s_"%CPU" - | Memory -> s_"%MEM" - | Time -> s_"TIME (CPU time)" - | DomainID -> s_"Domain ID" - | DomainName -> s_"Domain name" - | NetRX -> s_"Net RX bytes" - | NetTX -> s_"Net TX bytes" - | BlockRdRq -> s_"Block read reqs" - | BlockWrRq -> s_"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 -> - failwithf (f_"%s: sort order should be: %s") - str "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 -> - failwithf (f_"%s: display should be %s") str "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 @@ -134,11 +71,6 @@ let script_mode = ref false let stream_mode = ref false let block_in_bytes = ref false -(* Tuple of never-changing data returned by start_up function. *) -type setup = - Libvirt.ro C.t * bool * bool * bool * bool * C.node_info * string * - (int * int * int) - (* Function to read command line arguments and go into curses mode. *) let start_up () = (* Read command line arguments. *) @@ -352,16 +284,6 @@ OPTIONS" in node_info, hostname, libvirt_version (* info that doesn't change *) ) -(* Show a domain state (the 'S' column). *) -let show_state = function - | D.InfoNoState -> '?' - | D.InfoRunning -> 'R' - | D.InfoBlocked -> 'S' - | D.InfoPaused -> 'P' - | D.InfoShutdown -> 'D' - | D.InfoShutoff -> 'O' - | D.InfoCrashed -> 'X' - (* Sleep in seconds. *) let sleep = Unix.sleep @@ -387,1039 +309,33 @@ let get_string maxlen = Not_found -> str (* it is full maxlen bytes *) ) -(* Line numbers. *) -let top_lineno = 0 -let summary_lineno = 1 (* this takes 2 lines *) -let message_lineno = 3 -let header_lineno = 4 -let domains_lineno = 5 - -(* Easier to use versions of curses functions addstr, mvaddstr, etc. *) -let move y x = ignore (move y x) -let refresh () = ignore (refresh ()) -let addch c = ignore (addch (int_of_char c)) -let addstr s = ignore (addstr s) -let mvaddstr y x s = ignore (mvaddstr y x s) - -(* Print in the "message area". *) -let clear_msg () = move message_lineno 0; clrtoeol () -let print_msg str = clear_msg (); mvaddstr message_lineno 0 str - -(* Intermediate "domain + stats" structure that we use to collect - * everything we know about a domain within the collect function. - *) -type rd_domain = Inactive | Active of rd_active -and rd_active = { - rd_domid : int; (* Domain ID. *) - rd_dom : [`R] D.t; (* Domain object. *) - rd_info : D.info; (* Domain CPU info now. *) - rd_block_stats : (string * D.block_stats) list; - (* Domain block stats now. *) - rd_interface_stats : (string * D.interface_stats) list; - (* Domain net stats now. *) - rd_prev_info : D.info option; (* Domain CPU info previously. *) - rd_prev_block_stats : (string * D.block_stats) list; - (* Domain block stats prev. *) - rd_prev_interface_stats : (string * D.interface_stats) list; - (* Domain interface stats prev. *) - (* The following are since the last slice, or 0 if cannot be calculated: *) - rd_cpu_time : float; (* CPU time used in nanoseconds. *) - rd_percent_cpu : float; (* CPU time as percent of total. *) - rd_mem_bytes : int64; (* Memory usage in bytes *) - rd_mem_percent: int64; (* Memory usage as percent of total *) - (* The following are since the last slice, or None if cannot be calc'd: *) - rd_block_rd_reqs : int64 option; (* Number of block device read rqs. *) - rd_block_wr_reqs : int64 option; (* Number of block device write rqs. *) - rd_block_rd_bytes : int64 option; (* Number of bytes block device read *) - rd_block_wr_bytes : int64 option; (* Number of bytes block device write *) - (* _info fields includes the number considering --block_in_bytes option *) - rd_block_rd_info : int64 option; (* Block device read info for user *) - rd_block_wr_info : int64 option; (* Block device read info for user *) - - rd_net_rx_bytes : int64 option; (* Number of bytes received. *) - rd_net_tx_bytes : int64 option; (* Number of bytes transmitted. *) -} - -(* Collect stats. *) -let collect, clear_pcpu_display_data = - (* We cache the list of block devices and interfaces for each domain - * here, so we don't need to reparse the XML each time. - *) - let devices = Hashtbl.create 13 in - - (* Function to get the list of block devices, network interfaces for - * a particular domain. Get it from the devices cache, and if not - * there then parse the domain XML. - *) - let get_devices id dom = - try Hashtbl.find devices id - with Not_found -> - let blkdevs, netifs = (!parse_device_xml) id dom in - Hashtbl.replace devices id (blkdevs, netifs); - blkdevs, netifs - in - - (* We save the state of domains across redraws here, which allows us - * to deduce %CPU usage from the running total. - *) - let last_info = Hashtbl.create 13 in - let last_time = ref (Unix.gettimeofday ()) in - - (* Save pcpu_usages structures across redraws too (only for pCPU display). *) - let last_pcpu_usages = Hashtbl.create 13 in - - let clear_pcpu_display_data () = - (* Clear out pcpu_usages used by PCPUDisplay display_mode - * when we switch back to TaskDisplay mode. - *) - Hashtbl.clear last_pcpu_usages - in - - let collect (conn, _, _, _, _, node_info, _, _) = - (* Number of physical CPUs (some may be disabled). *) - let nr_pcpus = C.maxcpus_of_node_info node_info in - - (* Get the current time. *) - let time = Unix.gettimeofday () in - let tm = Unix.localtime time in - let printable_time = - sprintf "%02d:%02d:%02d" tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec in - - (* What's the total CPU time elapsed since we were last called? (ns) *) - let total_cpu_per_pcpu = 1_000_000_000. *. (time -. !last_time) in - (* Avoid division by zero. *) - let total_cpu_per_pcpu = - if total_cpu_per_pcpu <= 0. then 1. else total_cpu_per_pcpu in - let total_cpu = float node_info.C.cpus *. total_cpu_per_pcpu in - - (* Get the domains. Match up with their last_info (if any). *) - let doms = - (* Active domains. *) - let n = C.num_of_domains conn in - let ids = - if n > 0 then Array.to_list (C.list_domains conn n) - else [] in - let doms = - List.filter_map ( - fun id -> - try - let dom = D.lookup_by_id conn id in - let name = D.get_name dom in - let blkdevs, netifs = get_devices id dom in - - (* Get current CPU, block and network stats. *) - let info = D.get_info dom in - let block_stats = - try List.map (fun dev -> dev, D.block_stats dom dev) blkdevs - with - | Libvirt.Not_supported "virDomainBlockStats" - | Libvirt.Virterror _ -> [] in - let interface_stats = - try List.map (fun dev -> dev, D.interface_stats dom dev) netifs - with - | Libvirt.Not_supported "virDomainInterfaceStats" - | Libvirt.Virterror _ -> [] in - - let prev_info, prev_block_stats, prev_interface_stats = - try - let prev_info, prev_block_stats, prev_interface_stats = - Hashtbl.find last_info id in - Some prev_info, prev_block_stats, prev_interface_stats - with Not_found -> None, [], [] in - - Some (name, Active { - rd_domid = id; rd_dom = dom; rd_info = info; - rd_block_stats = block_stats; - rd_interface_stats = interface_stats; - rd_prev_info = prev_info; - rd_prev_block_stats = prev_block_stats; - rd_prev_interface_stats = prev_interface_stats; - rd_cpu_time = 0.; rd_percent_cpu = 0.; - rd_mem_bytes = 0L; rd_mem_percent = 0L; - rd_block_rd_reqs = None; rd_block_wr_reqs = None; - rd_block_rd_bytes = None; rd_block_wr_bytes = None; - rd_block_rd_info = None; rd_block_wr_info = None; - rd_net_rx_bytes = None; rd_net_tx_bytes = None; - }) - with - Libvirt.Virterror _ -> None (* ignore transient error *) - ) ids in - - (* Inactive domains. *) - 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 - - (* Calculate the CPU time (ns) and %CPU used by each domain. *) - let doms = - List.map ( - function - (* We have previous CPU info from which to calculate it? *) - | name, Active ({ rd_prev_info = Some prev_info } as rd) -> - let cpu_time = - Int64.to_float (rd.rd_info.D.cpu_time -^ prev_info.D.cpu_time) in - let percent_cpu = 100. *. cpu_time /. total_cpu in - let mem_usage = rd.rd_info.D.memory in - let mem_percent = - 100L *^ rd.rd_info.D.memory /^ node_info.C.memory in - let rd = { rd with - rd_cpu_time = cpu_time; - rd_percent_cpu = percent_cpu; - rd_mem_bytes = mem_usage; - rd_mem_percent = mem_percent} in - name, Active rd - (* For all other domains we can't calculate it, so leave as 0 *) - | rd -> rd - ) doms in - - (* Calculate the number of block device read/write requests across - * all block devices attached to a domain. - *) - let doms = - List.map ( - function - (* Do we have stats from the previous slice? *) - | name, Active ({ rd_prev_block_stats = ((_::_) as prev_block_stats) } - as rd) -> - let block_stats = rd.rd_block_stats in (* stats now *) - - (* Add all the devices together. Throw away device names. *) - let prev_block_stats = - sum_block_stats (List.map snd prev_block_stats) in - let block_stats = - sum_block_stats (List.map snd block_stats) in - - (* Calculate increase in read & write requests. *) - let read_reqs = - block_stats.D.rd_req -^ prev_block_stats.D.rd_req in - let write_reqs = - block_stats.D.wr_req -^ prev_block_stats.D.wr_req in - let read_bytes = - block_stats.D.rd_bytes -^ prev_block_stats.D.rd_bytes in - let write_bytes = - block_stats.D.wr_bytes -^ prev_block_stats.D.wr_bytes in - - let rd = { rd with - rd_block_rd_reqs = Some read_reqs; - rd_block_wr_reqs = Some write_reqs; - rd_block_rd_bytes = Some read_bytes; - rd_block_wr_bytes = Some write_bytes; - } in - let rd = { rd with - rd_block_rd_info = if !block_in_bytes then - rd.rd_block_rd_bytes else rd.rd_block_rd_reqs; - rd_block_wr_info = if !block_in_bytes then - rd.rd_block_wr_bytes else rd.rd_block_wr_reqs; - } in - name, Active rd - (* For all other domains we can't calculate it, so leave as None. *) - | rd -> rd - ) doms in - - (* Calculate the same as above for network interfaces across - * all network interfaces attached to a domain. - *) - let doms = - List.map ( - function - (* Do we have stats from the previous slice? *) - | name, Active ({ rd_prev_interface_stats = - ((_::_) as prev_interface_stats) } - as rd) -> - let interface_stats = rd.rd_interface_stats in (* stats now *) - - (* Add all the devices together. Throw away device names. *) - let prev_interface_stats = - sum_interface_stats (List.map snd prev_interface_stats) in - let interface_stats = - sum_interface_stats (List.map snd interface_stats) in - - (* Calculate increase in rx & tx bytes. *) - let rx_bytes = - interface_stats.D.rx_bytes -^ prev_interface_stats.D.rx_bytes in - let tx_bytes = - interface_stats.D.tx_bytes -^ prev_interface_stats.D.tx_bytes in - - let rd = { rd with - rd_net_rx_bytes = Some rx_bytes; - rd_net_tx_bytes = Some tx_bytes } in - name, Active rd - (* For all other domains we can't calculate it, so leave as None. *) - | rd -> rd - ) doms in - - (* Collect some extra information in PCPUDisplay display_mode. *) - let pcpu_display = - if !display_mode = PCPUDisplay then ( - (* Get the VCPU info and VCPU->PCPU mappings for active domains. - * Also cull some data we don't care about. - *) - let doms = List.filter_map ( - function - | (name, Active rd) -> - (try - let domid = rd.rd_domid in - let maplen = C.cpumaplen nr_pcpus in - let cpu_stats = D.get_cpu_stats rd.rd_dom in - - (* Note the terminology is confusing. - * - * In libvirt, cpu_time is the total time (hypervisor + vCPU). - * vcpu_time is the time only taken by the vCPU, - * excluding time taken inside the hypervisor. - * - * For each pCPU, libvirt may return either "cpu_time" - * or "vcpu_time" or neither or both. This function - * returns an array pair [|cpu_time, vcpu_time|]; - * if either is missing it is returned as 0. - *) - let find_cpu_usages params = - let rec find_uint64_field name = function - | (n, D.TypedFieldUInt64 usage) :: _ when n = name -> usage - | _ :: params -> find_uint64_field name params - | [] -> 0L - in - [| find_uint64_field "cpu_time" params; - find_uint64_field "vcpu_time" params |] - in - - let pcpu_usages = Array.map find_cpu_usages cpu_stats in - let maxinfo = rd.rd_info.D.nr_virt_cpu in - let nr_vcpus, vcpu_infos, cpumaps = - D.get_vcpus rd.rd_dom maxinfo maplen in - - (* Got previous pcpu_usages for this domain? *) - let prev_pcpu_usages = - try Some (Hashtbl.find last_pcpu_usages domid) - with Not_found -> None in - (* Update last_pcpu_usages. *) - Hashtbl.replace last_pcpu_usages domid pcpu_usages; - - (match prev_pcpu_usages with - | Some prev_pcpu_usages - when Array.length prev_pcpu_usages = Array.length pcpu_usages -> - Some (domid, name, nr_vcpus, vcpu_infos, pcpu_usages, - prev_pcpu_usages, cpumaps, maplen) - | _ -> None (* ignore missing / unequal length prev_vcpu_infos *) - ); - with - Libvirt.Virterror _ -> None(* ignore transient libvirt errs *) - ) - | (_, Inactive) -> None (* ignore inactive doms *) - ) doms in - let nr_doms = List.length doms in - - (* Rearrange the data into a matrix. Major axis (down) is - * pCPUs. Minor axis (right) is domains. At each node we store: - * cpu_time hypervisor + domain (on this pCPU only, nanosecs), - * vcpu_time domain only (on this pCPU only, nanosecs). - *) - let make_3d_array dimx dimy dimz e = - Array.init dimx (fun _ -> Array.make_matrix dimy dimz e) - in - let pcpus = make_3d_array nr_pcpus nr_doms 2 0L in - - List.iteri ( - fun di (domid, name, nr_vcpus, vcpu_infos, pcpu_usages, - prev_pcpu_usages, cpumaps, maplen) -> - (* Which pCPUs can this dom run on? *) - for p = 0 to Array.length pcpu_usages - 1 do - pcpus.(p).(di).(0) <- - pcpu_usages.(p).(0) -^ prev_pcpu_usages.(p).(0); - pcpus.(p).(di).(1) <- - pcpu_usages.(p).(1) -^ prev_pcpu_usages.(p).(1) - done - ) doms; - - (* Sum the total CPU time used by each pCPU, for the %CPU column. *) - let pcpus_cpu_time = Array.map ( - fun row -> - let cpu_time = ref 0L in - for di = 0 to Array.length row-1 do - let t = row.(di).(0) in - cpu_time := !cpu_time +^ t - done; - Int64.to_float !cpu_time - ) pcpus in - - Some (doms, pcpus, pcpus_cpu_time) - ) else - None in - - (* Calculate totals. *) - let totals = List.fold_left ( - fun (count, running, blocked, paused, shutdown, shutoff, - crashed, active, inactive, - total_cpu_time, total_memory, total_domU_memory) -> - function - | (name, Active rd) -> - let test state orig = - if rd.rd_info.D.state = state then orig+1 else orig - in - let running = test D.InfoRunning running in - let blocked = test D.InfoBlocked blocked in - let paused = test D.InfoPaused paused in - let shutdown = test D.InfoShutdown shutdown in - let shutoff = test D.InfoShutoff shutoff in - let crashed = test D.InfoCrashed crashed in - - let total_cpu_time = total_cpu_time +. rd.rd_cpu_time in - let total_memory = total_memory +^ rd.rd_info.D.memory in - let total_domU_memory = total_domU_memory +^ - if rd.rd_domid > 0 then rd.rd_info.D.memory else 0L in - - (count+1, running, blocked, paused, shutdown, shutoff, - crashed, active+1, inactive, - total_cpu_time, total_memory, total_domU_memory) - - | (name, Inactive) -> (* inactive domain *) - (count+1, running, blocked, paused, shutdown, shutoff, - crashed, active, inactive+1, - total_cpu_time, total_memory, total_domU_memory) - ) (0,0,0,0,0,0,0,0,0, 0.,0L,0L) doms in - - (* Update last_time, last_info. *) - last_time := time; - Hashtbl.clear last_info; - List.iter ( - function - | (_, Active rd) -> - let info = rd.rd_info, rd.rd_block_stats, rd.rd_interface_stats in - Hashtbl.add last_info rd.rd_domid info - | _ -> () - ) doms; - - (doms, - time, printable_time, - nr_pcpus, total_cpu, total_cpu_per_pcpu, - totals, - pcpu_display) - in - - collect, clear_pcpu_display_data - -(* Redraw the display. *) -let redraw = - (* Keep a historical list of %CPU usages. *) - let historical_cpu = ref [] in - let historical_cpu_last_time = ref (Unix.gettimeofday ()) in - fun - (_, _, _, _, _, node_info, _, _) (* setup *) - (doms, - time, printable_time, - nr_pcpus, total_cpu, total_cpu_per_pcpu, - totals, - pcpu_display) (* state *) -> - clear (); - - (* Get the screen/window size. *) - let lines, cols = get_size () in - - (* Time. *) - mvaddstr top_lineno 0 (sprintf "virt-top %s - " printable_time); - - (* Basic node_info. *) - addstr - (sprintf "%s %d/%dCPU %dMHz %LdMB " - node_info.C.model node_info.C.cpus nr_pcpus node_info.C.mhz - (node_info.C.memory /^ 1024L)); - (* Save the cursor position for when we come to draw the - * historical CPU times (down in this function). - *) - let stdscr = stdscr () in - let historical_cursor = getyx stdscr in - - (match !display_mode with - | TaskDisplay -> (*---------- Showing domains ----------*) - (* Sort domains on current sort_order. *) - let doms = - let cmp = - match !sort_order with - | DomainName -> - (fun _ -> 0) (* fallthrough to default name compare *) - | Processor -> - (function - | Active rd1, Active rd2 -> - compare rd2.rd_percent_cpu rd1.rd_percent_cpu - | Active _, Inactive -> -1 - | Inactive, Active _ -> 1 - | Inactive, Inactive -> 0) - | Memory -> - (function - | Active { rd_info = info1 }, Active { rd_info = info2 } -> - compare info2.D.memory info1.D.memory - | Active _, Inactive -> -1 - | Inactive, Active _ -> 1 - | Inactive, Inactive -> 0) - | Time -> - (function - | Active { rd_info = info1 }, Active { rd_info = info2 } -> - compare info2.D.cpu_time info1.D.cpu_time - | Active _, Inactive -> -1 - | Inactive, Active _ -> 1 - | Inactive, Inactive -> 0) - | DomainID -> - (function - | Active { rd_domid = id1 }, Active { rd_domid = id2 } -> - compare id1 id2 - | Active _, Inactive -> -1 - | Inactive, Active _ -> 1 - | Inactive, Inactive -> 0) - | NetRX -> - (function - | Active { rd_net_rx_bytes = r1 }, Active { rd_net_rx_bytes = r2 } -> - compare r2 r1 - | Active _, Inactive -> -1 - | Inactive, Active _ -> 1 - | Inactive, Inactive -> 0) - | NetTX -> - (function - | Active { rd_net_tx_bytes = r1 }, Active { rd_net_tx_bytes = r2 } -> - compare r2 r1 - | Active _, Inactive -> -1 - | Inactive, Active _ -> 1 - | Inactive, Inactive -> 0) - | BlockRdRq -> - (function - | Active { rd_block_rd_reqs = r1 }, Active { rd_block_rd_reqs = r2 } -> - compare r2 r1 - | Active _, Inactive -> -1 - | Inactive, Active _ -> 1 - | Inactive, Inactive -> 0) - | BlockWrRq -> - (function - | Active { rd_block_wr_reqs = r1 }, Active { rd_block_wr_reqs = r2 } -> - compare r2 r1 - | Active _, Inactive -> -1 - | Inactive, Active _ -> 1 - | Inactive, Inactive -> 0) - in - let cmp (name1, dom1) (name2, dom2) = - let r = cmp (dom1, dom2) in - if r <> 0 then r - else compare name1 name2 - in - List.sort ~cmp doms in - - (* Print domains. *) - attron A.reverse; - let header_string = if !block_in_bytes - then " ID S RDBY WRBY RXBY TXBY %CPU %MEM TIME NAME" - else " ID S RDRQ WRRQ RXBY TXBY %CPU %MEM TIME NAME" - in - mvaddstr header_lineno 0 - (pad cols header_string); - attroff A.reverse; - - let rec loop lineno = function - | [] -> () - | (name, Active rd) :: doms -> - if lineno < lines then ( - let state = show_state rd.rd_info.D.state in - let rd_req = Show.int64_option rd.rd_block_rd_info in - let wr_req = Show.int64_option rd.rd_block_wr_info in - let rx_bytes = Show.int64_option rd.rd_net_rx_bytes in - let tx_bytes = Show.int64_option rd.rd_net_tx_bytes in - let percent_cpu = Show.percent rd.rd_percent_cpu in - let percent_mem = Int64.to_float rd.rd_mem_percent in - let percent_mem = Show.percent percent_mem in - let time = Show.time rd.rd_info.D.cpu_time in - - let line = sprintf "%5d %c %s %s %s %s %s %s %s %s" - rd.rd_domid state rd_req wr_req rx_bytes tx_bytes - percent_cpu percent_mem time name in - let line = pad cols line in - mvaddstr lineno 0 line; - loop (lineno+1) doms - ) - | (name, Inactive) :: doms -> (* inactive domain *) - if lineno < lines then ( - let line = - sprintf - " - (%s)" - name in - let line = pad cols line in - mvaddstr lineno 0 line; - loop (lineno+1) doms - ) - in - loop domains_lineno doms - - | PCPUDisplay -> (*---------- Showing physical CPUs ----------*) - let doms, pcpus, pcpus_cpu_time = - match pcpu_display with - | Some p -> p - | None -> failwith "internal error: no pcpu_display data" in - - (* Display the pCPUs. *) - let dom_names = - String.concat "" ( - List.map ( - fun (_, name, _, _, _, _, _, _) -> - let len = String.length name in - let width = max (len+1) 12 in - pad width name - ) doms - ) in - attron A.reverse; - mvaddstr header_lineno 0 (pad cols ("PHYCPU %CPU " ^ dom_names)); - attroff A.reverse; - - Array.iteri ( - fun p row -> - mvaddstr (p+domains_lineno) 0 (sprintf "%4d " p); - let cpu_time = pcpus_cpu_time.(p) in (* ns used on this CPU *) - let percent_cpu = 100. *. cpu_time /. total_cpu_per_pcpu in - addstr (Show.percent percent_cpu); - addch ' '; - - List.iteri ( - fun di (domid, name, _, _, _, _, _, _) -> - let t = pcpus.(p).(di).(0) in (* hypervisor + domain *) - let t_only = pcpus.(p).(di).(1) in (* domain only *) - let len = String.length name in - let width = max (len+1) 12 in - let str_t = - if t <= 0L then "" - else ( - let t = Int64.to_float t in - let percent = 100. *. t /. total_cpu_per_pcpu in - Show.percent percent - ) in - let str_t_only = - if t_only <= 0L then "" - else ( - let t_only = Int64.to_float t_only in - let percent = 100. *. t_only /. total_cpu_per_pcpu in - Show.percent percent - ) in - addstr (pad 5 str_t); - addstr (pad 5 str_t_only); - addstr (pad (width-10) " "); - () - ) doms - ) pcpus; - - | NetDisplay -> (*---------- Showing network interfaces ----------*) - (* Only care about active domains. *) - let doms = List.filter_map ( - function - | (name, Active rd) -> Some (name, rd) - | (_, Inactive) -> None - ) doms in - - (* For each domain we have a list of network interfaces seen - * this slice, and seen in the previous slice, which we now - * match up to get a list of (domain, interface) for which - * we have current & previous knowledge. (And ignore the rest). - *) - let devs = - List.map ( - fun (name, rd) -> - List.filter_map ( - fun (dev, stats) -> - try - (* Have prev slice stats for this device? *) - let prev_stats = - List.assoc dev rd.rd_prev_interface_stats in - Some (dev, name, rd, stats, prev_stats) - with Not_found -> None - ) rd.rd_interface_stats - ) doms in - - (* Finally we have a list of: - * device name, domain name, rd_* stuff, curr stats, prev stats. - *) - let devs : (string * string * rd_active * - D.interface_stats * D.interface_stats) list = - List.flatten devs in - - (* Difference curr slice & prev slice. *) - let devs = List.map ( - fun (dev, name, rd, curr, prev) -> - dev, name, rd, diff_interface_stats curr prev - ) devs in - - (* Sort by current sort order, but map some of the standard - * sort orders into ones which makes sense here. - *) - let devs = - let cmp = - match !sort_order with - | DomainName -> - (fun _ -> 0) (* fallthrough to default name compare *) - | DomainID -> - (fun (_, { rd_domid = id1 }, _, { rd_domid = id2 }) -> - compare id1 id2) - | Processor | Memory | Time | BlockRdRq | BlockWrRq - (* fallthrough to RXBY comparison. *) - | NetRX -> - (fun ({ D.rx_bytes = b1 }, _, { D.rx_bytes = b2 }, _) -> - compare b2 b1) - | NetTX -> - (fun ({ D.tx_bytes = b1 }, _, { D.tx_bytes = b2 }, _) -> - compare b2 b1) - in - let cmp (dev1, name1, rd1, stats1) (dev2, name2, rd2, stats2) = - let r = cmp (stats1, rd1, stats2, rd2) in - if r <> 0 then r - else compare (dev1, name1) (dev2, name2) - in - List.sort ~cmp devs in - - (* Print the header for network devices. *) - attron A.reverse; - mvaddstr header_lineno 0 - (pad cols " ID S RXBY TXBY RXPK TXPK DOMAIN INTERFACE"); - attroff A.reverse; - - (* Print domains and devices. *) - let rec loop lineno = function - | [] -> () - | (dev, name, rd, stats) :: devs -> - if lineno < lines then ( - let state = show_state rd.rd_info.D.state in - let rx_bytes = - if stats.D.rx_bytes >= 0L - then Show.int64 stats.D.rx_bytes - else " " in - let tx_bytes = - if stats.D.tx_bytes >= 0L - then Show.int64 stats.D.tx_bytes - else " " in - let rx_packets = - if stats.D.rx_packets >= 0L - then Show.int64 stats.D.rx_packets - else " " in - let tx_packets = - if stats.D.tx_packets >= 0L - then Show.int64 stats.D.tx_packets - else " " in - - let line = sprintf "%5d %c %s %s %s %s %-12s %s" - rd.rd_domid state - rx_bytes tx_bytes - rx_packets tx_packets - (pad 12 name) dev in - let line = pad cols line in - mvaddstr lineno 0 line; - loop (lineno+1) devs - ) - in - loop domains_lineno devs - - | BlockDisplay -> (*---------- Showing block devices ----------*) - (* Only care about active domains. *) - let doms = List.filter_map ( - function - | (name, Active rd) -> Some (name, rd) - | (_, Inactive) -> None - ) doms in - - (* For each domain we have a list of block devices seen - * this slice, and seen in the previous slice, which we now - * match up to get a list of (domain, device) for which - * we have current & previous knowledge. (And ignore the rest). - *) - let devs = - List.map ( - fun (name, rd) -> - List.filter_map ( - fun (dev, stats) -> - try - (* Have prev slice stats for this device? *) - let prev_stats = - List.assoc dev rd.rd_prev_block_stats in - Some (dev, name, rd, stats, prev_stats) - with Not_found -> None - ) rd.rd_block_stats - ) doms in - - (* Finally we have a list of: - * device name, domain name, rd_* stuff, curr stats, prev stats. - *) - let devs : (string * string * rd_active * - D.block_stats * D.block_stats) list = - List.flatten devs in - - (* Difference curr slice & prev slice. *) - let devs = List.map ( - fun (dev, name, rd, curr, prev) -> - dev, name, rd, diff_block_stats curr prev - ) devs in - - (* Sort by current sort order, but map some of the standard - * sort orders into ones which makes sense here. - *) - let devs = - let cmp = - match !sort_order with - | DomainName -> - (fun _ -> 0) (* fallthrough to default name compare *) - | DomainID -> - (fun (_, { rd_domid = id1 }, _, { rd_domid = id2 }) -> - compare id1 id2) - | Processor | Memory | Time | NetRX | NetTX - (* fallthrough to RDRQ comparison. *) - | BlockRdRq -> - (fun ({ D.rd_req = b1 }, _, { D.rd_req = b2 }, _) -> - compare b2 b1) - | BlockWrRq -> - (fun ({ D.wr_req = b1 }, _, { D.wr_req = b2 }, _) -> - compare b2 b1) - in - let cmp (dev1, name1, rd1, stats1) (dev2, name2, rd2, stats2) = - let r = cmp (stats1, rd1, stats2, rd2) in - if r <> 0 then r - else compare (dev1, name1) (dev2, name2) - in - List.sort ~cmp devs in - - (* Print the header for block devices. *) - attron A.reverse; - mvaddstr header_lineno 0 - (pad cols " ID S RDBY WRBY RDRQ WRRQ DOMAIN DEVICE"); - attroff A.reverse; - - (* Print domains and devices. *) - let rec loop lineno = function - | [] -> () - | (dev, name, rd, stats) :: devs -> - if lineno < lines then ( - let state = show_state rd.rd_info.D.state in - let rd_bytes = - if stats.D.rd_bytes >= 0L - then Show.int64 stats.D.rd_bytes - else " " in - let wr_bytes = - if stats.D.wr_bytes >= 0L - then Show.int64 stats.D.wr_bytes - else " " in - let rd_req = - if stats.D.rd_req >= 0L - then Show.int64 stats.D.rd_req - else " " in - let wr_req = - if stats.D.wr_req >= 0L - then Show.int64 stats.D.wr_req - else " " in - - let line = sprintf "%5d %c %s %s %s %s %-12s %s" - rd.rd_domid state - rd_bytes wr_bytes - rd_req wr_req - (pad 12 name) dev in - let line = pad cols line in - mvaddstr lineno 0 line; - loop (lineno+1) devs - ) - in - loop domains_lineno devs - ); (* end of display_mode conditional section *) - - let (count, running, blocked, paused, shutdown, shutoff, - crashed, active, inactive, - total_cpu_time, total_memory, total_domU_memory) = totals in - - mvaddstr summary_lineno 0 - (sprintf - (f_"%d domains, %d active, %d running, %d sleeping, %d paused, %d inactive D:%d O:%d X:%d") - count active running blocked paused inactive shutdown shutoff crashed); - - (* Total %CPU used, and memory summary. *) - let percent_cpu = 100. *. total_cpu_time /. total_cpu in - mvaddstr (summary_lineno+1) 0 - (sprintf - (f_"CPU: %2.1f%% Mem: %Ld MB (%Ld MB by guests)") - percent_cpu (total_memory /^ 1024L) (total_domU_memory /^ 1024L)); - - (* Time to grab another historical %CPU for the list? *) - if time >= !historical_cpu_last_time +. float !historical_cpu_delay - then ( - historical_cpu := percent_cpu :: List.take 10 !historical_cpu; - historical_cpu_last_time := time - ); - - (* Display historical CPU time. *) - let () = - let y, x = historical_cursor in - let maxwidth = cols - x in - let line = - String.concat " " - (List.map (sprintf "%2.1f%%") !historical_cpu) in - let line = pad maxwidth line in - mvaddstr y x line; - () in - - move message_lineno 0; (* Park cursor in message area, as with top. *) - refresh () (* Refresh the display. *) - -(* Write CSV header row. *) -let write_csv_header () = - (!csv_write) ( - [ "Hostname"; "Time"; "Arch"; "Physical CPUs"; - "Count"; "Running"; "Blocked"; "Paused"; "Shutdown"; - "Shutoff"; "Crashed"; "Active"; "Inactive"; - "%CPU"; - "Total hardware memory (KB)"; - "Total memory (KB)"; "Total guest memory (KB)"; - "Total CPU time (ns)" ] @ - (* These fields are repeated for each domain: *) - [ "Domain ID"; "Domain name"; ] @ - (if !csv_cpu then [ "CPU (ns)"; "%CPU"; ] else []) @ - (if !csv_mem then [ "Mem (bytes)"; "%Mem";] else []) @ - (if !csv_block && not !block_in_bytes - then [ "Block RDRQ"; "Block WRRQ"; ] else []) @ - (if !csv_block && !block_in_bytes - then [ "Block RDBY"; "Block WRBY"; ] else []) @ - (if !csv_net then [ "Net RXBY"; "Net TXBY" ] else []) - ) - -(* Write summary data to CSV file. *) -let append_csv - (_, _, _, _, _, node_info, hostname, _) (* setup *) - (doms, - _, printable_time, - nr_pcpus, total_cpu, _, - totals, - _) (* state *) = - - (* The totals / summary fields. *) - let (count, running, blocked, paused, shutdown, shutoff, - crashed, active, inactive, - total_cpu_time, total_memory, total_domU_memory) = totals in - - let percent_cpu = 100. *. total_cpu_time /. total_cpu in - - let summary_fields = [ - hostname; printable_time; node_info.C.model; string_of_int nr_pcpus; - string_of_int count; string_of_int running; string_of_int blocked; - string_of_int paused; string_of_int shutdown; string_of_int shutoff; - string_of_int crashed; string_of_int active; string_of_int inactive; - sprintf "%2.1f" percent_cpu; - Int64.to_string node_info.C.memory; - Int64.to_string total_memory; Int64.to_string total_domU_memory; - Int64.to_string (Int64.of_float total_cpu_time) - ] in - - (* The domains. - * - * Sort them by ID so that the list of relatively stable. Ignore - * inactive domains. - *) - let doms = List.filter_map ( - function - | _, Inactive -> None (* Ignore inactive domains. *) - | name, Active rd -> Some (name, rd) - ) doms in - let cmp (_, { rd_domid = rd_domid1 }) (_, { rd_domid = rd_domid2 }) = - compare rd_domid1 rd_domid2 - in - let doms = List.sort ~cmp doms in - - let string_of_int64_option = Option.map_default Int64.to_string "" in - - let domain_fields = List.map ( - fun (domname, rd) -> - [ string_of_int rd.rd_domid; domname ] @ - (if !csv_cpu then [ - string_of_float rd.rd_cpu_time; string_of_float rd.rd_percent_cpu - ] else []) @ - (if !csv_mem then [ - Int64.to_string rd.rd_mem_bytes; Int64.to_string rd.rd_mem_percent - ] else []) @ - (if !csv_block then [ - string_of_int64_option rd.rd_block_rd_info; - string_of_int64_option rd.rd_block_wr_info; - ] else []) @ - (if !csv_net then [ - string_of_int64_option rd.rd_net_rx_bytes; - string_of_int64_option rd.rd_net_tx_bytes; - ] else []) - ) doms in - let domain_fields = List.flatten domain_fields in - - (!csv_write) (summary_fields @ domain_fields) - -let dump_stdout - (_, _, _, _, _, node_info, hostname, _) (* setup *) - (doms, - _, printable_time, - nr_pcpus, total_cpu, _, - totals, - _) (* state *) = - - (* Header for this iteration *) - printf "virt-top time %s Host %s %s %d/%dCPU %dMHz %LdMB \n" - printable_time hostname node_info.C.model node_info.C.cpus nr_pcpus - node_info.C.mhz (node_info.C.memory /^ 1024L); - (* dump domain information one by one *) - let rd, wr = if !block_in_bytes then "RDBY", "WRBY" else "RDRQ", "WRRQ" - in - printf " ID S %s %s RXBY TXBY %%CPU %%MEM TIME NAME\n" rd wr; - - (* sort by ID *) - let doms = - let compare = - (function - | Active {rd_domid = id1 }, Active {rd_domid = id2} -> - compare id1 id2 - | Active _, Inactive -> -1 - | Inactive, Active _ -> 1 - | Inactive, Inactive -> 0) - in - let cmp (name1, dom1) (name2, dom2) = compare(dom1, dom2) in - List.sort ~cmp doms in - (*Print domains *) - let dump_domain = fun name rd - -> begin - let state = show_state rd.rd_info.D.state in - let rd_req = if rd.rd_block_rd_info = None then " 0" - else Show.int64_option rd.rd_block_rd_info in - let wr_req = if rd.rd_block_wr_info = None then " 0" - else Show.int64_option rd.rd_block_wr_info in - let rx_bytes = if rd.rd_net_rx_bytes = None then " 0" - else Show.int64_option rd.rd_net_rx_bytes in - let tx_bytes = if rd.rd_net_tx_bytes = None then " 0" - else Show.int64_option rd.rd_net_tx_bytes in - let percent_cpu = Show.percent rd.rd_percent_cpu in - let percent_mem = Int64.to_float rd.rd_mem_percent in - let percent_mem = Show.percent percent_mem in - let time = Show.time rd.rd_info.D.cpu_time in - printf "%5d %c %s %s %s %s %s %s %s %s\n" - rd.rd_domid state rd_req wr_req rx_bytes tx_bytes - percent_cpu percent_mem time name; - end - in - List.iter ( - function - | name, Active dom -> dump_domain name dom - | name, Inactive -> () - ) doms; - flush stdout - (* Main loop. *) let rec main_loop ((_, batch_mode, script_mode, csv_enabled, stream_mode, _, _, _) as setup) = - if csv_enabled then write_csv_header (); + let csv_flags = !csv_cpu, !csv_mem, !csv_block, !csv_net in + + if csv_enabled then + Csv_output.write_csv_header csv_flags !block_in_bytes; while not !quit do - let state = collect setup in (* Collect stats. *) + (* Collect stats. *) + let state = collect setup !block_in_bytes in + let pcpu_display = + if !display_mode = PCPUDisplay then Some (collect_pcpu state) + else None in (* Redraw display. *) - if not script_mode && not stream_mode then redraw setup state; - if csv_enabled then append_csv setup state; (* Update CSV file. *) - if stream_mode then dump_stdout setup state; (* dump to stdout *) + if not script_mode && not stream_mode then + Redraw.redraw !display_mode !sort_order + setup !block_in_bytes !historical_cpu_delay + state pcpu_display; + + (* Update CSV file. *) + if csv_enabled then + Csv_output.append_csv setup csv_flags state; + + (* Append to stream output file. *) + if stream_mode then + Stream_output.append_stream setup !block_in_bytes state; (* Clear up unused virDomainPtr objects. *) Gc.compact (); @@ -1440,11 +356,10 @@ let rec main_loop ((_, batch_mode, script_mode, csv_enabled, stream_mode, _, _, (* No --end-time option, so use the current delay. *) !delay | Some end_time -> - let (_, time, _, _, _, _, _, _) = state in let delay_secs = float !delay /. 1000. in - if end_time <= time +. delay_secs then ( + if end_time <= state.rd_time +. delay_secs then ( quit := true; - let delay = int_of_float (1000. *. (end_time -. time)) in + let delay = int_of_float (1000. *. (end_time -. state.rd_time)) in if delay >= 0 then delay else 0 ) else !delay in