- Historical data combined into a single array of dhentrys.
- Provide accessor functions.
- Clamp %CPU to 0..100.
mutable last_time : float; (* exact time we measured the above *)
(* historical data for graphs etc: *)
- mutable hist_cpu : int array; (* historical %CPU *)
- mutable hist_cpu_posn : int; (* position within array *)
- mutable hist_mem : int64 array; (* historical memory (kilobytes) *)
- mutable hist_mem_posn : int; (* position within array *)
+ mutable hist : dhentry array; (* historical data *)
+ mutable hist_posn : int; (* position within array *)
+}
+and dhentry = {
+ hist_cpu : int; (* historical %CPU entry *)
+ hist_mem : int64; (* historical memory entry (KB) *)
}
let domhistory = Hashtbl.create 13
+let empty_dhentry = {
+ hist_cpu = 0; hist_mem = 0L;
+}
let new_domhistory () = {
last_cpu_time = 0L; last_time = 0.;
- hist_cpu = Array.make 0 0; hist_cpu_posn = 0;
- hist_mem = Array.make 0 0L; hist_mem_posn = 0;
+ hist = Array.make 0 empty_dhentry; hist_posn = 0;
}
(* These set limits on the amount of history we collect. *)
*)
type columns = string GTree.column * string GTree.column * string GTree.column * string GTree.column * string GTree.column * int GTree.column
-let debug_repopulate = true
+let debug_repopulate = false
(* Populate the tree with the current list of connections, domains.
* This function is called once per second.
let cpu_percent =
100. *. (cpu_used /. cpu_available) /. time_passed in
+ let cpu_percent =
+ if cpu_percent < 0. then 0.
+ else if cpu_percent > 100. then 100.
+ else cpu_percent in
+
let cpu_percent_str = sprintf "%.1f %%" cpu_percent in
model#set ~row ~column:col_cpu cpu_percent_str;
int_of_float cpu_percent
) else -1 in
(* Store history. *)
- let store arr posn datum =
- if posn >= hist_max then (
- (* rotate the array *)
- Array.blit arr hist_rot arr 0 (hist_max - hist_rot);
- let posn = posn - hist_rot in
- arr.(posn) <- datum;
- (arr, posn+1)
- ) else (
- let len = Array.length arr in
- if posn < len then (
- (* normal update *)
- arr.(posn) <- datum;
- (arr, posn+1)
- ) else (
- (* extend the array *)
- let len' = min (max (2*len) 1) hist_max in
- let arr' = Array.make len' datum in
- Array.blit arr 0 arr' 0 len;
- (arr', posn+1)
- )
+ let datum = { hist_cpu = cpu_percent;
+ hist_mem = info.D.memory } in
+
+ if dh.hist_posn >= hist_max then (
+ (* rotate the array *)
+ Array.blit dh.hist hist_rot dh.hist 0 (hist_max-hist_rot);
+ dh.hist_posn <- dh.hist_posn - hist_rot;
+ dh.hist.(dh.hist_posn) <- datum;
+ ) else (
+ let len = Array.length dh.hist in
+ if dh.hist_posn < len then
+ (* normal update *)
+ dh.hist.(dh.hist_posn) <- datum
+ else (
+ (* extend the array *)
+ let len' = min (max (2*len) 1) hist_max in
+ let arr' = Array.make len' datum in
+ Array.blit dh.hist 0 arr' 0 len;
+ dh.hist <- arr';
)
- in
- let hist_cpu, hist_cpu_posn =
- store dh.hist_cpu dh.hist_cpu_posn cpu_percent in
- dh.hist_cpu <- hist_cpu; dh.hist_cpu_posn <- hist_cpu_posn;
- let hist_mem, hist_mem_posn =
- store dh.hist_mem dh.hist_mem_posn info.D.memory in
- dh.hist_mem <- hist_mem; dh.hist_mem_posn <- hist_mem_posn
+ );
+ dh.hist_posn <- dh.hist_posn+1
with
Libvirt.Virterror _ -> () (* Ignore any transient error *)
(* Add it to our list of connections. *)
let conn_id = add_conn conn in
Hashtbl.add static_conn_info conn_id (node_info, hostname, uri)
+
+(* Get historical data size. *)
+let get_hist_size connid domid =
+ try
+ let dh = Hashtbl.find domhistory (connid, domid) in
+ dh.hist_posn
+ with
+ Not_found -> 0
+
+(* Get historical data entries. *)
+let _get_hist ?(latest=0) ?earliest ?(granularity=1)
+ extract fold zero connid domid =
+ try
+ let dh = Hashtbl.find domhistory (connid, domid) in
+ let earliest =
+ match earliest with
+ | None -> dh.hist_posn
+ | Some e -> min e dh.hist_posn in
+
+ let src = dh.hist in
+ let src_start = dh.hist_posn - earliest in assert (src_start >= 0);
+ let src_end = dh.hist_posn - latest in assert (src_end <= dh.hist_posn);
+
+ (* Create a sufficiently large array to store the result. *)
+ let len = (earliest-latest) / granularity in
+ let r = Array.make len zero in
+
+ if granularity = 1 then (
+ for j = 0 to len-1 do
+ r.(j) <- extract src.(src_start+j)
+ done
+ ) else (
+ let i = ref src_start in
+ for j = 0 to len-1 do
+ let sub = Array.sub src !i (min (!i+granularity) src_end - !i) in
+ let sub = Array.map extract sub in
+ r.(j) <- fold sub;
+ i := !i + granularity
+ done
+ );
+ r
+ with
+ Not_found -> [| |]
+
+let get_hist_cpu ?latest ?earliest ?granularity connid domid =
+ let zero = 0 in
+ let extract { hist_cpu = c } = c in
+ let fold a =
+ let len = Array.length a in
+ if len > 0 then Array.fold_left (+) zero a / len else -1 in
+ _get_hist ?latest ?earliest ?granularity extract fold zero connid domid
+
+let get_hist_mem ?latest ?earliest ?granularity connid domid =
+ let zero = 0L in
+ let extract { hist_mem = m } = m in
+ let fold a =
+ let len = Array.length a in
+ if len > 0 then
+ Int64.div (Array.fold_left (Int64.add) zero a) (Int64.of_int len)
+ else
+ -1L in
+ _get_hist ?latest ?earliest ?granularity extract fold zero connid domid
(** This callback creates the Connect to hypervisor dialog. *)
val open_connection : unit -> unit
+
+(** Return the amount of historical data that we hold about a
+ domain (in seconds).
+
+ The parameters are connection ID (see {!get_conns}) and domain ID.
+
+ This can return from [0] to [86400] (or 1 day of data).
+*)
+val get_hist_size : int -> int -> int
+
+(** Return a slice of historical %CPU data about a domain.
+
+ The required parameters are connection ID (see {!get_conns})
+ and domain ID.
+
+ The optional [latest] parameter is the latest data we should
+ return. It defaults to [0] meaning to return everything up to now.
+
+ The optional [earliest] parameter is the earliest data we should
+ return. This is a positive number representing number of seconds
+ back in time. It defaults to returning all data.
+
+ The optional [granularity] parameter is the granularity of data
+ that we should return, in seconds. This defaults to [1], meaning
+ to return all data (once per second), but you might for example
+ set this to [60] to return data for each minute.
+
+ This returns an array of data. The first element of the array is
+ the oldest data. The last element of the array is the most recent
+ data. The array returned might be shorter than you expect (if
+ data is missing or for some other reason) so always check the
+ length.
+
+ Entries in the array are clamped to [0..100], except that if an
+ entry is [-1] it means "no data".
+
+ This returns a zero-length array if we don't know about the domain.
+*)
+val get_hist_cpu : ?latest:int -> ?earliest:int -> ?granularity:int ->
+ int -> int ->
+ int array
+
+(** Return a slice of historical memory data about a domain.
+
+ Parameters as above.
+
+ Entries in the array are 64 bit integers corresponding to the
+ amount of memory in KB allocated to the domain (not necessarily
+ the amount being used, which we don't know about).
+*)
+val get_hist_mem : ?latest:int -> ?earliest:int -> ?granularity:int ->
+ int -> int ->
+ int64 array
| None -> None (* No row at all selected. *)
| Some path ->
let row = model#get_iter path in
- (* Visit parent to get the conn_id.
+ (* Visit parent to get the connid.
* If this returns None, then it's a top-level row which is
* selected (ie. a connection), so just ignore.
*)
| Some parent ->
try
let (_, col_domname, _, _, _, col_id) = columns in
- let conn_id = model#get ~row:parent ~column:col_id in
+ let connid = model#get ~row:parent ~column:col_id in
let conn =
- List.assoc conn_id (Vc_connections.get_conns ()) in
+ List.assoc connid (Vc_connections.get_conns ()) in
let domid = model#get ~row ~column:col_id in
if domid = -1 then ( (* Inactive domain. *)
let domname = model#get ~row ~column:col_domname in
let dom = D.lookup_by_name conn domname in
let info = D.get_info dom in
- Some (dom, info, -1)
- ) else if domid > 0 then ( (* Active domU. *)
+ Some (dom, info, connid, -1)
+ ) else ( (* Active domU. *)
let dom = D.lookup_by_id conn domid in
let info = D.get_info dom in
- Some (dom, info, domid)
- ) else (* Dom0 - ignore. *)
- None
+ Some (dom, info, connid, domid)
+ )
with
(* Domain or connection disappeared under us. *)
| Not_found -> None
let start_domain tree model columns () =
match get_domain tree model columns with
| None -> ()
- | Some (dom, _, domid) ->
+ | Some (dom, _, _, domid) ->
if domid = -1 then
D.create dom
let pause_domain tree model columns () =
match get_domain tree model columns with
| None -> ()
- | Some (dom, info, domid) ->
+ | Some (dom, info, _, domid) ->
if domid >= 0 && info.D.state <> D.InfoPaused then
D.suspend dom
let resume_domain tree model columns () =
match get_domain tree model columns with
| None -> ()
- | Some (dom, info, domid) ->
+ | Some (dom, info, _, domid) ->
if domid >= 0 && info.D.state = D.InfoPaused then
D.resume dom
let shutdown_domain tree model columns () =
match get_domain tree model columns with
| None -> ()
- | Some (dom, info, domid) ->
+ | Some (dom, info, _, domid) ->
if domid >= 0 && info.D.state <> D.InfoShutdown then
D.shutdown dom
+
+let open_domain_details tree model columns () =
+ match get_domain tree model columns with
+ | None -> ()
+ | Some (dom, info, connid, domid) ->
+ if domid >= 0 then (
+
+
+
+ )
val pause_domain : dops_callback_fn
val resume_domain : dops_callback_fn
val shutdown_domain : dops_callback_fn
+val open_domain_details : dops_callback_fn
GToolbox.message_box ~title ~icon label
let make ~open_connection
- ~start_domain ~pause_domain ~resume_domain ~shutdown_domain =
+ ~start_domain ~pause_domain ~resume_domain ~shutdown_domain
+ ~open_domain_details =
(* Create the main window. *)
let window = GWindow.window ~width:800 ~height:600 ~title () in
let vbox = GPack.vbox ~packing:window#add () in
let connect_button =
GButton.tool_button ~label:"Connect ..." ~stock:`CONNECT
~packing:toolbar#insert () in
+ ignore (GButton.separator_tool_item ~packing:toolbar#insert ());
+ let open_button =
+ GButton.tool_button ~label:"Details" ~stock:`OPEN
+ ~packing:toolbar#insert () in
+ ignore (GButton.separator_tool_item ~packing:toolbar#insert ());
let start_button =
GButton.tool_button ~label:"Start" ~stock:`ADD
~packing:toolbar#insert () in
let shutdown_button =
GButton.tool_button ~label:"Shutdown" ~stock:`STOP
~packing:toolbar#insert () in
- ignore (connect_button#connect#clicked ~callback:open_connection);
(* The treeview. *)
let (tree, model, columns, initial_state) =
Vc_connections.make_treeview
~packing:(vbox#pack ~expand:true ~fill:true) () in
+ (* Set callbacks for the buttons. *)
+ ignore (connect_button#connect#clicked ~callback:open_connection);
+ ignore (open_button#connect#clicked
+ ~callback:(open_domain_details tree model columns));
ignore (start_button#connect#clicked
~callback:(start_domain tree model columns));
ignore (pause_button#connect#clicked
pause_domain:Vc_domain_ops.dops_callback_fn ->
resume_domain:Vc_domain_ops.dops_callback_fn ->
shutdown_domain:Vc_domain_ops.dops_callback_fn ->
+ open_domain_details:Vc_domain_ops.dops_callback_fn ->
unit
~start_domain:Vc_domain_ops.start_domain
~pause_domain:Vc_domain_ops.pause_domain
~resume_domain:Vc_domain_ops.resume_domain
- ~shutdown_domain:Vc_domain_ops.shutdown_domain;
+ ~shutdown_domain:Vc_domain_ops.shutdown_domain
+ ~open_domain_details:Vc_domain_ops.open_domain_details;
(* Enter the Gtk main loop. *)
GMain.main ();
git.annexia.org / virt-top.git / commitdiff