Daily check-in.

[guestfs-browser.git] / cmdline.ml

diff --git a/cmdline.ml b/cmdline.ml
new file mode 100644 (file)
index 0000000..e0f244b
--- /dev/null
+++ b/cmdline.ml
@@ -0,0 +1,95 @@
+(* Guestfs Browser.
+ * Copyright (C) 2010 Red Hat Inc.
+ *
+ * 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.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+open Printf
+
+open Utils
+
+type cli_request =
+  | Empty_window
+  | Open_guest of string
+  | Open_images of (string * string option) list
+
+let format = ref None
+let images = ref []
+let guests = ref []
+
+let set_connect = function
+  | "" -> set_connect_uri None
+  | uri -> set_connect_uri (Some uri)
+let set_format = function
+  | "" -> format := None
+  | f -> format := Some f
+let add_image image =
+  images := (image, !format) :: !images
+let add_guest guest =
+  guests := guest :: !guests
+
+(* Parse command line arguments. *)
+let argspec = Arg.align [
+  "-a",        Arg.String add_image,      "image Open disk image";
+  "--add",     Arg.String add_image,      "image Open disk image";
+  "-c",        Arg.String set_connect,    "uri Connect to libvirt URI";
+  "--connect", Arg.String set_connect,    "uri Connect to libvirt URI";
+  "-d",        Arg.String add_guest,      "guest Open libvirt guest";
+  "--domain",  Arg.String add_guest,      "guest Open libvirt guest";
+  "--format",  Arg.String set_format,     "format Set format";
+  "-v",        Arg.Unit set_verbose_flag, " Enable debugging messages";
+  "--verbose", Arg.Unit set_verbose_flag, " Enable debugging messages";
+  "-V",        Arg.Unit set_verbose_flag, " Display version and exit";
+  "--version", Arg.Unit set_verbose_flag, " Display version and exit";
+  "-x",        Arg.Unit set_trace_flag,   " Enable tracing of libguestfs calls";
+]
+
+let prog = Filename.basename Sys.executable_name
+
+let anon_fun _ =
+  raise (Arg.Bad "unknown argument")
+
+let usage_msg =
+  sprintf "\
+%s: graphical guest filesystem browser
+
+Usage:
+  %s
+    Open the program with an empty window.
+
+  %s -a disk.img [-a disk.img [...]]
+    Start with a guest from a disk image file.
+
+  %s -d guest
+    Start with the named libvirt guest.
+
+Options:"
+    prog prog prog prog
+
+let command_line () =
+  Arg.parse argspec anon_fun usage_msg;
+
+  (* Verify number of -a and -d options given on the command line. *)
+  let images = List.rev !images in
+  let guests = List.rev !guests in
+
+  match images, guests with
+  | [], [] -> Empty_window
+  | _, [] -> Open_images images
+  | [], [guest] -> Open_guest guest
+  | [], _ ->
+      failwith "cannot use -d option more than once"
+  | _, _ ->
+      failwith "cannot mix -a and -d options"