--- /dev/null
+(* mclu: Mini Cloud
+ * Copyright (C) 2014-2015 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+(* Implement 'mclu status'. *)
+
+open Printf
+
+open Utils
+
+module C = Libvirt.Connect
+module D = Libvirt.Domain
+
+let get_arg_speclist () = Arg.align [
+]
+
+type node_status = {
+ node : Mclu_conf.node;
+ node_on : bool; (* true = appears to be switched on *)
+ node_info : C.node_info;
+}
+
+let node_statuses ?(verbose = false) ?(nodes = Mclu_conf.nodes ()) () =
+ let nodes =
+ Parallel.map (
+ fun node ->
+ let hostname = node.Mclu_conf.hostname
+ and name = node.Mclu_conf.libvirt_uri in
+ let conn =
+ try Some (C.connect_readonly ~name ())
+ with Libvirt.Virterror msg ->
+ if verbose then
+ eprintf "mclu: %s: %s (ignored)\n" hostname
+ (Libvirt.Virterror.to_string msg);
+ None in
+ let node_info =
+ match conn with
+ | Some conn -> C.get_node_info conn
+ | None -> { C.model = ""; memory = 0L; cpus = 0;
+ mhz = 0; nodes = 0;
+ sockets = 0; cores = 0; threads = 0 } in
+ { node = node; node_on = conn <> None; node_info = node_info }
+ ) nodes in
+ List.map (fun s -> Marshal.from_bytes s 0) nodes
+
+type node_guest_summary = {
+ node_status : node_status;
+ active_guests : Mclu_list.dom_info list;
+ used_memory : int64;
+ used_vcpus : int;
+ free_memory : int64;
+}
+
+let node_guest_summary ?(verbose = false) () =
+ let node_statuses = node_statuses ~verbose () in
+
+ (* Get list of active guests for nodes which are on. *)
+ let active_guests =
+ let nodes = List.filter (fun { node_on = on } -> on) node_statuses in
+ let nodes = List.map (fun { node = node } -> node) nodes in
+ Mclu_list.active_guests ~verbose ~nodes () in
+
+ List.map (
+ fun node_status ->
+ let guests =
+ try List.assoc node_status.node active_guests with Not_found -> [] in
+ let used_vcpus, used_memory_kb =
+ List.fold_left (
+ fun (used_vcpus, used_memory_kb)
+ { Mclu_list.dom_info = { D.nr_virt_cpu = vcpus;
+ memory = memory_kb } } ->
+ (used_vcpus + vcpus, used_memory_kb +^ memory_kb)
+ ) (0, 0L) guests in
+ let used_memory = used_memory_kb *^ 1024L in
+ let total_memory =
+ node_status.node_info.C.memory *^ 1024L in
+ let total_memory =
+ max (total_memory -^ 1024L *^ 1024L *^ 1024L) 0L in
+ let free_memory = total_memory -^ used_memory in
+ { node_status = node_status;
+ active_guests = guests;
+ used_memory = used_memory;
+ used_vcpus = used_vcpus;
+ free_memory = free_memory }
+ ) node_statuses
+
+let status ~verbose () =
+ let summary = node_guest_summary ~verbose () in
+
+ List.iter (
+ function
+ | { node_status = { node_on = false;
+ node = { Mclu_conf.hostname = hostname } } } ->
+ printf "%-28s off\n" hostname
+ | { node_status = { node_on = true;
+ node = { Mclu_conf.hostname = hostname };
+ node_info = node_info };
+ active_guests = guests;
+ used_vcpus = used_vcpus;
+ used_memory = used_memory;
+ free_memory = free_memory } ->
+ printf "%-28s on\n" hostname;
+ printf " ";
+ printf "total: %dpcpus %s\n"
+ node_info.C.cpus (human_size (node_info.C.memory *^ 1024L));
+ if guests <> [] then (
+ printf " ";
+ printf "used: %dvcpus %s by %d guest(s)\n"
+ used_vcpus (human_size used_memory) (List.length guests)
+ );
+ printf " ";
+ printf "free: %s\n" (human_size free_memory)
+ ) summary;
+
+ ()
+
+let run ~verbose = function
+ | [] -> status ~verbose ()
+ | _ ->
+ eprintf "mclu status: Too many arguments\n";
+ exit 1