(* Guestfs Browser.
 * Copyright (C) 2010 Red Hat Inc.
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or
 * (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License along
 * with this program; if not, write to the Free Software Foundation, Inc.,
 * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
 *)

open Printf

open Utils

type cli_request =
  | Connect_to_libvirt of string option
  | Open_disk_image of string list
  | Empty_window

(* 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 "\

%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 [...]]
    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.

Options:"
      prog prog prog prog prog in

  Arg.parse argspec anon_fun usage_msg;

  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"