mlvirtmanager/mlvirtmanager_domain_ops.ml

   1 (* virt-manager-like graphical management tool.
   2    (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc.
   3    http://libvirt.org/
   4    $Id: mlvirtmanager_domain_ops.ml,v 1.1 2007/08/06 10:16:53 rjones Exp $
   5
   6    Domain operations buttons.
   7 *)
   8
   9 open Printf
  10
  11 module C = Libvirt.Connect
  12 module D = Libvirt.Domain
  13 module N = Libvirt.Network
  14
  15 (* Get the selected domain (if there is one) or return None. *)
  16 let get_domain (tree : GTree.view) (model : GTree.tree_store)
  17     (columns : Mlvirtmanager_connections.columns) =
  18   let path, _ = tree#get_cursor () in
  19   match path with
  20   | None -> None                        (* No row at all selected. *)
  21   | Some path ->
  22       let row = model#get_iter path in
  23       (* Visit parent to get the conn_id.
  24        * If this returns None, then it's a top-level row which is
  25        * selected (ie. a connection), so just ignore.
  26        *)
  27       match model#iter_parent row with
  28       | None -> None
  29       | Some parent ->
  30           try
  31             let (_, col_domname, _, _, _, col_id) = columns in
  32             let conn_id = model#get ~row:parent ~column:col_id in
  33             let conn =
  34               List.assoc conn_id (Mlvirtmanager_connections.get_conns ()) in
  35             let domid = model#get ~row ~column:col_id in
  36             if domid = -1 then (        (* Inactive domain. *)
  37               let domname = model#get ~row ~column:col_domname in
  38               let dom = D.lookup_by_name conn domname in
  39               let info = D.get_info dom in
  40               Some (dom, info, -1)
  41             ) else if domid > 0 then (  (* Active domU. *)
  42               let dom = D.lookup_by_id conn domid in
  43               let info = D.get_info dom in
  44               Some (dom, info, domid)
  45             ) else                      (* Dom0 - ignore. *)
  46               None
  47           with
  48             (* Domain or connection disappeared under us. *)
  49           | Not_found -> None
  50           | Failure msg ->
  51               prerr_endline msg;
  52               None
  53           | Libvirt.Virterror err ->
  54               prerr_endline (Libvirt.Virterror.to_string err);
  55               None
  56
  57 let start_domain tree model columns () =
  58   match get_domain tree model columns with
  59   | None -> ()
  60   | Some (dom, _, domid) ->
  61       if domid = -1 then
  62         D.create dom
  63
  64 let pause_domain tree model columns () =
  65   match get_domain tree model columns with
  66   | None -> ()
  67   | Some (dom, info, domid) ->
  68       if domid >= 0 && info.D.state <> D.InfoPaused then
  69         D.suspend dom
  70
  71 let resume_domain tree model columns () =
  72   match get_domain tree model columns with
  73   | None -> ()
  74   | Some (dom, info, domid) ->
  75       if domid >= 0 && info.D.state = D.InfoPaused then
  76         D.resume dom
  77
  78 let shutdown_domain tree model columns () =
  79   match get_domain tree model columns with
  80   | None -> ()
  81   | Some (dom, info, domid) ->
  82       if domid >= 0 && info.D.state <> D.InfoShutdown then
  83         D.shutdown dom