1 (* virt-ctrl: A graphical management tool.
2 (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc.
5 This program is free software; you can redistribute it and/or modify
6 it under the terms of the GNU General Public License as published by
7 the Free Software Foundation; either version 2 of the License, or
8 (at your option) any later version.
10 This program is distributed in the hope that it will be useful,
11 but WITHOUT ANY WARRANTY; without even the implied warranty of
12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 GNU General Public License for more details.
15 You should have received a copy of the GNU General Public License
16 along with this program; if not, write to the Free Software
17 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
19 Domain operations buttons.
23 open Virt_ctrl_gettext.Gettext
25 module C = Libvirt.Connect
26 module D = Libvirt.Domain
27 module N = Libvirt.Network
29 (* Get the selected domain (if there is one) or return None. *)
30 let get_domain (tree : GTree.view) (model : GTree.tree_store)
31 (columns : Vc_connections.columns) =
32 let path, _ = tree#get_cursor () in
34 | None -> None (* No row at all selected. *)
36 let row = model#get_iter path in
37 (* Visit parent to get the connid.
38 * If this returns None, then it's a top-level row which is
39 * selected (ie. a connection), so just ignore.
41 match model#iter_parent row with
45 let (_, col_domname, _, _, _, col_id) = columns in
46 let connid = model#get ~row:parent ~column:col_id in
48 List.assoc connid (Vc_connections.get_conns ()) in
49 let domid = model#get ~row ~column:col_id in
50 if domid = -1 then ( (* Inactive domain. *)
51 let domname = model#get ~row ~column:col_domname in
52 let dom = D.lookup_by_name conn domname in
53 let info = D.get_info dom in
54 Some (dom, info, connid, -1)
55 ) else ( (* Active domU. *)
56 let dom = D.lookup_by_id conn domid in
57 let info = D.get_info dom in
58 Some (dom, info, connid, domid)
61 (* Domain or connection disappeared under us. *)
66 | Libvirt.Virterror err ->
67 prerr_endline (Libvirt.Virterror.to_string err);
70 type dops_callback_fn =
71 GTree.view -> GTree.tree_store -> Vc_connections.columns -> unit -> unit
73 let start_domain tree model columns () =
74 match get_domain tree model columns with
76 | Some (dom, _, _, domid) ->
80 let pause_domain tree model columns () =
81 match get_domain tree model columns with
83 | Some (dom, info, _, domid) ->
84 if domid >= 0 && info.D.state <> D.InfoPaused then
87 let resume_domain tree model columns () =
88 match get_domain tree model columns with
90 | Some (dom, info, _, domid) ->
91 if domid >= 0 && info.D.state = D.InfoPaused then
94 let shutdown_domain tree model columns () =
95 match get_domain tree model columns with
97 | Some (dom, info, _, domid) ->
98 if domid >= 0 && info.D.state <> D.InfoShutdown then
101 let open_domain_details tree model columns () =
102 match get_domain tree model columns with
104 | Some (dom, info, connid, domid) ->