virt-ctrl/vc_domain_ops.ml

   1 (* virt-ctrl: A graphical management tool.
   2    (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc.
   3    http://libvirt.org/
   4
   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.
   9
  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.
  14
  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.
  18
  19    Domain operations buttons.
  20 *)
  21
  22 open Printf
  23 open Virt_ctrl_gettext.Gettext
  24
  25 module C = Libvirt.Connect
  26 module D = Libvirt.Domain
  27 module N = Libvirt.Network
  28
  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
  33   match path with
  34   | None -> None                        (* No row at all selected. *)
  35   | Some path ->
  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.
  40        *)
  41       match model#iter_parent row with
  42       | None -> None
  43       | Some parent ->
  44           try
  45             let (_, col_domname, _, _, _, col_id) = columns in
  46             let connid = model#get ~row:parent ~column:col_id in
  47             let conn =
  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)
  59             )
  60           with
  61             (* Domain or connection disappeared under us. *)
  62           | Not_found -> None
  63           | Failure msg ->
  64               prerr_endline msg;
  65               None
  66           | Libvirt.Virterror err ->
  67               prerr_endline (Libvirt.Virterror.to_string err);
  68               None
  69
  70 type dops_callback_fn =
  71     GTree.view -> GTree.tree_store -> Vc_connections.columns -> unit -> unit
  72
  73 let start_domain tree model columns () =
  74   match get_domain tree model columns with
  75   | None -> ()
  76   | Some (dom, _, _, domid) ->
  77       if domid = -1 then
  78         D.create dom
  79
  80 let pause_domain tree model columns () =
  81   match get_domain tree model columns with
  82   | None -> ()
  83   | Some (dom, info, _, domid) ->
  84       if domid >= 0 && info.D.state <> D.InfoPaused then
  85         D.suspend dom
  86
  87 let resume_domain tree model columns () =
  88   match get_domain tree model columns with
  89   | None -> ()
  90   | Some (dom, info, _, domid) ->
  91       if domid >= 0 && info.D.state = D.InfoPaused then
  92         D.resume dom
  93
  94 let shutdown_domain tree model columns () =
  95   match get_domain tree model columns with
  96   | None -> ()
  97   | Some (dom, info, _, domid) ->
  98       if domid >= 0 && info.D.state <> D.InfoShutdown then
  99         D.shutdown dom
 100
 101 let open_domain_details tree model columns () =
 102   match get_domain tree model columns with
 103   | None -> ()
 104   | Some (dom, info, connid, domid) ->
 105       if domid >= 0 then (
 106
 107
 108
 109       )