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;
let clear_pcpu_display_data () =
Hashtbl.clear last_pcpu_usages
+(* 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
(* 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_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 =
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;
git.annexia.org / virt-top.git / blobdiff