slave: Use slightly modified event_callback.

[guestfs-browser.git] / cmdline.ml

diff --git a/cmdline.ml b/cmdline.ml
index 43e0bf6..bab5768 100644 (file)
--- a/cmdline.ml
+++ b/cmdline.ml
@@ -21,62 +21,79 @@ open Printf
 open Utils
 
 type cli_request =
-  | Connect_to_libvirt of string option
-  | Open_disk_image of string list
   | Empty_window
+  | Open_guest of string
+  | Open_images of (string * string option) list
+
+let display_version () =
+  printf "%s %s\n" Config.package Config.version;
+  exit 0
+
+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 command_line () =
-  let connect_uri = ref None in
-  let images = ref [] in
-
-  let argspec = Arg.align [
-    "--verbose", Arg.Unit set_verbose_flag, " Enable debugging messages";
-    "--write", Arg.Unit set_write_flag, " Allow writes to the disk";
-    "--connect", Arg.String (function
-                             | "" -> connect_uri := Some None
-                             | uri -> connect_uri := Some (Some uri)),
-      "uri Connect to libvirt URI";
-  ] in
-
-  let anon_fun image = images := image :: !images in
-
-  let prog = Filename.basename Sys.executable_name in
-
-  let usage_msg =
-    sprintf "\
-
+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 display_version,  " Display version and exit";
+  "--version", Arg.Unit display_version,  " 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 --connect ''
-    Connect to libvirt default URL to get list of guests.
-
-  %s --connect qemu:///system
-    Connect to some libvirt URL to get list of guests.
-    (Note only local libvirt connections are supported).
-
-  %s [--write] disk.img [disk.img [...]]
+  %s -a disk.img [-a disk.img [...]]
     Start with a guest from a disk image file.
 
-Important note: The --write option must NEVER be used for live
-virtual machines.  If you try to write to live VMs you will
-inevitably get disk corruption.
+  %s -d guest
+    Start with the named libvirt guest.
 
 Options:"
-      prog prog prog prog prog in
+    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 connect_uri = !connect_uri in
-
-  match connect_uri, images with
-  | None, [] -> Empty_window
-  | None, images -> Open_disk_image images
-  | Some uri, [] -> Connect_to_libvirt uri
-  | Some uri, images ->
-      failwith "you cannot specify --connect and a list of disk images"
+  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"