mclu.ml

   1 (* mclu: Mini Cloud
   2  * Copyright (C) 2014-2015 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
  15  * along with this program; if not, write to the Free Software
  16  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  17  *)
  18
  19 open Utils
  20
  21 open Printf
  22
  23 let config_file =
  24   let default =
  25     try Sys.getenv "MCLU_CONFIG"
  26     with Not_found -> Config.sysconfdir // "mclu.conf" in
  27   ref default
  28
  29 let verbose = ref false
  30
  31 let show_version () =
  32   printf "%s %s\n" Config.package_name Config.package_version;
  33   exit 0
  34
  35 let global_speclist = Arg.align [
  36   "--config-file", Arg.Set_string config_file, "FILE Set configuration file";
  37   "-f",            Arg.Set_string config_file, "FILE Set configuration file";
  38   "-v",            Arg.Set verbose, " Enable verbose/debugging messages";
  39   "--verbose",     Arg.Set verbose, " Enable verbose/debugging messages";
  40   "-V",            Arg.Unit show_version, " Display version and exit";
  41   "--version",     Arg.Unit show_version, " Display version and exit";
  42 ]
  43 let speclist = ref global_speclist
  44 let subcommand_run = ref (fun ~verbose _ -> assert false)
  45 let anon_fun, get_anon_args =
  46   let i = ref 0 in
  47   let args = ref [] in
  48   let anon_fun arg =
  49     incr i; let i = !i in
  50     if i = 1 then (
  51       match arg with
  52       | "boot" ->
  53         speclist := Mclu_boot.get_arg_speclist ();
  54         subcommand_run := Mclu_boot.run
  55       | "console" ->
  56         speclist := Mclu_console.get_arg_speclist ();
  57         subcommand_run := Mclu_console.run
  58       | "destroy" ->
  59         speclist := Mclu_destroy.get_arg_speclist ();
  60         subcommand_run := Mclu_destroy.run
  61       | "list" ->
  62         speclist := Mclu_list.get_arg_speclist ();
  63         subcommand_run := Mclu_list.run
  64       | "off" ->
  65         speclist := Mclu_onoff.get_arg_speclist ();
  66         subcommand_run := Mclu_onoff.run ~on:false
  67       | "on" ->
  68         speclist := Mclu_onoff.get_arg_speclist ();
  69         subcommand_run := Mclu_onoff.run ~on:true
  70       | "reboot" ->
  71         speclist := Mclu_reboot.get_arg_speclist ();
  72         subcommand_run := Mclu_reboot.run
  73       | "status" ->
  74         speclist := Mclu_status.get_arg_speclist ();
  75         subcommand_run := Mclu_status.run
  76       | "viewer" ->
  77         speclist := Mclu_viewer.get_arg_speclist ();
  78         subcommand_run := Mclu_viewer.run
  79       | _ ->
  80         eprintf "mclu: unknown subcommand '%s'
  81 For help, use mclu --help or read the mclu(1) man page.\n" arg;
  82         exit 1
  83     )
  84     else
  85       args := arg :: !args
  86   in
  87   let get_anon_args () = List.rev !args in
  88   anon_fun, get_anon_args
  89 let usage_msg = "\
  90 Usage:
  91   mclu [-f mclu.conf] [--options] [list|status|boot|...] ...
  92
  93 For more help, use mclu --help or read the mclu(1) man page.
  94
  95 Options:"
  96
  97 let () =
  98   (* Parse the command line and subcommand arguments. *)
  99   Arg.parse_dynamic speclist anon_fun usage_msg;
 100
 101   (* Load the configuration file. *)
 102   Mclu_conf.load_configuration !config_file;
 103
 104   (* Run the subcommand. *)
 105   let verbose = !verbose in
 106   !subcommand_run ~verbose (get_anon_args ())