*)
open Printf
+open Virt_ctrl_gettext.Gettext
module C = Libvirt.Connect
module D = Libvirt.Domain
in
get_conns, add_conn, del_conn
+(* Store the node_info and hostname for each connection, fetched
+ * once just after we connect since these don't normally change.
+ * Hash of connid -> (C.node_info, hostname option, uri)
+ *)
+let static_conn_info = Hashtbl.create 13
+
+let open_connection uri =
+ (* If this fails, let the exception escape and be printed
+ * in the global exception handler.
+ *)
+ let conn = C.connect ~name:uri () in
+
+ let node_info = C.get_node_info conn in
+ let hostname =
+ try Some (C.get_hostname conn)
+ with
+ | Libvirt.Not_supported "virConnectGetHostname"
+ | Libvirt.Virterror _ -> None in
+
+ (* 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)
+
+(* Stores the state and history for each domain.
+ * Hash of (connid, domid) -> mutable domhistory structure.
+ * We never delete entries in this hash table, which may be a problem
+ * for very very long-lived instances of virt-ctrl.
+ *)
+type domhistory = {
+ (* for %CPU calculation: *)
+ mutable last_cpu_time : int64; (* last virDomainInfo->cpuTime *)
+ mutable last_time : float; (* exact time we measured the above *)
+
+ (* historical data for graphs etc: *)
+ 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 = Array.make 0 empty_dhentry; hist_posn = 0;
+}
+
+(* These set limits on the amount of history we collect. *)
+let hist_max = 86400 (* max history stored, seconds *)
+let hist_rot = 3600 (* rotation of array when we hit max *)
+
(* The current state. This is used so that we can see changes that
* have happened and add or remove parts of the model. (Previously
* we used to recreate the whole model each time, but the problem
and active = int (* domain's ID *)
and inactive = string (* domain's name *)
-(* The last "CPU time" seen for a domain, so we can calculate CPU % usage.
- * Hash of (connid, domid) -> cpu_time [int64].
+(* The types of the display columns in the main window. The interesting
+ * one of the final (int) field which stores the ID of the row, either
+ * connid or domid.
*)
-let last_cpu_time = Hashtbl.create 13
-let last_time = ref (Unix.gettimeofday ())
-
-(* Store the node_info and hostname for each connection, fetched
- * once just after we connect since these don't normally change.
- * Hash of connid -> (C.node_info, hostname option, uri)
- *)
-let static_conn_info = Hashtbl.create 13
-
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 repopulate (tree : GTree.view) (model : GTree.tree_store)
(col_name_id, col_domname, col_status, col_cpu, col_mem, col_id)
state =
- let time_passed =
- let time_now = Unix.gettimeofday () in
- let time_passed = time_now -. !last_time in
- last_time := time_now;
- time_passed in
-
(* Which connections have been added or removed? *)
let conns = get_conns () in
let added, _, removed =
let memory = sprintf "%Ld K" info.D.memory in
model#set ~row ~column:col_mem memory;
- let ns_now = info.D.cpu_time in (* ns = nanoseconds *)
- let ns_prev =
- try
- let ns = Hashtbl.find last_cpu_time (conn_id, domid) in
- if ns > ns_now then 0L else ns (* Rebooted? *)
- with Not_found -> 0L in
- Hashtbl.replace last_cpu_time (conn_id, domid) ns_now;
- let ns_now = Int64.to_float ns_now in
- let ns_prev = Int64.to_float ns_prev in
- let ns_used = ns_now -. ns_prev in
- let ns_available = 1_000_000_000. *. float nr_cpus in
- let cpu_percent =
- 100. *. (ns_used /. ns_available) /. time_passed in
- let cpu_percent = sprintf "%.1f %%" cpu_percent in
- model#set ~row ~column:col_cpu cpu_percent;
+ (* Get domhistory. For a new domain it won't exist, so
+ * create an empty one.
+ *)
+ let dh =
+ let key = conn_id, domid in
+ try Hashtbl.find domhistory key
+ with Not_found ->
+ let dh = new_domhistory () in
+ Hashtbl.add domhistory key dh;
+ dh in
+
+ (* Measure current time and domain cpuTime as close
+ * together as possible.
+ *)
+ let time_now = Unix.gettimeofday () in
+ let cpu_now = info.D.cpu_time in
+
+ let time_prev = dh.last_time in
+ let cpu_prev =
+ if dh.last_cpu_time > cpu_now then 0L (* Rebooted? *)
+ else dh.last_cpu_time in
+
+ dh.last_time <- time_now;
+ dh.last_cpu_time <- cpu_now;
- with Libvirt.Virterror _ -> () (* Ignore any transient error *)
+ let cpu_percent =
+ if time_prev > 0. then (
+ let cpu_now = Int64.to_float cpu_now in
+ let cpu_prev = Int64.to_float cpu_prev in
+ let cpu_used = cpu_now -. cpu_prev in
+ let cpu_available = 1_000_000_000. *. float nr_cpus in
+ let time_passed = time_now -. time_prev in
+
+ 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 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';
+ )
+ );
+ dh.hist_posn <- dh.hist_posn+1
+
+ with
+ Libvirt.Virterror _ -> () (* Ignore any transient error *)
)
) (model#iter_children (Some parent));
view_col#set_sort_order sort_order;
view_col#set_sort_column_id sort_column_id
in
- append_visible_column "ID" col_name_id (Some (false, `ASCENDING, 0));
- append_visible_column "Name" col_domname (Some (true, `ASCENDING, 1));
- append_visible_column "Status" col_status None;
- append_visible_column "CPU" col_cpu None;
- append_visible_column "Memory" col_mem None;
+ append_visible_column (s_ "ID") col_name_id (Some (false, `ASCENDING, 0));
+ append_visible_column (s_ "Name") col_domname (Some (true, `ASCENDING, 1));
+ append_visible_column (s_ "Status") col_status None;
+ append_visible_column (s_ "CPU") col_cpu None;
+ append_visible_column (s_ "Memory") col_mem None;
let columns =
col_name_id, col_domname, col_status, col_cpu, col_mem, col_id in
(tree, model, columns, state)
-(* Callback function to open a connection.
- * This should be a lot more sophisticated. XXX
- *)
-let open_connection () =
- let title = "Open connection to hypervisor" in
- let uri =
- GToolbox.input_string ~title ~text:"xen:///" ~ok:"Open" "Connection:" in
- match uri with
- | None -> ()
- | Some uri ->
- (* If this fails, let the exception escape and be printed
- * in the global exception handler.
- *)
- let conn = C.connect ~name:uri () in
-
- let node_info = C.get_node_info conn in
- let hostname =
- try Some (C.get_hostname conn)
- with
- | Libvirt.Not_supported "virConnectGetHostname"
- | Libvirt.Virterror _ -> None in
-
- (* 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