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
  24 module C = Libvirt.Connect
  25 module D = Libvirt.Domain
  26 module N = Libvirt.Network
  27
  28 (* Get the selected domain (if there is one) or return None. *)
  29 let get_domain (tree : GTree.view) (model : GTree.tree_store)
  30     (columns : Vc_connections.columns) =
  31   let path, _ = tree#get_cursor () in
  32   match path with
  33   | None -> None                        (* No row at all selected. *)
  34   | Some path ->
  35       let row = model#get_iter path in
  36       (* Visit parent to get the connid.
  37        * If this returns None, then it's a top-level row which is
  38        * selected (ie. a connection), so just ignore.
  39        *)
  40       match model#iter_parent row with
  41       | None -> None
  42       | Some parent ->
  43           try
  44             let (_, col_domname, _, _, _, col_id) = columns in
  45             let connid = model#get ~row:parent ~column:col_id in
  46             let conn =
  47               List.assoc connid (Vc_connections.get_conns ()) in
  48             let domid = model#get ~row ~column:col_id in
  49             if domid = -1 then (        (* Inactive domain. *)
  50               let domname = model#get ~row ~column:col_domname in
  51               let dom = D.lookup_by_name conn domname in
  52               let info = D.get_info dom in
  53               Some (dom, info, connid, -1)
  54             ) else (                    (* Active domU. *)
  55               let dom = D.lookup_by_id conn domid in
  56               let info = D.get_info dom in
  57               Some (dom, info, connid, domid)
  58             )
  59           with
  60             (* Domain or connection disappeared under us. *)
  61           | Not_found -> None
  62           | Failure msg ->
  63               prerr_endline msg;
  64               None
  65           | Libvirt.Virterror err ->
  66               prerr_endline (Libvirt.Virterror.to_string err);
  67               None
  68
  69 type dops_callback_fn =
  70     GTree.view -> GTree.tree_store -> Vc_connections.columns -> unit -> unit
  71
  72 let start_domain tree model columns () =
  73   match get_domain tree model columns with
  74   | None -> ()
  75   | Some (dom, _, _, domid) ->
  76       if domid = -1 then
  77         D.create dom
  78
  79 let pause_domain tree model columns () =
  80   match get_domain tree model columns with
  81   | None -> ()
  82   | Some (dom, info, _, domid) ->
  83       if domid >= 0 && info.D.state <> D.InfoPaused then
  84         D.suspend dom
  85
  86 let resume_domain tree model columns () =
  87   match get_domain tree model columns with
  88   | None -> ()
  89   | Some (dom, info, _, domid) ->
  90       if domid >= 0 && info.D.state = D.InfoPaused then
  91         D.resume dom
  92
  93 let shutdown_domain tree model columns () =
  94   match get_domain tree model columns with
  95   | None -> ()
  96   | Some (dom, info, _, domid) ->
  97       if domid >= 0 && info.D.state <> D.InfoShutdown then
  98         D.shutdown dom
  99
 100 let open_domain_details tree model columns () =
 101   match get_domain tree model columns with
 102   | None -> ()
 103   | Some (dom, info, connid, domid) ->
 104       if domid >= 0 then (
 105
 106
 107
 108       )