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