summaryrefslogtreecommitdiffstats
path: root/virt-ctrl/vc_domain_ops.ml
blob: 787e71ea6f73d511d2aacfc527e08634eeac554c (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
(* virt-ctrl: A graphical management tool.
   (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc.
   http://libvirt.org/

   This program is free software; you can redistribute it and/or modify
   it under the terms of the GNU General Public License as published by
   the Free Software Foundation; either version 2 of the License, or
   (at your option) any later version.

   This program is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   GNU General Public License for more details.

   You should have received a copy of the GNU General Public License
   along with this program; if not, write to the Free Software
   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

   Domain operations buttons.
*)

open Printf

module C = Libvirt.Connect
module D = Libvirt.Domain
module N = Libvirt.Network

(* Get the selected domain (if there is one) or return None. *)
let get_domain (tree : GTree.view) (model : GTree.tree_store)
    (columns : Vc_connections.columns) =
  let path, _ = tree#get_cursor () in
  match path with
  | None -> None			(* No row at all selected. *)
  | Some path ->
      let row = model#get_iter path in
      (* Visit parent to get the connid.
       * If this returns None, then it's a top-level row which is
       * selected (ie. a connection), so just ignore.
       *)
      match model#iter_parent row with
      | None -> None
      | Some parent ->
	  try
	    let (_, col_domname, _, _, _, col_id) = columns in
	    let connid = model#get ~row:parent ~column:col_id in
	    let conn =
	      List.assoc connid (Vc_connections.get_conns ()) in
	    let domid = model#get ~row ~column:col_id in
	    if domid = -1 then (	(* Inactive domain. *)
	      let domname = model#get ~row ~column:col_domname in
	      let dom = D.lookup_by_name conn domname in
	      let info = D.get_info dom in
	      Some (dom, info, connid, -1)
	    ) else (			(* Active domU. *)
	      let dom = D.lookup_by_id conn domid in
	      let info = D.get_info dom in
	      Some (dom, info, connid, domid)
	    )
	  with
	    (* Domain or connection disappeared under us. *)
	  | Not_found -> None
	  | Failure msg ->
	      prerr_endline msg;
	      None
	  | Libvirt.Virterror err ->
	      prerr_endline (Libvirt.Virterror.to_string err);
	      None

type dops_callback_fn =
    GTree.view -> GTree.tree_store -> Vc_connections.columns -> unit -> unit

let start_domain tree model columns () =
  match get_domain tree model columns with
  | None -> ()
  | Some (dom, _, _, domid) ->
      if domid = -1 then
	D.create dom

let pause_domain tree model columns () =
  match get_domain tree model columns with
  | None -> ()
  | Some (dom, info, _, domid) ->
      if domid >= 0 && info.D.state <> D.InfoPaused then
	D.suspend dom

let resume_domain tree model columns () =
  match get_domain tree model columns with
  | None -> ()
  | Some (dom, info, _, domid) ->
      if domid >= 0 && info.D.state = D.InfoPaused then
	D.resume dom

let shutdown_domain tree model columns () =
  match get_domain tree model columns with
  | None -> ()
  | Some (dom, info, _, domid) ->
      if domid >= 0 && info.D.state <> D.InfoShutdown then
	D.shutdown dom

let open_domain_details tree model columns () =
  match get_domain tree model columns with
  | None -> ()
  | Some (dom, info, connid, domid) ->
      if domid >= 0 then (



      )