cmdline.ml

   1 (* Guestfs Browser.
   2  * Copyright (C) 2010 Red Hat Inc.
   3  *
   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.
   8  *
   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.
  13  *
  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.
  17  *)
  18
  19 open Printf
  20
  21 open Utils
  22
  23 type cli_request =
  24   | Connect_to_libvirt of string option
  25   | Open_disk_image of string list
  26   | Empty_window
  27
  28 (* Parse command line arguments. *)
  29 let command_line () =
  30   let connect_uri = ref None in
  31   let images = ref [] in
  32
  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";
  40   ] in
  41
  42   let anon_fun image = images := image :: !images in
  43
  44   let prog = Filename.basename Sys.executable_name in
  45
  46   let usage_msg =
  47     sprintf "\
  48
  49 %s: graphical guest filesystem browser
  50
  51 Usage:
  52   %s
  53     Open the program with an empty window.
  54
  55   %s --connect ''
  56     Connect to libvirt default URL to get list of guests.
  57
  58   %s --connect qemu:///system
  59     Connect to some libvirt URL to get list of guests.
  60     (Note only local libvirt connections are supported).
  61
  62   %s [--write] disk.img [disk.img [...]]
  63     Start with a guest from a disk image file.
  64
  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.
  68
  69 Options:"
  70       prog prog prog prog prog in
  71
  72   Arg.parse argspec anon_fun usage_msg;
  73
  74   let images = List.rev !images in
  75   let connect_uri = !connect_uri in
  76
  77   match connect_uri, images with
  78   | None, [] -> Empty_window
  79   | None, images -> Open_disk_image images
  80   | Some uri, [] -> Connect_to_libvirt uri
  81   | Some uri, images ->
  82       failwith "you cannot specify --connect and a list of disk images"