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 list'. *)
25 module C = Libvirt.Connect
26 module D = Libvirt.Domain
28 let list_what = ref `All
29 let set_all () = list_what := `All
30 let set_active () = list_what := `ActiveOnly
31 let set_templates () = list_what := `TemplatesOnly
33 let get_arg_speclist () = Arg.align [
34 "--active", Arg.Unit set_active, " List only active/running guests";
35 "--all", Arg.Unit set_all, " List active guests and templates (default)";
36 "--inactive", Arg.Unit set_templates, " List only templates";
37 "--running", Arg.Unit set_active, " List only active/running guests";
38 "--templates", Arg.Unit set_templates, " List only templates";
46 (* Return the active (running) guests. This utility function is
47 * also called from other places.
49 let active_guests ?(verbose = false) ?(nodes = Mclu_conf.nodes ()) () =
50 (* A list of running guests, indexed by each node. *)
54 let hostname = node.Mclu_conf.hostname
55 and name = node.Mclu_conf.libvirt_uri in
57 try Some (C.connect_readonly ~name ())
58 with Libvirt.Virterror msg ->
60 eprintf "mclu: %s: %s (ignored)\n" hostname
61 (Libvirt.Virterror.to_string msg);
66 let dominfos = D.get_domains_and_infos conn [D.ListActive] in
67 (* D.t is abstract so we cannot marshal it. *)
70 { dom_name = D.get_name dom; dom_info = info }
75 List.map (fun s -> Marshal.from_bytes s 0) active_guests
77 let find_guest ?verbose ?(nodes = Mclu_conf.nodes ()) name =
78 let host, name = name_parse name in
82 (try List.find (fun n -> host = n.Mclu_conf.hostname) nodes
84 eprintf "mclu: host '%s' not found\n" host;
87 (* No 'host:' prefix given, so we need to find the host. *)
88 let guests = active_guests ?verbose ~nodes () in
93 List.exists (fun dom -> name = dom.dom_name) doms
97 eprintf "mclu: guest '%s' not found\n" name;
102 let list ~verbose () =
103 let list_what = !list_what in
105 (match list_what with
106 | `TemplatesOnly -> ()
107 | `All | `ActiveOnly ->
108 let active_guests = active_guests ~verbose () in
111 fun ({ Mclu_conf.hostname = hostname }, dominfos) ->
113 fun { dom_name = name;
114 dom_info = { D.nr_virt_cpu = vcpus;
115 D.memory = memory_kb;
116 D.state = state } } ->
117 let host_dom_name = sprintf "%s:%s" hostname name in
118 printf "%-28s %s %dvcpus %s\n"
119 host_dom_name (string_of_dom_state state)
120 vcpus (human_size (memory_kb *^ 1024L))
125 (* For quasi-historical reasons, this command also lists the inactive
126 * guests, which in mclu v2 are templates.
128 (match list_what with
130 | `All | `TemplatesOnly ->
131 let templates = Template.template_names () in
135 printf "%-28s template\n" name
139 let run ~verbose = function
140 | [] -> list ~verbose ()
142 eprintf "mclu list: Too many arguments\n";