X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=src%2Fcollect.ml;h=a1e50a10b3d2b20ea14b3beb25d7590b4cfbbae3;hb=9c8d3ba8382df450392a8c78ab45fc263742096c;hp=f856067230cc1958e26723a145b8bb69d6d09410;hpb=90d14bc151e488972d33eefaac2242d9a6e07578;p=virt-top.git diff --git a/src/collect.ml b/src/collect.ml index f856067..a1e50a1 100644 --- a/src/collect.ml +++ b/src/collect.ml @@ -38,6 +38,7 @@ let parse_device_xml : (int -> [>`R] D.t -> string list * string list) ref = type rd_domain = Inactive | Active of rd_active and rd_active = { rd_domid : int; (* Domain ID. *) + rd_domuuid : Libvirt.uuid; (* Domain UUID. *) rd_dom : [`R] D.t; (* Domain object. *) rd_info : D.info; (* Domain CPU info now. *) rd_block_stats : (string * D.block_stats) list; @@ -57,12 +58,8 @@ and rd_active = { (* 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_block_rd_bytes : int64 option; (* Number of bytes block device read *) + rd_block_wr_bytes : int64 option; (* Number of bytes block device write *) rd_net_rx_bytes : int64 option; (* Number of bytes received. *) rd_net_tx_bytes : int64 option; (* Number of bytes transmitted. *) } @@ -114,7 +111,17 @@ let last_pcpu_usages = Hashtbl.create 13 let clear_pcpu_display_data () = Hashtbl.clear last_pcpu_usages -let collect (conn, _, _, _, _, node_info, _, _) block_in_bytes = +(* What to get from virConnectGetAllDomainStats. *) +let what = [ + D.StatsState; D.StatsCpuTotal; D.StatsBalloon; D.StatsVcpu; + D.StatsInterface; D.StatsBlock +] +(* Which domains to get. Empty list means return all domains: + * active, inactive, persistent, transient etc. + *) +let who = [] + +let collect (conn, _, _, _, _, node_info, _, _) = (* Number of physical CPUs (some may be disabled). *) let nr_pcpus = C.maxcpus_of_node_info node_info in @@ -133,73 +140,179 @@ let collect (conn, _, _, _, _, node_info, _, _) block_in_bytes = (* 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 + let doms = D.get_all_domain_stats conn what who in + let doms = Array.to_list doms in + List.map ( + fun { D.dom_uuid = uuid; D.params = params } -> + let nr_params = Array.length params in + let get_param name = + let rec loop i = + if i = nr_params then None + else if fst params.(i) = name then Some (snd params.(i)) + else loop (i+1) + in + loop 0 + in + let get_param_int name default = + match get_param name with + | None -> None + | Some (D.TypedFieldInt32 i) + | Some (D.TypedFieldUInt32 i) -> Some (Int32.to_int i) + | Some (D.TypedFieldInt64 i) + | Some (D.TypedFieldUInt64 i) -> Some (Int64.to_int i) + | _ -> default + in + let get_param_int64 name default = + match get_param name with + | None -> None + | Some (D.TypedFieldInt32 i) + | Some (D.TypedFieldUInt32 i) -> Some (Int64.of_int32 i) + | Some (D.TypedFieldInt64 i) + | Some (D.TypedFieldUInt64 i) -> Some i + | _ -> default + in + + let dom = D.lookup_by_uuid conn uuid in + let id = D.get_id dom in + let name = D.get_name dom in + let state = get_param_int "state.state" None in + + if state = Some 5 (* VIR_DOMAIN_SHUTOFF *) then + (name, Inactive) + else ( + (* Active domain. *) + + (* Synthesize a D.info struct out of the data we have + * from virConnectGetAllDomainStats. Doing this is an + * artifact from the old APIs we used to use to fetch + * stats, we could simplify here, and also return the + * RSS memory. XXX + *) + let state = + match state with + | None | Some 0 -> D.InfoNoState + | Some 1 -> D.InfoRunning + | Some 2 -> D.InfoBlocked + | Some 3 -> D.InfoPaused + | Some 4 -> D.InfoShutdown + | Some 5 -> D.InfoShutoff + | Some 6 -> D.InfoCrashed + | Some 7 -> D.InfoPaused (* XXX really VIR_DOMAIN_PMSUSPENDED *) + | _ -> D.InfoNoState in + let memory = + match get_param_int64 "balloon.current" None with + | None -> 0_L + | Some m -> m in + let nr_virt_cpu = + match get_param_int "vcpu.current" None with + | None -> 1 + | Some v -> v in + let cpu_time = + (* NB: libvirt does not return cpu.time for non-root domains. *) + match get_param_int64 "cpu.time" None with + | None -> 0_L + | Some ns -> ns in + let info = { + D.state = state; + max_mem = -1_L; (* not used anywhere in virt-top *) + memory = memory; + nr_virt_cpu = nr_virt_cpu; + cpu_time = cpu_time + } in + + let nr_block_devs = + match get_param_int "block.count" None with + | None -> 0 + | Some i -> i in + let block_stats = + List.map ( + fun i -> + let dev = + match get_param (sprintf "block.%d.name" i) with + | None -> sprintf "blk%d" i + | Some (D.TypedFieldString s) -> s + | _ -> assert false in + dev, { + D.rd_req = + (match get_param_int64 (sprintf "block.%d.rd.reqs" i) None + with None -> 0_L | Some v -> v); + rd_bytes = + (match get_param_int64 (sprintf "block.%d.rd.bytes" i) None + with None -> 0_L | Some v -> v); + wr_req = + (match get_param_int64 (sprintf "block.%d.wr.reqs" i) None + with None -> 0_L | Some v -> v); + wr_bytes = + (match get_param_int64 (sprintf "block.%d.wr.bytes" i) None + with None -> 0_L | Some v -> v); + errs = 0_L + } + ) (range 0 (nr_block_devs-1)) in + + let nr_interface_devs = + match get_param_int "net.count" None with + | None -> 0 + | Some i -> i in + let interface_stats = + List.map ( + fun i -> + let dev = + match get_param (sprintf "net.%d.name" i) with + | None -> sprintf "net%d" i + | Some (D.TypedFieldString s) -> s + | _ -> assert false in + dev, { + D.rx_bytes = + (match get_param_int64 (sprintf "net.%d.rx.bytes" i) None + with None -> 0_L | Some v -> v); + rx_packets = + (match get_param_int64 (sprintf "net.%d.rx.pkts" i) None + with None -> 0_L | Some v -> v); + rx_errs = + (match get_param_int64 (sprintf "net.%d.rx.errs" i) None + with None -> 0_L | Some v -> v); + rx_drop = + (match get_param_int64 (sprintf "net.%d.rx.drop" i) None + with None -> 0_L | Some v -> v); + tx_bytes = + (match get_param_int64 (sprintf "net.%d.tx.bytes" i) None + with None -> 0_L | Some v -> v); + tx_packets = + (match get_param_int64 (sprintf "net.%d.tx.pkts" i) None + with None -> 0_L | Some v -> v); + tx_errs = + (match get_param_int64 (sprintf "net.%d.tx.errs" i) None + with None -> 0_L | Some v -> v); + tx_drop = + (match get_param_int64 (sprintf "net.%d.tx.drop" i) None + with None -> 0_L | Some v -> v); + } + ) (range 0 (nr_interface_devs-1)) in + + let prev_info, prev_block_stats, prev_interface_stats = + try + let prev_info, prev_block_stats, prev_interface_stats = + Hashtbl.find last_info uuid in + Some prev_info, prev_block_stats, prev_interface_stats + with Not_found -> None, [], [] in + + (name, + Active { + rd_domid = id; rd_domuuid = uuid; 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_net_rx_bytes = None; rd_net_tx_bytes = None; + }) + ) + ) doms in (* Calculate the CPU time (ns) and %CPU used by each domain. *) let doms = @@ -256,14 +369,6 @@ let collect (conn, _, _, _, _, node_info, _, _) block_in_bytes = 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 @@ -342,7 +447,7 @@ let collect (conn, _, _, _, _, node_info, _, _) block_in_bytes = 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 + Hashtbl.add last_info rd.rd_domuuid info | _ -> () ) doms;