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 let name = D.get_name dom in
71 let name_len = String.length name in
72 if name_len > 8 && String.sub name 0 8 = "guestfs-" then
75 Some { dom_name = D.get_name dom; dom_info = info }
80 List.map (fun s -> Marshal.from_bytes s 0) active_guests
82 let find_guest ?verbose ?(nodes = Mclu_conf.nodes ()) name =
83 let host, name = name_parse name in
87 (try List.find (fun n -> host = n.Mclu_conf.hostname) nodes
89 eprintf "mclu: host '%s' not found\n" host;
92 (* No 'host:' prefix given, so we need to find the host. *)
93 let guests = active_guests ?verbose ~nodes () in
98 List.exists (fun dom -> name = dom.dom_name) doms
102 eprintf "mclu: guest '%s' not found\n" name;
107 let list ~verbose () =
108 let list_what = !list_what in
110 (match list_what with
111 | `TemplatesOnly -> ()
112 | `All | `ActiveOnly ->
113 let active_guests = active_guests ~verbose () in
116 fun ({ Mclu_conf.hostname = hostname }, dominfos) ->
118 fun { dom_name = name;
119 dom_info = { D.nr_virt_cpu = vcpus;
120 D.memory = memory_kb;
121 D.state = state } } ->
122 let host_dom_name = sprintf "%s:%s" hostname name in
123 printf "%-28s %s %dvcpus %s\n"
124 host_dom_name (string_of_dom_state state)
125 vcpus (human_size (memory_kb *^ 1024L))
130 (* For quasi-historical reasons, this command also lists the inactive
131 * guests, which in mclu v2 are templates.
133 (match list_what with
135 | `All | `TemplatesOnly ->
136 let templates = Template.template_names () in
140 printf "%-28s template\n" name
144 let run ~verbose = function
145 | [] -> list ~verbose ()
147 eprintf "mclu list: Too many arguments\n";