boot: Allow template to specify custom libvirt XML.

diff --git a/mclu.pod b/mclu.pod
index aeff24b..54bc6f0 100644 (file)
--- a/mclu.pod
+++ b/mclu.pod
@@ -324,6 +324,42 @@ The template MAY print the recommended amount of memory (RAM), used if
 the user does not select any other value.  Abbreviations like C<2G>
 are supported.
 
+=item xml
+
+The template MAY specify custom libvirt XML.  Usually you should
+I<not> specify this.  It is only used when you need very odd guest
+configuration (especially when emulating other architectures).
+
+The following environment variables are passed to the template:
+
+=over 4
+
+=item C<$name>
+
+The guest name.
+
+=item C<$format>
+
+The disk format (eg. C<qcow2>).
+
+=item C<$output>
+
+The disk file name.
+
+=item C<$memory_kb>
+
+The size of the RAM in kilobytes.
+
+=item C<$vcpus>
+
+The number of virtual CPUs.
+
+=item C<$mac_addr>
+
+The MAC address.
+
+=back
+
 =back
 
 =head1 ENVIRONMENT VARIABLES

diff --git a/mclu_boot.ml b/mclu_boot.ml
index 451beb8..16b8ac9 100644 (file)
--- a/mclu_boot.ml
+++ b/mclu_boot.ml
@@ -163,6 +163,7 @@ Try: `mclu on %s'\n" hostname hostname;
   let format, extension = "qcow2", "qcow2" in
   let remote_template = sprintf "/tmp/mclu%s.sh" (string_random8 ()) in
   let remote_template_wrapper = sprintf "/tmp/mclu%s.sh" (string_random8 ()) in
+  let xml_template_wrapper = sprintf "/tmp/mclu%s.sh" (string_random8 ()) in
   let remote_image = sprintf "/var/tmp/%s.%s" name extension in
 
   (* Get ready to generate the guest XML. *)
@@ -174,8 +175,10 @@ Try: `mclu on %s'\n" hostname hostname;
     sprintf "52:54:00:%02x:%02x:%02x"
       (Random.int 256) (Random.int 256) (Random.int 256) in
 
-  (* Generate the guest XML.  XXX Quoting. *)
-  let xml = sprintf "\
+  (* Generate the guest XML. *)
+  let generate_standard_xml () =
+    (* XXX Better quoting. *)
+    let xml = sprintf "\
 <domain type='kvm'>
   <name>%s</name>
   <memory unit='KiB'>%Ld</memory>
@@ -202,12 +205,12 @@ Try: `mclu on %s'\n" hostname hostname;
   <devices>
 " name (memory /^ 1024L) (memory /^ 1024L) vcpus in
 
-  let xml = xml ^ sprintf "\
+    let xml = xml ^ sprintf "\
   <disk type='file' device='disk'>
     <driver name='qemu' type='%s' cache='none' io='native'/>
     <source file='%s'/>
 " format remote_image in
-  let xml = xml ^
+    let xml = xml ^
     match template_info.Template.disk_bus with
     | Some "ide" ->
       "      <target dev='sda' bus='ide'/>\n"
@@ -216,22 +219,23 @@ Try: `mclu on %s'\n" hostname hostname;
     | Some bus ->
       eprintf "mclu: unknown disk-bus: %s\n" bus;
       exit 1 in
-  let xml = xml ^ "\
+    let xml = xml ^ "\
     </disk>
 " in
 
-  let xml = xml ^
-    if template_info.Template.disk_bus = Some "virtio-scsi" then
-      "  <controller type='scsi' index='0' model='virtio-scsi'/>\n"
-    else
-      "" in
-
-  (* XXX Don't hard-code bridge name here. *)
-  let network_model =
-    match template_info with
-    | { Template.network_model = None } -> "virtio"
-    | { Template.network_model = Some d } -> d in
-  let xml = xml ^ sprintf "\
+    let xml =
+      xml ^
+        if template_info.Template.disk_bus = Some "virtio-scsi" then
+          "  <controller type='scsi' index='0' model='virtio-scsi'/>\n"
+        else
+          "" in
+
+    (* XXX Don't hard-code bridge name here. *)
+    let network_model =
+      match template_info with
+      | { Template.network_model = None } -> "virtio"
+      | { Template.network_model = Some d } -> d in
+    let xml = xml ^ sprintf "\
     <interface type='bridge'>
       <mac address='%s'/>
       <source bridge='br0'/>
@@ -239,7 +243,7 @@ Try: `mclu on %s'\n" hostname hostname;
     </interface>
 " mac_addr network_model in
 
-  let xml = xml ^ "\
+    let xml = xml ^ "\
     <serial type='pty'>
       <target port='0'/>
     </serial>
@@ -255,6 +259,56 @@ Try: `mclu on %s'\n" hostname hostname;
     </video>
   </devices>
 </domain>" in
+    xml
+
+  and generate_custom_xml () =
+    (* Generate a wrapper script to make passing the variables
+     * to the template easier.
+     *)
+    let () =
+      let chan = open_out xml_template_wrapper in
+      let fpf fs = fprintf chan fs in
+      fpf "#!/bin/sh\n";
+      fpf "export format=%s\n" (quote format);
+      fpf "export mac_addr=%s\n" (quote mac_addr);
+      fpf "export memory_kb=%Ld\n" (memory /^ 1024L);
+      fpf "export name=%s\n" (quote name);
+      fpf "export output=%s\n" (quote remote_image);
+      fpf "export vcpus=%d\n" vcpus;
+      fpf "%s xml\n" template_filename;
+      close_out chan;
+      Unix.chmod xml_template_wrapper 0o755 in
+
+    if verbose then printf "%s\n%!" xml_template_wrapper;
+    let chan = Unix.open_process_in xml_template_wrapper in
+    let lines = ref [] in
+    (try while true do lines := input_line chan :: !lines done
+     with End_of_file -> ());
+    let stat = Unix.close_process_in chan in
+    (match stat with
+     | Unix.WEXITED 0 -> ()
+     | Unix.WEXITED i ->
+        eprintf "mclu: template '%s' subcmd xml exited with error %d\n"
+                template_filename i;
+        exit 1
+     | Unix.WSIGNALED i ->
+        eprintf "mclu: template '%s' subcmd xml killed by signal %d\n"
+                template_filename i;
+        exit 1
+     | Unix.WSTOPPED i ->
+        eprintf "mclu: template '%s' subcmd xml stopped by signal %d\n"
+                template_filename i;
+        exit 1
+    );
+    let xml = String.concat "\n" (List.rev !lines) in
+    xml
+  in
+
+  let xml =
+    if not template_info.Template.has_xml_target then
+      generate_standard_xml ()
+    else
+      generate_custom_xml () in
 
   (* Copy the template to remote. *)
   let cmd =

diff --git a/template.ml b/template.ml
index 29af293..428ffe4 100644 (file)
--- a/template.ml
+++ b/template.ml
@@ -78,6 +78,7 @@ type template_info = {
   minimum_size : int64 option;
   disk_bus : string option;
   network_model : string option;
+  has_xml_target : bool;
 }
 
 let probe ?(verbose = false) filename =
@@ -135,9 +136,12 @@ let probe ?(verbose = false) filename =
     | Some [answer] -> Some answer
     | _ -> None in
 
+  let has_xml_target = run_template ~verbose filename "xml" [] <> None in
+
   { base_image = base_image;
     minimum_memory = minimum_memory;
     recommended_memory = recommended_memory;
     minimum_size = minimum_size;
     disk_bus = disk_bus;
-    network_model = network_model }
+    network_model = network_model;
+    has_xml_target = has_xml_target }

diff --git a/template.mli b/template.mli
index 635ca55..470baeb 100644 (file)
--- a/template.mli
+++ b/template.mli
@@ -31,6 +31,7 @@ type template_info = {
   minimum_size : int64 option;
   disk_bus : string option;
   network_model : string option;
+  has_xml_target : bool;
 }
 
 val probe : ?verbose:bool -> string -> template_info