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