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 list ~verbose () =
78 let list_what = !list_what in
81 | `TemplatesOnly -> ()
82 | `All | `ActiveOnly ->
83 let active_guests = active_guests ~verbose () in
86 fun ({ Mclu_conf.hostname = hostname }, dominfos) ->
88 fun { dom_name = name;
89 dom_info = { D.nr_virt_cpu = vcpus;
91 D.state = state } } ->
92 let host_dom_name = sprintf "%s:%s" hostname name in
93 printf "%-28s %s %dvcpus %s\n"
94 host_dom_name (string_of_dom_state state)
95 vcpus (human_size (memory_kb *^ 1024L))
100 (* For quasi-historical reasons, this command also lists the inactive
101 * guests, which in mclu v2 are templates.
103 (match list_what with
105 | `All | `TemplatesOnly ->
106 let templates = Template.template_names () in
110 printf "%-28s template\n" name
114 let run ~verbose = function
115 | [] -> list ~verbose ()
117 eprintf "mclu list: Too many arguments\n";