boot: Allow template to specify custom libvirt XML.
[mclu.git] / mclu_conf.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 (* Parsing /etc/mclu.conf *)
20
21 open Printf
22
23 (* blank line *)
24 let is_blank_line =
25   let rex = Pcre.regexp "^\\s*$" in
26   Pcre.pmatch ~rex
27
28 (* comment *)
29 let is_comment =
30   let rex = Pcre.regexp "^\\s*#" in
31   Pcre.pmatch ~rex
32
33 (* [header] *)
34 let is_header =
35   let rex = Pcre.regexp "^\\s*\\[(\\w+)\\]\\s*$" in
36   fun line ->
37     try
38       let subs = Pcre.exec ~rex line in
39       Some (Pcre.get_substring subs 1)
40     with
41       Not_found -> None
42
43 let ws_rex = Pcre.regexp "\\s+"
44
45 type node = {
46   hostname : string;
47   libvirt_uri : string;
48   mac_addr : string option;
49 }
50
51 let _nodes : node list ref = ref []
52
53 let load_configuration config_file =
54   let chan =
55     try open_in config_file
56     with Sys_error msg ->
57       eprintf "mclu: %s: cannot open configuration file: %s\n" config_file msg;
58       exit 1 in
59   let rec loop section =
60     let line = input_line chan in
61     if is_blank_line line || is_comment line then
62       loop section
63     else (
64       match is_header line with
65       | Some "nodes" ->
66         loop `Nodes
67       | Some section ->
68         (* Ignore unknown sections and keep going. *)
69         printf "mclu: %s: warning: ignoring unknown section [%s]\n"
70           config_file section;
71         loop `Unknown
72       | None ->
73         (* How we parse lines within sections depends on the header. *)
74         match section with
75         | `Nodes ->
76           (* If we're in the [nodes] section, parse "hostname [key=value].." *)
77           (match Pcre.split ~rex:ws_rex line with
78           | [] -> assert false
79           | hostname :: defs ->
80             let node = {
81               hostname = hostname;
82               libvirt_uri = sprintf "qemu+ssh://root@%s/system" hostname;
83               mac_addr = None
84             } in
85             let node = List.fold_left (
86               fun node def ->
87                 match Pcre.split ~pat:"=" ~max:2 def with
88                 | ["mac"; value] -> { node with mac_addr = Some value }
89                 | ["uri"; value] -> { node with libvirt_uri = value }
90                 | [_] -> node           (* key with no value - ignore *)
91                 | [_; _] -> node        (* unknown key=value - ignore *)
92                 | _ -> assert false
93             ) node defs in
94             _nodes := node :: !_nodes;
95             loop section
96           )
97         | `Global
98         | `Unknown ->
99           (* Ignore the line. *)
100           printf "mclu: %s: warning: ignoring `%s'\n" config_file line;
101           loop section
102     )
103   in
104   (try
105      loop `Global
106    with End_of_file -> ()
107   );
108   close_in chan;
109
110   _nodes := List.rev !_nodes
111
112 (* Get list of nodes. *)
113 let nodes () = !_nodes