X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=cmdline.ml;h=bab5768bde07153c274a68cfff52d55b28e20514;hb=f91c6fe39b0c5b016758f85bdeee28911314a9bd;hp=43e0bf64df523c95a2cfbd0d9bea5e05b12f9bc7;hpb=b07102fda0034da5840a9f33bd6d404a195b8cc9;p=guestfs-browser.git diff --git a/cmdline.ml b/cmdline.ml index 43e0bf6..bab5768 100644 --- 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"