mclu version 2

[mclu.git] / template.ml

diff --git a/template.ml b/template.ml
new file mode 100644 (file)
index 0000000..fffc0e4
--- /dev/null
+++ b/template.ml
@@ -0,0 +1,129 @@
+(* mclu: Mini Cloud
+ * Copyright (C) 2014-2015 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+(* Templates. *)
+
+open Utils
+
+open Printf
+
+let template_dir =
+  try Sys.getenv "MCLU_PATH"
+  with Not_found -> Config.pkgdatadir // "templates"
+
+let templates () =
+  let files = Sys.readdir template_dir in
+  let files = Array.to_list files in
+  let files = List.map ((//) template_dir) files in
+  let files =
+    List.filter (fun name -> Filename.check_suffix name ".template") files in
+  List.map (
+    fun filename ->
+      let name = Filename.basename filename in
+      let name = Filename.chop_suffix name ".template" in
+      (name, filename)
+  ) files
+
+let template_names () = List.map fst (templates ())
+
+let run_template ~verbose filename subcmd args =
+  let cmd =
+    sprintf "%s %s %s" (quote filename) (quote subcmd)
+      (String.concat " " (List.map quote args)) in
+  if verbose then printf "%s\n%!" cmd;
+  let chan = Unix.open_process_in cmd in
+  let lines = ref [] in
+  (try while true do lines := input_line chan :: !lines done
+   with End_of_file -> ());
+  let lines = List.rev !lines in
+  let stat = Unix.close_process_in chan in
+  (match stat with
+  | Unix.WEXITED 0 -> Some lines
+  | Unix.WEXITED 2 -> None
+  | Unix.WEXITED i ->
+    eprintf "mclu: template '%s' subcmd '%s' exited with error %d\n"
+      filename subcmd i;
+    exit 1
+  | Unix.WSIGNALED i ->
+    eprintf "mclu: template '%s' subcmd '%s' killed by signal %d\n"
+      filename subcmd i;
+    exit 1
+  | Unix.WSTOPPED i ->
+    eprintf "mclu: template '%s' subcmd '%s' stopped by signal %d\n"
+      filename subcmd i;
+    exit 1
+  )
+
+type template_info = {
+  base_image : string;
+  minimum_memory : int64 option;
+  recommended_memory : int64 option;
+  disk_bus : string option;
+  network_model : string option;
+}
+
+let probe ?(verbose = false) filename =
+  (* Check the template is a template. *)
+  (match run_template ~verbose filename "probe" [] with
+  | Some ["hello"] -> ()
+  | _ ->
+    eprintf "mclu: file %s is not an mclu template\n" filename;
+    exit 1
+  );
+
+  (* Probe for various properties. *)
+  let base_image =
+    match run_template ~verbose filename "base-image" [] with
+    | Some [answer] -> answer
+    | _ ->
+      eprintf "mclu: cannot parse '%s base-image'\n" filename;
+      exit 1 in
+  let minimum_memory =
+    match run_template ~verbose filename "minimum-memory" [] with
+    | Some [memory] ->
+      (try Some (bytes_of_human_size memory)
+       with Not_found ->
+         eprintf "mclu: cannot parse output of '%s minimum-memory'\n"
+           filename;
+         exit 1
+      );
+    | _ -> None in
+  let recommended_memory =
+    match run_template ~verbose filename "recommended-memory" [] with
+    | Some [memory] ->
+      (try Some (bytes_of_human_size memory)
+       with Not_found ->
+         eprintf "mclu: cannot parse output of '%s recommended-memory'\n"
+           filename;
+         exit 1
+      );
+    | _ -> None in
+  let disk_bus =
+    match run_template ~verbose filename "disk-bus" [] with
+    | Some [answer] -> Some answer
+    | _ -> None in
+  let network_model =
+    match run_template ~verbose filename "network-model" [] with
+    | Some [answer] -> Some answer
+    | _ -> None in
+
+  { base_image = base_image;
+    minimum_memory = minimum_memory;
+    recommended_memory = recommended_memory;
+    disk_bus = disk_bus;
+    network_model = network_model }