adae6de8e41a68ffc0f3e229b347e6776775906a
[mclu.git] / mclu_boot.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 (* Implement 'mclu boot'. *)
20
21 module C = Libvirt.Connect
22 module D = Libvirt.Domain
23 module MS = Mclu_status
24
25 open Printf
26
27 open Utils
28
29 let memory = ref 0L                     (* 0 = choose for me *)
30 let set_memory s =
31   try memory := bytes_of_human_size s
32   with Not_found ->
33     eprintf "mclu: don't understand --memory parameter '%s'
34 Try something like --memory 1G\n" s;
35     exit 1
36 let vcpus = ref 0                       (* 0 = choose for me *)
37
38 let open_console = ref false
39 let open_viewer = ref false
40
41 let get_arg_speclist () = Arg.align [
42   "--console",  Arg.Set open_console, " Open the serial console";
43   "--cpus",     Arg.Set_int vcpus, "n Number of virtual CPUs";
44   "--memory",   Arg.String set_memory, "nnG Amount of RAM to give guest";
45   "--ram",      Arg.String set_memory, "nnG Amount of RAM to give guest";
46   "--vcpus",    Arg.Set_int vcpus, "n Number of virtual CPUs";
47   "--viewer",   Arg.Set open_viewer, " Open the graphical console";
48 ]
49
50 let boot ~verbose template name =
51   let templates = Template.templates () in
52
53   (* Does the template exist? *)
54   let template_filename =
55     try List.assoc template templates
56     with Not_found ->
57       eprintf "mclu: template %s not found
58 Try `mclu list --templates' to list all known templates.\n" template;
59       exit 1 in
60
61   (* Probe the template for various features. *)
62   let template_info = Template.probe ~verbose template_filename in
63
64   (* Decide how much RAM we will give the guest.  This affects our
65    * choice of node, so do it early.
66    *)
67   let memory = !memory in
68   let memory =
69     if memory > 0L then (
70       (* User requested, just check it's above the minimum. *)
71       match template_info.Template.minimum_memory with
72       | None -> memory
73       | Some min when min > memory ->
74         eprintf "mclu: minimum memory for this template is %s\n"
75           (human_size min);
76         exit 1
77       | Some _ -> memory
78     ) else (
79       (* User didn't request any memory setting, use the recommended. *)
80       match template_info.Template.recommended_memory with
81       | Some memory -> memory
82       | None -> 4L *^ 1024L *^ 1024L *^ 1024L (* 4 GB *)
83     ) in
84
85   (* Check what's running. *)
86   let summary = MS.node_guest_summary ~verbose () in
87
88   (* Did the user request a specific host?  If not, choose one. *)
89   let hostname, name =
90     match name_parse name with
91     | Some hostname, name -> hostname, name
92     | None, name ->
93       (* Choose the first host with enough free memory. *)
94       let nodes = List.filter (
95         fun { MS.free_memory = free_memory } -> free_memory >= memory
96       ) summary in
97       match nodes with
98       | [] ->
99         eprintf "mclu: no node with enough free memory found
100 Try: `mclu status' and `mclu on <node>'\n";
101         exit 1
102       | node :: _ ->
103         let hostname =
104           node.MS.node_status.MS.node.Mclu_conf.hostname in
105         hostname, name in
106
107   (* Check there isn't a guest with this name running anywhere
108    * in the cluster already.
109    *)
110   List.iter (
111     fun ({ MS.active_guests = guests } as node) ->
112       List.iter (
113         fun { Mclu_list.dom_name = n } ->
114           if name = n then (
115             let hostname =
116               node.MS.node_status.MS.node.Mclu_conf.hostname
117             in
118             eprintf "mclu: there is already a guest called '%s' (running on %s)\n"
119               name hostname;
120             exit 1
121           )
122       ) guests
123   ) summary;
124
125   (* Convert hostname to a specific node, and check it is up. *)
126   let node =
127     try List.find (
128       fun node ->
129         node.MS.node_status.MS.node.Mclu_conf.hostname = hostname
130     ) summary
131     with Not_found ->
132       eprintf "mclu: no node is called '%s'\n" hostname;
133       exit 1 in
134   if not node.MS.node_status.MS.node_on then (
135     eprintf "mclu: node '%s' is switched off
136 Try: `mclu on %s'\n" hostname hostname;
137     exit 1
138   );
139
140   (* Where we upload the template and image on remote. *)
141   let format, extension = "qcow2", "qcow2" in
142   let remote_filename = sprintf "/tmp/mclu%s.sh" (string_random8 ()) in
143   let remote_image = sprintf "/var/tmp/%s.%s" name extension in
144
145   (* Get ready to generate the guest XML. *)
146   let vcpus = !vcpus in
147   let vcpus =
148     if vcpus > 0 then vcpus
149     else min 4 node.MS.node_status.MS.node_info.C.cpus in
150   let mac_addr =
151     sprintf "52:54:00:%02x:%02x:%02x"
152       (Random.int 256) (Random.int 256) (Random.int 256) in
153
154   (* Generate the guest XML.  XXX Quoting. *)
155   let xml = sprintf "\
156 <domain type='kvm'>
157   <name>%s</name>
158   <memory unit='KiB'>%Ld</memory>
159   <currentMemory unit='KiB'>%Ld</currentMemory>
160   <vcpu>%d</vcpu>
161   <os>
162     <type>hvm</type>
163     <boot dev='hd'/>
164   </os>
165   <features>
166     <acpi/>
167     <apic/>
168     <pae/>
169   </features>
170   <cpu mode='host-model' fallback='allow' />
171   <clock offset='utc'>
172     <timer name='rtc' tickpolicy='catchup'/>
173     <timer name='pit' tickpolicy='delay'/>
174     <timer name='hpet' present='no'/>
175   </clock>
176   <on_poweroff>destroy</on_poweroff>
177   <on_reboot>restart</on_reboot>
178   <on_crash>restart</on_crash>
179   <devices>
180 " name (memory /^ 1024L) (memory /^ 1024L) vcpus in
181
182   let xml = xml ^ sprintf "\
183   <disk type='file' device='disk'>
184     <driver name='qemu' type='%s' cache='none' io='native'/>
185     <source file='%s'/>
186 " format remote_image in
187   let xml = xml ^
188     match template_info.Template.disk_bus with
189     | Some "ide" ->
190       "      <target dev='sda' bus='ide'/>\n"
191     | Some "virtio-scsi" | None ->
192       "      <target dev='sda' bus='scsi'/>\n"
193     | Some bus ->
194       eprintf "mclu: unknown disk-bus: %s\n" bus;
195       exit 1 in
196   let xml = xml ^ "\
197     </disk>
198 " in
199
200   let xml = xml ^
201     if template_info.Template.disk_bus = Some "virtio-scsi" then
202       "  <controller type='scsi' index='0' model='virtio-scsi'/>\n"
203     else
204       "" in
205
206   (* XXX Don't hard-code bridge name here. *)
207   let network_model =
208     match template_info with
209     | { Template.network_model = None } -> "virtio"
210     | { Template.network_model = Some d } -> d in
211   let xml = xml ^ sprintf "\
212     <interface type='bridge'>
213       <mac address='%s'/>
214       <source bridge='br0'/>
215       <model type='%s'/>
216     </interface>
217 " mac_addr network_model in
218
219   let xml = xml ^ "\
220     <serial type='pty'>
221       <target port='0'/>
222     </serial>
223     <console type='pty'>
224       <target type='serial' port='0'/>
225     </console>
226     <input type='tablet' bus='usb'/>
227     <input type='mouse' bus='ps2'/>
228     <input type='keyboard' bus='ps2'/>
229     <graphics type='vnc' autoport='yes'/>
230     <video>
231       <model type='cirrus' vram='9216' heads='1'/>
232     </video>
233   </devices>
234 </domain>" in
235
236   (* Copy the template to remote and build the guest. *)
237   let cmd =
238     sprintf "scp %s root@%s:%s"
239       (quote template_filename) (quote hostname) remote_filename in
240   if verbose then printf "%s\n%!" cmd;
241   if Sys.command cmd <> 0 then (
242     eprintf "mclu: scp template to remote failed\n";
243     exit 1
244   );
245   let cmd =
246     (* XXX Don't hard-code network_bridge here. *)
247     sprintf "ssh root@%s \
248 LIBGUESTFS_BACKEND_SETTINGS=network_bridge=br0 \
249 base_image=%s \
250 format=%s \
251 name=%s \
252 output=%s \
253 %s build"
254       (quote hostname)
255       (quote template_info.Template.base_image) (* base_image *)
256       format (* format *)
257       name (* name *)
258       (quote remote_image) (* output *)
259       remote_filename in
260   if verbose then printf "%s\n%!" cmd;
261   if Sys.command cmd <> 0 then (
262     eprintf "mclu: remote build failed\n";
263     exit 1
264   );
265
266   (* Start the guest. *)
267   let dom =
268     try
269       let conn =
270         let name = node.MS.node_status.MS.node.Mclu_conf.libvirt_uri in
271         C.connect ~name () in
272       let dom = D.create_xml conn xml [] in
273       printf "mclu: %s:%s started\n" hostname (D.get_name dom);
274       dom
275     with Libvirt.Virterror msg ->
276       eprintf "mclu: %s: %s\n" hostname (Libvirt.Virterror.to_string msg);
277       exit 1 in
278
279   (* Graphical console? *)
280   if !open_viewer then
281     Mclu_viewer.viewer ~verbose ~host:hostname (D.get_name dom);
282
283   (* Serial console?  (Interactive, so run it last) *)
284   if !open_console then
285     Mclu_console.console ~verbose ~host:hostname (D.get_name dom)
286
287 let run ~verbose = function
288   | [ template; name ] ->
289     boot ~verbose template name
290   | _ ->
291     eprintf "Usage: mclu boot <template> <[host:]name>\n";
292     exit 1