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