1 (* virt-ctrl: A graphical management tool.
2 (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc.
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.
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.
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.
20 open Virt_ctrl_gettext.Gettext
22 module C = Libvirt.Connect
23 module D = Libvirt.Domain
24 module N = Libvirt.Network
26 (* Given two lists, xs and ys, return a list of items which have been
27 * added to ys, items which are the same, and items which have been
29 * Returns a triplet (list of added, list of same, list of removed).
31 let differences xs ys =
33 | [], [] -> (* Base case. *)
35 | [], ys -> (* All ys have been added. *)
37 | xs, [] -> (* All xs have been removed. *)
39 | (x :: xs), (y :: ys) when x = y -> (* Not added or removed. *)
40 let added, unchanged, removed = d (xs, ys) in
41 added, x :: unchanged, removed
42 | (x :: xs), ((y :: _) as ys) when x < y -> (* x removed. *)
43 let added, unchanged, removed = d (xs, ys) in
44 added, unchanged, x :: removed
45 | ((x :: _) as xs), (y :: ys) (* when x > y *) -> (* y added. *)
46 let added, unchanged, removed = d (xs, ys) in
47 y :: added, unchanged, removed
49 d (List.sort compare xs, List.sort compare ys)
51 let string_of_domain_state = function
52 | D.InfoNoState -> s_ "unknown"
53 | D.InfoRunning -> s_ "running"
54 | D.InfoBlocked -> s_ "blocked"
55 | D.InfoPaused -> s_ "paused"
56 | D.InfoShutdown -> s_ "shutdown"
57 | D.InfoShutoff -> s_ "shutoff"
58 | D.InfoCrashed -> s_ "crashed"
60 (* Filter top level rows (only) in a tree_store. If function f returns
61 * true then the row remains, but if it returns false then the row is
64 let rec filter_top_level_rows (model : GTree.tree_store) f =
65 match model#get_iter_first with
67 | Some iter -> filter_rows model f iter
69 (* Filter rows in a tree_store at a particular level. *)
70 and filter_rows model f row =
72 let iter_still_valid =
73 if not keep then model#remove row else model#iter_next row in
74 if iter_still_valid then filter_rows model f row
76 (* Find the first top level row matching predicate f and return it. *)
77 let rec find_top_level_row (model : GTree.tree_store) f =
78 match model#get_iter_first with
79 | None -> raise Not_found (* no rows *)
80 | Some row -> find_row model f row
82 (* Find the first row matching predicate f at a particular level. *)
83 and find_row model f row =
85 else if model#iter_next row then find_row model f row
88 (* Iterate over top level rows (only) in a tree_store. *)
89 let rec iter_top_level_rows (model : GTree.tree_store) f =
90 match model#get_iter_first with
92 | Some iter -> iter_rows model f iter
94 (* Iterate over rows in a tree_store at a particular level. *)
95 and iter_rows model f row =
97 if model#iter_next row then iter_rows model f row