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 conn_id.
  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 conn_id = model#get ~row:parent ~column:col_id in
  46             let conn =
  47               List.assoc conn_id (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, -1)
  54             ) else if domid > 0 then (  (* Active domU. *)
  55               let dom = D.lookup_by_id conn domid in
  56               let info = D.get_info dom in
  57               Some (dom, info, domid)
  58             ) else                      (* Dom0 - ignore. *)
  59               None
  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 let start_domain tree model columns () =
  71   match get_domain tree model columns with
  72   | None -> ()
  73   | Some (dom, _, domid) ->
  74       if domid = -1 then
  75         D.create dom
  76
  77 let pause_domain tree model columns () =
  78   match get_domain tree model columns with
  79   | None -> ()
  80   | Some (dom, info, domid) ->
  81       if domid >= 0 && info.D.state <> D.InfoPaused then
  82         D.suspend dom
  83
  84 let resume_domain tree model columns () =
  85   match get_domain tree model columns with
  86   | None -> ()
  87   | Some (dom, info, domid) ->
  88       if domid >= 0 && info.D.state = D.InfoPaused then
  89         D.resume dom
  90
  91 let shutdown_domain tree model columns () =
  92   match get_domain tree model columns with
  93   | None -> ()
  94   | Some (dom, info, domid) ->
  95       if domid >= 0 && info.D.state <> D.InfoShutdown then
  96         D.shutdown dom