2 * Copyright (C) 2014-2015 Red Hat Inc.
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.
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.
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.
26 try Sys.getenv "MCLU_PATH"
27 with Not_found -> Config.pkgdatadir // "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
34 List.filter (fun name -> Filename.check_suffix name ".template") files in
38 let name = Filename.basename filename in
39 let name = Filename.chop_suffix name ".template" in
42 List.sort compare templates
44 let template_names () = List.map fst (templates ())
46 let run_template ~verbose filename subcmd args =
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
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
58 | Unix.WEXITED 0 -> Some lines
59 | Unix.WEXITED 2 -> None
61 eprintf "mclu: template '%s' subcmd '%s' exited with error %d\n"
65 eprintf "mclu: template '%s' subcmd '%s' killed by signal %d\n"
69 eprintf "mclu: template '%s' subcmd '%s' stopped by signal %d\n"
74 type template_info = {
76 guest_arch : string option;
77 minimum_memory : int64 option;
78 recommended_memory : int64 option;
79 minimum_size : int64 option;
80 disk_bus : string option;
81 network_model : string option;
82 has_xml_target : bool;
83 needs_external_kernel : bool;
84 cmdline : string option;
87 let probe ?(verbose = false) filename =
88 (* Check the template is a template. *)
89 (match run_template ~verbose filename "probe" [] with
90 | Some ["hello"] -> ()
92 eprintf "mclu: file %s is not an mclu template\n" filename;
96 (* Probe for various properties. *)
98 match run_template ~verbose filename "base-image" [] with
99 | Some [answer] -> answer
101 eprintf "mclu: cannot parse '%s base-image'\n" filename;
104 match run_template ~verbose filename "guest-arch" [] with
105 | Some [arch] -> Some arch
108 match run_template ~verbose filename "minimum-memory" [] with
110 (try Some (bytes_of_human_size memory)
112 eprintf "mclu: cannot parse output of '%s minimum-memory'\n"
117 let recommended_memory =
118 match run_template ~verbose filename "recommended-memory" [] with
120 (try Some (bytes_of_human_size memory)
122 eprintf "mclu: cannot parse output of '%s recommended-memory'\n"
128 match run_template ~verbose filename "minimum-size" [] with
130 (try Some (bytes_of_human_size size)
132 eprintf "mclu: cannot parse output of '%s minimum-size'\n"
138 match run_template ~verbose filename "disk-bus" [] with
139 | Some [answer] -> Some answer
142 match run_template ~verbose filename "network-model" [] with
143 | Some [answer] -> Some answer
146 let has_xml_target = run_template ~verbose filename "xml" [] <> None in
148 let needs_external_kernel =
149 match run_template ~verbose filename "needs-external-kernel" [] with
151 | Some ["1"|"yes"] -> true
155 match run_template ~verbose filename "cmdline" [] with
156 | Some [cmdline] -> Some cmdline
159 if not needs_external_kernel && cmdline <> None then (
160 eprintf "mclu: template cannot set 'cmdline' unless 'needs-external-kernel' is 'yes'.\n";
164 { base_image = base_image;
165 guest_arch = guest_arch;
166 minimum_memory = minimum_memory;
167 recommended_memory = recommended_memory;
168 minimum_size = minimum_size;
170 network_model = network_model;
171 has_xml_target = has_xml_target;
172 needs_external_kernel = needs_external_kernel;