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