2 * Copyright (C) 2010 Red Hat Inc.
4 * This program is free software; you can redistribute it and/or modify
5 * it under the terms of the GNU General Public License as published by
6 * the Free Software Foundation; either version 2 of the License, or
7 * (at your option) any later version.
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 * GNU General Public License for more details.
14 * You should have received a copy of the GNU General Public License along
15 * with this program; if not, write to the Free Software Foundation, Inc.,
16 * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
24 | Connect_to_libvirt of string option
25 | Open_disk_image of string list
28 (* Parse command line arguments. *)
30 let connect_uri = ref None in
31 let images = ref [] in
33 let argspec = Arg.align [
34 "--verbose", Arg.Unit set_verbose_flag, " Enable debugging messages";
35 "--write", Arg.Unit set_write_flag, " Allow writes to the disk";
36 "--connect", Arg.String (function
37 | "" -> connect_uri := Some None
38 | uri -> connect_uri := Some (Some uri)),
39 "uri Connect to libvirt URI";
42 let anon_fun image = images := image :: !images in
44 let prog = Filename.basename Sys.executable_name in
49 %s: graphical guest filesystem browser
53 Open the program with an empty window.
56 Connect to libvirt default URL to get list of guests.
58 %s --connect qemu:///system
59 Connect to some libvirt URL to get list of guests.
60 (Note only local libvirt connections are supported).
62 %s [--write] disk.img [disk.img [...]]
63 Start with a guest from a disk image file.
65 Important note: The --write option must NEVER be used for live
66 virtual machines. If you try to write to live VMs you will
67 inevitably get disk corruption.
70 prog prog prog prog prog in
72 Arg.parse argspec anon_fun usage_msg;
74 let images = List.rev !images in
75 let connect_uri = !connect_uri in
77 match connect_uri, images with
78 | None, [] -> Empty_window
79 | None, images -> Open_disk_image images
80 | Some uri, [] -> Connect_to_libvirt uri
82 failwith "you cannot specify --connect and a list of disk images"