2 * Copyright (C) 2014-2015 Red Hat Inc.
4 * This program is free software; you can redistribute it and/or modify
5 * it under the terms of the GNU General Public License as published by
6 * the Free Software Foundation; either version 2 of the License, or
7 * (at your option) any later version.
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 * GNU General Public License for more details.
14 * You should have received a copy of the GNU General Public License
15 * along with this program; if not, write to the Free Software
16 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19 (* Implement 'mclu status'. *)
25 module C = Libvirt.Connect
26 module D = Libvirt.Domain
28 let get_arg_speclist () = Arg.align [
32 node : Mclu_conf.node;
33 node_on : bool; (* true = appears to be switched on *)
34 node_info : C.node_info;
37 let node_statuses ?(verbose = false) ?(nodes = Mclu_conf.nodes ()) () =
41 let hostname = node.Mclu_conf.hostname
42 and name = node.Mclu_conf.libvirt_uri in
44 try Some (C.connect_readonly ~name ())
45 with Libvirt.Virterror msg ->
47 eprintf "mclu: %s: %s (ignored)\n" hostname
48 (Libvirt.Virterror.to_string msg);
52 | Some conn -> C.get_node_info conn
53 | None -> { C.model = ""; memory = 0L; cpus = 0;
55 sockets = 0; cores = 0; threads = 0 } in
56 { node = node; node_on = conn <> None; node_info = node_info }
58 List.map (fun s -> Marshal.from_bytes s 0) nodes
60 type node_guest_summary = {
61 node_status : node_status;
62 active_guests : Mclu_list.dom_info list;
68 let node_guest_summary ?(verbose = false) () =
69 let node_statuses = node_statuses ~verbose () in
71 (* Get list of active guests for nodes which are on. *)
73 let nodes = List.filter (fun { node_on = on } -> on) node_statuses in
74 let nodes = List.map (fun { node = node } -> node) nodes in
75 Mclu_list.active_guests ~verbose ~nodes () in
80 try List.assoc node_status.node active_guests with Not_found -> [] in
81 let used_vcpus, used_memory_kb =
83 fun (used_vcpus, used_memory_kb)
84 { Mclu_list.dom_info = { D.nr_virt_cpu = vcpus;
85 memory = memory_kb } } ->
86 (used_vcpus + vcpus, used_memory_kb +^ memory_kb)
88 let used_memory = used_memory_kb *^ 1024L in
90 node_status.node_info.C.memory *^ 1024L in
92 max (total_memory -^ 1024L *^ 1024L *^ 1024L) 0L in
93 let free_memory = total_memory -^ used_memory in
94 { node_status = node_status;
95 active_guests = guests;
96 used_memory = used_memory;
97 used_vcpus = used_vcpus;
98 free_memory = free_memory }
101 let status ~verbose () =
102 let summary = node_guest_summary ~verbose () in
106 | { node_status = { node_on = false;
107 node = { Mclu_conf.hostname = hostname } } } ->
108 printf "%-28s off\n" hostname
109 | { node_status = { node_on = true;
110 node = { Mclu_conf.hostname = hostname };
111 node_info = node_info };
112 active_guests = guests;
113 used_vcpus = used_vcpus;
114 used_memory = used_memory;
115 free_memory = free_memory } ->
116 printf "%-28s on\n" hostname;
118 printf "total: %dpcpus %s\n"
119 node_info.C.cpus (human_size (node_info.C.memory *^ 1024L));
120 if guests <> [] then (
122 printf "used: %dvcpus %s by %d guest(s)\n"
123 used_vcpus (human_size used_memory) (List.length guests)
126 printf "free: %s\n" (human_size free_memory)
131 let run ~verbose = function
132 | [] -> status ~verbose ()
134 eprintf "mclu status: Too many arguments\n";