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