dfeae3f08e79862dd595efbe6d1cbf9211490364
[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   disk_bus : string option;
79   network_model : string option;
80 }
81
82 let probe ?(verbose = false) filename =
83   (* Check the template is a template. *)
84   (match run_template ~verbose filename "probe" [] with
85   | Some ["hello"] -> ()
86   | _ ->
87     eprintf "mclu: file %s is not an mclu template\n" filename;
88     exit 1
89   );
90
91   (* Probe for various properties. *)
92   let base_image =
93     match run_template ~verbose filename "base-image" [] with
94     | Some [answer] -> answer
95     | _ ->
96       eprintf "mclu: cannot parse '%s base-image'\n" filename;
97       exit 1 in
98   let minimum_memory =
99     match run_template ~verbose filename "minimum-memory" [] with
100     | Some [memory] ->
101       (try Some (bytes_of_human_size memory)
102        with Not_found ->
103          eprintf "mclu: cannot parse output of '%s minimum-memory'\n"
104            filename;
105          exit 1
106       );
107     | _ -> None in
108   let recommended_memory =
109     match run_template ~verbose filename "recommended-memory" [] with
110     | Some [memory] ->
111       (try Some (bytes_of_human_size memory)
112        with Not_found ->
113          eprintf "mclu: cannot parse output of '%s recommended-memory'\n"
114            filename;
115          exit 1
116       );
117     | _ -> None in
118   let disk_bus =
119     match run_template ~verbose filename "disk-bus" [] with
120     | Some [answer] -> Some answer
121     | _ -> None in
122   let network_model =
123     match run_template ~verbose filename "network-model" [] with
124     | Some [answer] -> Some answer
125     | _ -> None in
126
127   { base_image = base_image;
128     minimum_memory = minimum_memory;
129     recommended_memory = recommended_memory;
130     disk_bus = disk_bus;
131     network_model = network_model }