boot: Allow template to specify custom libvirt XML.
[mclu.git] / template.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 (* Templates. *)
20
21 open Utils
22
23 open Printf
24
25 let template_dir =
26   try Sys.getenv "MCLU_PATH"
27   with Not_found -> Config.pkgdatadir // "templates"
28
29 let templates () =
30   let files = Sys.readdir template_dir in
31   let files = Array.to_list files in
32   let files = List.map ((//) template_dir) files in
33   let files =
34     List.filter (fun name -> Filename.check_suffix name ".template") files in
35   let templates =
36     List.map (
37       fun filename ->
38         let name = Filename.basename filename in
39         let name = Filename.chop_suffix name ".template" in
40         (name, filename)
41     ) files in
42   List.sort compare templates
43
44 let template_names () = List.map fst (templates ())
45
46 let run_template ~verbose filename subcmd args =
47   let cmd =
48     sprintf "%s %s %s" (quote filename) (quote subcmd)
49       (String.concat " " (List.map quote args)) in
50   if verbose then printf "%s\n%!" cmd;
51   let chan = Unix.open_process_in cmd in
52   let lines = ref [] in
53   (try while true do lines := input_line chan :: !lines done
54    with End_of_file -> ());
55   let lines = List.rev !lines in
56   let stat = Unix.close_process_in chan in
57   (match stat with
58   | Unix.WEXITED 0 -> Some lines
59   | Unix.WEXITED 2 -> None
60   | Unix.WEXITED i ->
61     eprintf "mclu: template '%s' subcmd '%s' exited with error %d\n"
62       filename subcmd i;
63     exit 1
64   | Unix.WSIGNALED i ->
65     eprintf "mclu: template '%s' subcmd '%s' killed by signal %d\n"
66       filename subcmd i;
67     exit 1
68   | Unix.WSTOPPED i ->
69     eprintf "mclu: template '%s' subcmd '%s' stopped by signal %d\n"
70       filename subcmd i;
71     exit 1
72   )
73
74 type template_info = {
75   base_image : string;
76   minimum_memory : int64 option;
77   recommended_memory : int64 option;
78   minimum_size : int64 option;
79   disk_bus : string option;
80   network_model : string option;
81   has_xml_target : bool;
82 }
83
84 let probe ?(verbose = false) filename =
85   (* Check the template is a template. *)
86   (match run_template ~verbose filename "probe" [] with
87   | Some ["hello"] -> ()
88   | _ ->
89     eprintf "mclu: file %s is not an mclu template\n" filename;
90     exit 1
91   );
92
93   (* Probe for various properties. *)
94   let base_image =
95     match run_template ~verbose filename "base-image" [] with
96     | Some [answer] -> answer
97     | _ ->
98       eprintf "mclu: cannot parse '%s base-image'\n" filename;
99       exit 1 in
100   let minimum_memory =
101     match run_template ~verbose filename "minimum-memory" [] with
102     | Some [memory] ->
103       (try Some (bytes_of_human_size memory)
104        with Not_found ->
105          eprintf "mclu: cannot parse output of '%s minimum-memory'\n"
106            filename;
107          exit 1
108       );
109     | _ -> None in
110   let recommended_memory =
111     match run_template ~verbose filename "recommended-memory" [] with
112     | Some [memory] ->
113       (try Some (bytes_of_human_size memory)
114        with Not_found ->
115          eprintf "mclu: cannot parse output of '%s recommended-memory'\n"
116            filename;
117          exit 1
118       );
119     | _ -> None in
120   let minimum_size =
121     match run_template ~verbose filename "minimum-size" [] with
122     | Some [size] ->
123       (try Some (bytes_of_human_size size)
124        with Not_found ->
125          eprintf "mclu: cannot parse output of '%s minimum-size'\n"
126            filename;
127          exit 1
128       );
129     | _ -> None in
130   let disk_bus =
131     match run_template ~verbose filename "disk-bus" [] with
132     | Some [answer] -> Some answer
133     | _ -> None in
134   let network_model =
135     match run_template ~verbose filename "network-model" [] with
136     | Some [answer] -> Some answer
137     | _ -> None in
138
139   let has_xml_target = run_template ~verbose filename "xml" [] <> None in
140
141   { base_image = base_image;
142     minimum_memory = minimum_memory;
143     recommended_memory = recommended_memory;
144     minimum_size = minimum_size;
145     disk_bus = disk_bus;
146     network_model = network_model;
147     has_xml_target = has_xml_target }