boot: Allow template to specify custom libvirt XML.
[mclu.git] / 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 ())