X-Git-Url: http://git.annexia.org/?p=virt-top.git;a=blobdiff_plain;f=virt-ctrl%2Fvc_connections.ml;h=8f5fba05dbd63119f88abcd428c177a43f93a76e;hp=5525f5e556967f0de369cb81fab637e6c2a880c5;hb=f4bba95a7a09519e8828a146dfd7cb57b7e7df73;hpb=474e8b8e2e98b61d5d01a58f843b9338754ecf2f

diff --git a/virt-ctrl/vc_connections.ml b/virt-ctrl/vc_connections.ml
index 5525f5e..8f5fba0 100644
--- a/virt-ctrl/vc_connections.ml
+++ b/virt-ctrl/vc_connections.ml
@@ -18,6 +18,7 @@
 *)
 
 open Printf
+open Virt_ctrl_gettext.Gettext
 
 module C = Libvirt.Connect
 module D = Libvirt.Domain
@@ -43,6 +44,62 @@ let get_conns, add_conn, del_conn =
   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
@@ -53,15 +110,13 @@ and connection = int (* connection ID *) * (active list * inactive list)
 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 ())
-
 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.
@@ -69,12 +124,6 @@ let debug_repopulate = true
 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 =
@@ -97,14 +146,15 @@ let repopulate (tree : GTree.view) (model : GTree.tree_store)
   List.iter (
     fun conn_id ->
       let row = model#append () in
-      (* Get the connection name. *)
+      (* Get the connection name, usually the hostname. *)
       let name =
-	try C.get_hostname (List.assoc conn_id conns)
-	with Not_found | Libvirt.Virterror _ ->
-	  "Conn #" ^ string_of_int conn_id in
+	match Hashtbl.find static_conn_info conn_id with
+	| (_, Some hostname, _) -> hostname
+	| (_, None, _) -> sprintf "Conn #%d" conn_id in
       model#set ~row ~column:col_name_id name;
       model#set ~row ~column:col_id conn_id;
-      (* XXX This doesn't work, why? *)
+      (* Expand the new row. *)
+      (* XXX This doesn't work, why? - Because we haven't create subrows yet.*)
       tree#expand_row (model#get_path row)
   ) added;
 
@@ -127,8 +177,8 @@ let repopulate (tree : GTree.view) (model : GTree.tree_store)
 	  with Not_found -> assert false (* Should never happen. *) in
 
 	try
-	  (* Node info & number of CPUs available. *)
-	  let node_info = C.get_node_info conn in
+	  (* Number of CPUs available. *)
+	  let node_info, _, _ = Hashtbl.find static_conn_info conn_id in
 	  let nr_cpus = C.maxcpus_of_node_info node_info in
 
 	  (* For this connection, get a current list of active domains (IDs) *)
@@ -219,23 +269,78 @@ let repopulate (tree : GTree.view) (model : GTree.tree_store)
 		  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));
 
@@ -297,11 +402,11 @@ let make_treeview ?packing () =
 	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
@@ -309,18 +414,64 @@ let make_treeview ?packing () =
 
   (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 name =
-    GToolbox.input_string ~title ~text:"xen:///" ~ok:"Open" "Connection:" in
-  match name with
-  | None -> ()
-  | Some name ->
-      (* If this fails, let the exception escape and be printed
-       * in the global exception handler.
-       *)
-      let conn = C.connect ~name () in
-      ignore (add_conn conn)
+(* 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