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.
19 (* Implement 'mclu boot'. *)
21 module C = Libvirt.Connect
22 module D = Libvirt.Domain
23 module MS = Mclu_status
29 let memory = ref 0L (* 0 = choose for me *)
31 try memory := bytes_of_human_size s
33 eprintf "mclu: don't understand --memory parameter '%s'
34 Try something like --memory 1G\n" s;
36 let size = ref 0L (* 0 = default *)
38 try size := bytes_of_human_size s
40 eprintf "mclu: don't understand --size parameter '%s'
41 Try something like --size 20G\n" s;
43 let timezone = ref "" (* "" = no timezone set *)
44 let vcpus = ref 0 (* 0 = choose for me *)
46 let open_console = ref false
47 let open_viewer = ref false
49 let get_arg_speclist () = Arg.align [
50 "--console", Arg.Set open_console, " Open the serial console";
51 "--cpus", Arg.Set_int vcpus, "n Number of virtual CPUs";
52 "--memory", Arg.String set_memory, "nnG Amount of RAM to give guest";
53 "--ram", Arg.String set_memory, "nnG Amount of RAM to give guest";
54 "--size", Arg.String set_size, "nnG Size of disk to give guest";
55 "--timezone", Arg.Set_string timezone, "TZ Set timezone of guest";
56 "--vcpus", Arg.Set_int vcpus, "n Number of virtual CPUs";
57 "--viewer", Arg.Set open_viewer, " Open the graphical console";
60 let boot ~verbose template name =
61 let templates = Template.templates () in
63 (* Does the template exist? *)
64 let template_filename =
65 try List.assoc template templates
67 eprintf "mclu: template %s not found
68 Try `mclu list --templates' to list all known templates.\n" template;
71 (* Probe the template for various features. *)
72 let template_info = Template.probe ~verbose template_filename in
74 (* Check --size is not too small. *)
76 match !size, template_info.Template.minimum_size with
77 | 0L, None -> 0L (* virt-builder default *)
78 | 0L, Some min_size -> (* go with template minimum size *)
80 | size, Some min_size when size < min_size ->
81 eprintf "mclu: --size parameter is smaller than the minimum specified by the template (%s).\n"
82 (human_size min_size);
84 | size, _ -> size in (* go with user-specified size *)
86 (* Decide how much RAM we will give the guest. This affects our
87 * choice of node, so do it early.
89 let memory = !memory in
92 (* User requested, just check it's above the minimum. *)
93 match template_info.Template.minimum_memory with
95 | Some min when min > memory ->
96 eprintf "mclu: minimum memory for this template is %s\n"
101 (* User didn't request any memory setting, use the recommended. *)
102 match template_info.Template.recommended_memory with
103 | Some memory -> memory
104 | None -> 4L *^ 1024L *^ 1024L *^ 1024L (* 4 GB *)
107 (* Check what's running. *)
108 let summary = MS.node_guest_summary ~verbose () in
110 (* Did the user request a specific host? If not, choose one. *)
112 match name_parse name with
113 | Some hostname, name -> hostname, name
115 (* Choose the first host with enough free memory. *)
116 let nodes = List.filter (
117 fun { MS.free_memory = free_memory } -> free_memory >= memory
121 eprintf "mclu: no node with enough free memory found
122 Try: `mclu status' and `mclu on <node>'\n";
126 node.MS.node_status.MS.node.Mclu_conf.hostname in
129 (* Check there isn't a guest with this name running anywhere
130 * in the cluster already.
133 fun ({ MS.active_guests = guests } as node) ->
135 fun { Mclu_list.dom_name = n } ->
138 node.MS.node_status.MS.node.Mclu_conf.hostname
140 eprintf "mclu: there is already a guest called '%s' (running on %s)\n"
147 (* Convert hostname to a specific node, and check it is up. *)
151 node.MS.node_status.MS.node.Mclu_conf.hostname = hostname
154 eprintf "mclu: no node is called '%s'\n" hostname;
156 if not node.MS.node_status.MS.node_on then (
157 eprintf "mclu: node '%s' is switched off
158 Try: `mclu on %s'\n" hostname hostname;
162 (* Where we upload the template and image on remote. *)
163 let format, extension = "qcow2", "qcow2" in
164 let remote_template = sprintf "/tmp/mclu%s.sh" (string_random8 ()) in
165 let remote_template_wrapper = sprintf "/tmp/mclu%s.sh" (string_random8 ()) in
166 let xml_template_wrapper = sprintf "/tmp/mclu%s.sh" (string_random8 ()) in
167 let remote_image = sprintf "/var/tmp/%s.%s" name extension in
169 (* Get ready to generate the guest XML. *)
170 let vcpus = !vcpus in
172 if vcpus > 0 then vcpus
173 else min 4 node.MS.node_status.MS.node_info.C.cpus in
175 sprintf "52:54:00:%02x:%02x:%02x"
176 (Random.int 256) (Random.int 256) (Random.int 256) in
178 (* Generate the guest XML. *)
179 let generate_standard_xml () =
180 (* XXX Better quoting. *)
184 <memory unit='KiB'>%Ld</memory>
185 <currentMemory unit='KiB'>%Ld</currentMemory>
196 <cpu mode='host-model' fallback='allow' />
198 <timer name='rtc' tickpolicy='catchup'/>
199 <timer name='pit' tickpolicy='delay'/>
200 <timer name='hpet' present='no'/>
202 <on_poweroff>destroy</on_poweroff>
203 <on_reboot>restart</on_reboot>
204 <on_crash>restart</on_crash>
206 " name (memory /^ 1024L) (memory /^ 1024L) vcpus in
208 let xml = xml ^ sprintf "\
209 <disk type='file' device='disk'>
210 <driver name='qemu' type='%s' cache='none' io='native'/>
212 " format remote_image in
214 match template_info.Template.disk_bus with
216 " <target dev='sda' bus='ide'/>\n"
217 | Some "virtio-scsi" | None ->
218 " <target dev='sda' bus='scsi'/>\n"
220 eprintf "mclu: unknown disk-bus: %s\n" bus;
228 if template_info.Template.disk_bus = Some "virtio-scsi" then
229 " <controller type='scsi' index='0' model='virtio-scsi'/>\n"
233 (* XXX Don't hard-code bridge name here. *)
235 match template_info with
236 | { Template.network_model = None } -> "virtio"
237 | { Template.network_model = Some d } -> d in
238 let xml = xml ^ sprintf "\
239 <interface type='bridge'>
241 <source bridge='br0'/>
244 " mac_addr network_model in
251 <target type='serial' port='0'/>
253 <input type='tablet' bus='usb'/>
254 <input type='mouse' bus='ps2'/>
255 <input type='keyboard' bus='ps2'/>
256 <graphics type='vnc' autoport='yes'/>
258 <model type='cirrus' vram='9216' heads='1'/>
264 and generate_custom_xml () =
265 (* Generate a wrapper script to make passing the variables
266 * to the template easier.
269 let chan = open_out xml_template_wrapper in
270 let fpf fs = fprintf chan fs in
272 fpf "export format=%s\n" (quote format);
273 fpf "export mac_addr=%s\n" (quote mac_addr);
274 fpf "export memory_kb=%Ld\n" (memory /^ 1024L);
275 fpf "export name=%s\n" (quote name);
276 fpf "export output=%s\n" (quote remote_image);
277 fpf "export vcpus=%d\n" vcpus;
278 fpf "%s xml\n" template_filename;
280 Unix.chmod xml_template_wrapper 0o755 in
282 if verbose then printf "%s\n%!" xml_template_wrapper;
283 let chan = Unix.open_process_in xml_template_wrapper in
284 let lines = ref [] in
285 (try while true do lines := input_line chan :: !lines done
286 with End_of_file -> ());
287 let stat = Unix.close_process_in chan in
289 | Unix.WEXITED 0 -> ()
291 eprintf "mclu: template '%s' subcmd xml exited with error %d\n"
294 | Unix.WSIGNALED i ->
295 eprintf "mclu: template '%s' subcmd xml killed by signal %d\n"
299 eprintf "mclu: template '%s' subcmd xml stopped by signal %d\n"
303 let xml = String.concat "\n" (List.rev !lines) in
308 if not template_info.Template.has_xml_target then
309 generate_standard_xml ()
311 generate_custom_xml () in
313 (* Copy the template to remote. *)
315 sprintf "scp %s root@%s:%s"
316 (quote template_filename) (quote hostname) remote_template in
317 if verbose then printf "%s\n%!" cmd;
318 if Sys.command cmd <> 0 then (
319 eprintf "mclu: scp template to remote failed\n";
323 (* Create a wrapper script that sets the variables and runs the
324 * template. This just avoids complex quoting.
327 let chan = open_out remote_template_wrapper in
328 let fpf fs = fprintf chan fs in
330 (* XXX Don't hard-code network_bridge here. *)
331 fpf "export LIBGUESTFS_BACKEND_SETTINGS=network_bridge=br0\n";
332 fpf "export base_image=%s\n" (quote template_info.Template.base_image);
333 fpf "export format=%s\n" (quote format);
334 fpf "export name=%s\n" (quote name);
335 fpf "export output=%s\n" (quote remote_image);
338 | size -> fpf "export size=%s\n" (quote (sprintf "--size %Ldb" size))
340 (match !timezone with
342 | tz -> fpf "export timezone=%s\n" (quote (sprintf "--timezone %s" tz))
344 fpf "%s build\n" remote_template;
346 Unix.chmod remote_template_wrapper 0o755 in
349 sprintf "scp %s root@%s:%s"
350 (quote remote_template_wrapper) (quote hostname)
351 (quote remote_template_wrapper) in
352 if verbose then printf "%s\n%!" cmd;
353 if Sys.command cmd <> 0 then (
354 eprintf "mclu: scp template wrapper to remote failed\n";
359 sprintf "ssh root@%s %s" (quote hostname) (quote remote_template_wrapper) in
360 if verbose then printf "%s\n%!" cmd;
361 if Sys.command cmd <> 0 then (
362 eprintf "mclu: remote build failed\n";
366 (* Start the guest. *)
370 let name = node.MS.node_status.MS.node.Mclu_conf.libvirt_uri in
371 C.connect ~name () in
372 let dom = D.create_xml conn xml [] in
373 printf "mclu: %s:%s started\n" hostname (D.get_name dom);
375 with Libvirt.Virterror msg ->
376 eprintf "mclu: %s: %s\n" hostname (Libvirt.Virterror.to_string msg);
379 (* Graphical console? *)
381 Mclu_viewer.viewer ~verbose ~host:hostname (D.get_name dom);
383 (* Serial console? (Interactive, so run it last) *)
384 if !open_console then
385 Mclu_console.console ~verbose ~host:hostname (D.get_name dom)
387 let run ~verbose = function
388 | [ template; name ] ->
389 boot ~verbose template name
391 eprintf "Usage: mclu boot <template> <[host:]name>\n";