From 430d646f23385cff10f3cfe359f27226f42cf01a Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Sat, 16 Feb 2008 19:16:50 +0000 Subject: Combine historical data, provide accessor functions. - Historical data combined into a single array of dhentrys. - Provide accessor functions. - Clamp %CPU to 0..100. --- virt-ctrl/vc_connections.ml | 133 ++++++++++++++++++++++++++++++++----------- virt-ctrl/vc_connections.mli | 53 +++++++++++++++++ virt-ctrl/vc_domain_ops.ml | 33 +++++++---- virt-ctrl/vc_domain_ops.mli | 1 + virt-ctrl/vc_mainwindow.ml | 13 ++++- virt-ctrl/vc_mainwindow.mli | 1 + virt-ctrl/virt_ctrl.ml | 3 +- 7 files changed, 188 insertions(+), 49 deletions(-) diff --git a/virt-ctrl/vc_connections.ml b/virt-ctrl/vc_connections.ml index 210c68a..c99b2c4 100644 --- a/virt-ctrl/vc_connections.ml +++ b/virt-ctrl/vc_connections.ml @@ -70,18 +70,22 @@ type domhistory = { 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. *) @@ -94,7 +98,7 @@ let hist_rot = 3600 (* rotation of array when we hit max *) *) 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. @@ -283,40 +287,39 @@ let repopulate (tree : GTree.view) (model : GTree.tree_store) 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 *) @@ -418,3 +421,65 @@ let open_connection () = (* 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 diff --git a/virt-ctrl/vc_connections.mli b/virt-ctrl/vc_connections.mli index d3542dc..22c40a1 100644 --- a/virt-ctrl/vc_connections.mli +++ b/virt-ctrl/vc_connections.mli @@ -47,3 +47,56 @@ val make_treeview : (** 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 diff --git a/virt-ctrl/vc_domain_ops.ml b/virt-ctrl/vc_domain_ops.ml index 74540be..787e71e 100644 --- a/virt-ctrl/vc_domain_ops.ml +++ b/virt-ctrl/vc_domain_ops.ml @@ -33,7 +33,7 @@ let get_domain (tree : GTree.view) (model : GTree.tree_store) | 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. *) @@ -42,21 +42,20 @@ let get_domain (tree : GTree.view) (model : GTree.tree_store) | 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 @@ -73,27 +72,37 @@ type dops_callback_fn = 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 ( + + + + ) diff --git a/virt-ctrl/vc_domain_ops.mli b/virt-ctrl/vc_domain_ops.mli index 661ede3..38a2015 100644 --- a/virt-ctrl/vc_domain_ops.mli +++ b/virt-ctrl/vc_domain_ops.mli @@ -32,3 +32,4 @@ val start_domain : dops_callback_fn 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 diff --git a/virt-ctrl/vc_mainwindow.ml b/virt-ctrl/vc_mainwindow.ml index 4fd82c9..b8ec4db 100644 --- a/virt-ctrl/vc_mainwindow.ml +++ b/virt-ctrl/vc_mainwindow.ml @@ -61,7 +61,8 @@ let () = 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 @@ -94,6 +95,11 @@ let make ~open_connection 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 @@ -106,13 +112,16 @@ let make ~open_connection 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 diff --git a/virt-ctrl/vc_mainwindow.mli b/virt-ctrl/vc_mainwindow.mli index 1f3a176..68843fb 100644 --- a/virt-ctrl/vc_mainwindow.mli +++ b/virt-ctrl/vc_mainwindow.mli @@ -27,4 +27,5 @@ val make : open_connection:(unit -> unit) -> 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 diff --git a/virt-ctrl/virt_ctrl.ml b/virt-ctrl/virt_ctrl.ml index b4a3159..a9740c1 100644 --- a/virt-ctrl/virt_ctrl.ml +++ b/virt-ctrl/virt_ctrl.ml @@ -26,7 +26,8 @@ let () = ~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 (); -- cgit