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   | Empty_window
  25   | Open_guest of string
  26   | Open_images of (string * string option) list
  27
  28 let format = ref None
  29 let images = ref []
  30 let guests = ref []
  31
  32 let set_connect = function
  33   | "" -> set_connect_uri None
  34   | uri -> set_connect_uri (Some uri)
  35 let set_format = function
  36   | "" -> format := None
  37   | f -> format := Some f
  38 let add_image image =
  39   images := (image, !format) :: !images
  40 let add_guest guest =
  41   guests := guest :: !guests
  42
  43 (* Parse command line arguments. *)
  44 let argspec = Arg.align [
  45   "-a",        Arg.String add_image,      "image Open disk image";
  46   "--add",     Arg.String add_image,      "image Open disk image";
  47   "-c",        Arg.String set_connect,    "uri Connect to libvirt URI";
  48   "--connect", Arg.String set_connect,    "uri Connect to libvirt URI";
  49   "-d",        Arg.String add_guest,      "guest Open libvirt guest";
  50   "--domain",  Arg.String add_guest,      "guest Open libvirt guest";
  51   "--format",  Arg.String set_format,     "format Set format";
  52   "-v",        Arg.Unit set_verbose_flag, " Enable debugging messages";
  53   "--verbose", Arg.Unit set_verbose_flag, " Enable debugging messages";
  54   "-V",        Arg.Unit set_verbose_flag, " Display version and exit";
  55   "--version", Arg.Unit set_verbose_flag, " Display version and exit";
  56   "-x",        Arg.Unit set_trace_flag,   " Enable tracing of libguestfs calls";
  57 ]
  58
  59 let prog = Filename.basename Sys.executable_name
  60
  61 let anon_fun _ =
  62   raise (Arg.Bad "unknown argument")
  63
  64 let usage_msg =
  65   sprintf "\
  66 %s: graphical guest filesystem browser
  67
  68 Usage:
  69   %s
  70     Open the program with an empty window.
  71
  72   %s -a disk.img [-a disk.img [...]]
  73     Start with a guest from a disk image file.
  74
  75   %s -d guest
  76     Start with the named libvirt guest.
  77
  78 Options:"
  79     prog prog prog prog
  80
  81 let command_line () =
  82   Arg.parse argspec anon_fun usage_msg;
  83
  84   (* Verify number of -a and -d options given on the command line. *)
  85   let images = List.rev !images in
  86   let guests = List.rev !guests in
  87
  88   match images, guests with
  89   | [], [] -> Empty_window
  90   | _, [] -> Open_images images
  91   | [], [guest] -> Open_guest guest
  92   | [], _ ->
  93       failwith "cannot use -d option more than once"
  94   | _, _ ->
  95       failwith "cannot mix -a and -d options"