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   (* Check --size is not too small. *)
  75   let size =
  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 *)
  79       min_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);
  83       exit 1
  84     | size, _ -> size in           (* go with user-specified size *)
  85
  86   (* Decide how much RAM we will give the guest.  This affects our
  87    * choice of node, so do it early.
  88    *)
  89   let memory = !memory in
  90   let memory =
  91     if memory > 0L then (
  92       (* User requested, just check it's above the minimum. *)
  93       match template_info.Template.minimum_memory with
  94       | None -> memory
  95       | Some min when min > memory ->
  96         eprintf "mclu: minimum memory for this template is %s\n"
  97           (human_size min);
  98         exit 1
  99       | Some _ -> memory
 100     ) else (
 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 *)
 105     ) in
 106
 107   (* Check what's running. *)
 108   let summary = MS.node_guest_summary ~verbose () in
 109
 110   (* Did the user request a specific host?  If not, choose one. *)
 111   let hostname, name =
 112     match name_parse name with
 113     | Some hostname, name -> hostname, name
 114     | None, 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
 118       ) summary in
 119       match nodes with
 120       | [] ->
 121         eprintf "mclu: no node with enough free memory found
 122 Try: `mclu status' and `mclu on <node>'\n";
 123         exit 1
 124       | node :: _ ->
 125         let hostname =
 126           node.MS.node_status.MS.node.Mclu_conf.hostname in
 127         hostname, name in
 128
 129   (* Check there isn't a guest with this name running anywhere
 130    * in the cluster already.
 131    *)
 132   List.iter (
 133     fun ({ MS.active_guests = guests } as node) ->
 134       List.iter (
 135         fun { Mclu_list.dom_name = n } ->
 136           if name = n then (
 137             let hostname =
 138               node.MS.node_status.MS.node.Mclu_conf.hostname
 139             in
 140             eprintf "mclu: there is already a guest called '%s' (running on %s)\n"
 141               name hostname;
 142             exit 1
 143           )
 144       ) guests
 145   ) summary;
 146
 147   (* Convert hostname to a specific node, and check it is up. *)
 148   let node =
 149     try List.find (
 150       fun node ->
 151         node.MS.node_status.MS.node.Mclu_conf.hostname = hostname
 152     ) summary
 153     with Not_found ->
 154       eprintf "mclu: no node is called '%s'\n" hostname;
 155       exit 1 in
 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;
 159     exit 1
 160   );
 161
 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
 168   let remote_external_kernel_dir = sprintf "/var/tmp/%s.boot" name in
 169   let remote_external_kernel = sprintf "/var/tmp/%s.boot/kernel" name in
 170   let remote_external_initrd = sprintf "/var/tmp/%s.boot/initrd" name in
 171   let remote_arch = node.MS.node_status.node_info.model in
 172
 173   (* Guest arch defaults to the node host arch, but can be overridden
 174    * in the template.
 175    *)
 176   let guest_arch =
 177     match template_info.Template.guest_arch with
 178     | Some arch -> arch
 179     | None -> remote_arch in
 180
 181   (* UEFI firmware and NVRAM on remote, if required. *)
 182   let nvram =
 183     match guest_arch with
 184     | "aarch64" ->
 185        Some ("/usr/share/edk2.git/aarch64/QEMU_EFI-pflash.raw",
 186              "/usr/share/edk2.git/aarch64/vars-template-pflash.raw",
 187              remote_image ^ ".nvram")
 188     | _ -> None in
 189
 190   (* Get ready to generate the guest XML. *)
 191   let vcpus = !vcpus in
 192   let vcpus =
 193     if vcpus > 0 then vcpus
 194     else min 4 node.MS.node_status.MS.node_info.C.cpus in
 195   let mac_addr =
 196     sprintf "52:54:00:%02x:%02x:%02x"
 197       (Random.int 256) (Random.int 256) (Random.int 256) in
 198
 199   (* Generate the guest XML. *)
 200   let generate_standard_xml () =
 201     (* XXX Better quoting. *)
 202     let xml = sprintf "\
 203 <domain type='kvm'>
 204   <name>%s</name>
 205   <memory unit='KiB'>%Ld</memory>
 206   <currentMemory unit='KiB'>%Ld</currentMemory>
 207   <vcpu>%d</vcpu>
 208 " name (memory /^ 1024L) (memory /^ 1024L) vcpus in
 209
 210     let xml = xml ^ "\
 211   <os>
 212     <boot dev='hd'/>
 213 " in
 214     let xml =
 215       match guest_arch with
 216       | "arm" | "armv7" | "armv7l" | "armv7hl" ->
 217          xml ^ "\
 218     <type arch='armv7l' machine='virt'>hvm</type>
 219 "
 220       | "aarch64" ->
 221          xml ^ "\
 222     <type machine='virt'>hvm</type>
 223 "
 224       | _ ->
 225          xml ^ "\
 226     <type>hvm</type>
 227 " in
 228
 229     let xml =
 230       match nvram with
 231       | Some (loader, nvram_template, nvram) ->
 232          xml ^ sprintf "\
 233     <loader readonly='yes' type='pflash'>%s</loader>
 234     <nvram template='%s'>%s</nvram>
 235 " loader nvram_template nvram
 236       | None -> xml in
 237
 238     let xml = xml ^
 239       if template_info.Template.needs_external_kernel then
 240         sprintf "\
 241     <kernel>%s</kernel>
 242     <initrd>%s</initrd>
 243 " remote_external_kernel remote_external_initrd
 244       else "" in
 245
 246     let xml = xml ^
 247       match template_info.Template.cmdline with
 248       | Some cmdline -> sprintf "    <cmdline>%s</cmdline>\n" cmdline
 249       | None -> "" in
 250
 251     let xml = xml ^ "\
 252   </os>
 253   <features>
 254     <acpi/>
 255     <apic/>
 256     <pae/>
 257   </features>
 258   <cpu mode='host-passthrough'/> <!-- -cpu host, also allows nested -->
 259   <clock offset='utc'>
 260     <timer name='rtc' tickpolicy='catchup'/>
 261     <timer name='pit' tickpolicy='delay'/>
 262     <timer name='hpet' present='no'/>
 263   </clock>
 264   <on_poweroff>destroy</on_poweroff>
 265   <on_reboot>restart</on_reboot>
 266   <on_crash>restart</on_crash>
 267   <devices>
 268 " in
 269
 270     let xml = xml ^ sprintf "\
 271   <disk type='file' device='disk'>
 272     <driver name='qemu' type='%s' cache='none' io='native'/>
 273     <source file='%s'/>
 274 " format remote_image in
 275     let xml = xml ^
 276     match template_info.Template.disk_bus with
 277     | Some "ide" ->
 278       "      <target dev='sda' bus='ide'/>\n"
 279     | Some "virtio-scsi" | None ->
 280       "      <target dev='sda' bus='scsi'/>\n"
 281     | Some bus ->
 282       eprintf "mclu: unknown disk-bus: %s\n" bus;
 283       exit 1 in
 284     let xml = xml ^ "\
 285     </disk>
 286 " in
 287
 288     let xml =
 289       xml ^
 290         if template_info.Template.disk_bus = Some "virtio-scsi" then
 291           "  <controller type='scsi' index='0' model='virtio-scsi'/>\n"
 292         else
 293           "" in
 294
 295     (* XXX Don't hard-code bridge name here. *)
 296     let network_model =
 297       match template_info with
 298       | { Template.network_model = None } -> "virtio"
 299       | { Template.network_model = Some d } -> d in
 300     let xml = xml ^ sprintf "\
 301     <interface type='bridge'>
 302       <mac address='%s'/>
 303       <source bridge='br0'/>
 304       <model type='%s'/>
 305     </interface>
 306 " mac_addr network_model in
 307
 308     let xml = xml ^ "\
 309     <serial type='pty'>
 310       <target port='0'/>
 311     </serial>
 312     <console type='pty'>
 313       <target type='serial' port='0'/>
 314     </console>
 315 " in
 316     let xml =
 317       match guest_arch with
 318       | "i386" | "i486" | "i586" | "i686"
 319       | "x86_64" ->
 320          xml ^ "\
 321     <input type='tablet' bus='usb'/>
 322     <input type='mouse' bus='ps2'/>
 323     <input type='keyboard' bus='ps2'/>
 324     <graphics type='vnc' autoport='yes'/>
 325     <video>
 326       <model type='cirrus' vram='9216' heads='1'/>
 327     </video>
 328 "
 329       | _ -> xml in
 330     let xml = xml ^ "\
 331   </devices>
 332 </domain>" in
 333     xml
 334
 335   and generate_custom_xml () =
 336     (* Generate a wrapper script to make passing the variables
 337      * to the template easier.
 338      *)
 339     let () =
 340       let chan = open_out xml_template_wrapper in
 341       let fpf fs = fprintf chan fs in
 342       fpf "#!/bin/sh\n";
 343       fpf "export format=%s\n" (quote format);
 344       fpf "export initrd=%s\n" (quote remote_external_initrd);
 345       fpf "export kernel=%s\n" (quote remote_external_kernel);
 346       fpf "export mac_addr=%s\n" (quote mac_addr);
 347       fpf "export memory_kb=%Ld\n" (memory /^ 1024L);
 348       fpf "export name=%s\n" (quote name);
 349       fpf "export output=%s\n" (quote remote_image);
 350       fpf "export vcpus=%d\n" vcpus;
 351       fpf "%s xml\n" template_filename;
 352       close_out chan;
 353       Unix.chmod xml_template_wrapper 0o755 in
 354
 355     if verbose then printf "%s\n%!" xml_template_wrapper;
 356     let chan = Unix.open_process_in xml_template_wrapper in
 357     let lines = ref [] in
 358     (try while true do lines := input_line chan :: !lines done
 359      with End_of_file -> ());
 360     let stat = Unix.close_process_in chan in
 361     (match stat with
 362      | Unix.WEXITED 0 -> ()
 363      | Unix.WEXITED i ->
 364         eprintf "mclu: template '%s' subcmd xml exited with error %d\n"
 365                 template_filename i;
 366         exit 1
 367      | Unix.WSIGNALED i ->
 368         eprintf "mclu: template '%s' subcmd xml killed by signal %d\n"
 369                 template_filename i;
 370         exit 1
 371      | Unix.WSTOPPED i ->
 372         eprintf "mclu: template '%s' subcmd xml stopped by signal %d\n"
 373                 template_filename i;
 374         exit 1
 375     );
 376     let xml = String.concat "\n" (List.rev !lines) in
 377     xml
 378   in
 379
 380   let xml =
 381     if not template_info.Template.has_xml_target then
 382       generate_standard_xml ()
 383     else
 384       generate_custom_xml () in
 385
 386   (* Copy the template to remote. *)
 387   let cmd =
 388     sprintf "scp %s root@%s:%s"
 389       (quote template_filename) (quote hostname) remote_template in
 390   if verbose then printf "%s\n%!" cmd;
 391   if Sys.command cmd <> 0 then (
 392     eprintf "mclu: scp template to remote failed\n";
 393     exit 1
 394   );
 395
 396   (* Create a wrapper script that sets the variables and runs the
 397    * template.  This just avoids complex quoting.
 398    *)
 399   let () =
 400     let chan = open_out remote_template_wrapper in
 401     let fpf fs = fprintf chan fs in
 402     fpf "#!/bin/bash\n";
 403     fpf "set -e\n";
 404     (* XXX Don't hard-code network_bridge here. *)
 405     fpf "export LIBGUESTFS_BACKEND_SETTINGS=network_bridge=br0\n";
 406     fpf "export base_image=%s\n" (quote template_info.Template.base_image);
 407     fpf "export format=%s\n" (quote format);
 408     fpf "export guest_arch=%s\n" (quote guest_arch);
 409     fpf "export name=%s\n" (quote name);
 410     fpf "export output=%s\n" (quote remote_image);
 411     (match size with
 412     | 0L -> ()
 413     | size -> fpf "export size=%s\n" (quote (sprintf "--size %Ldb" size))
 414     );
 415     (match !timezone with
 416     | "" -> ()
 417     | tz -> fpf "export timezone=%s\n" (quote (sprintf "--timezone %s" tz))
 418     );
 419     (match nvram with
 420      | Some (_, nvram_template, nvram) ->
 421         fpf "cp %s %s\n" (quote nvram_template) (quote nvram)
 422      | None -> ()
 423     );
 424     fpf "%s build\n" remote_template;
 425     if template_info.Template.needs_external_kernel then (
 426       fpf "rm -rf %s\n" (quote remote_external_kernel_dir);
 427       fpf "mkdir %s\n" (quote remote_external_kernel_dir);
 428       fpf "pushd %s\n" (quote remote_external_kernel_dir);
 429       fpf "virt-builder --get-kernel %s\n" (quote remote_image);
 430       fpf "ln vmlinuz-* kernel\n";
 431       fpf "ln init* initrd\n";
 432       fpf "popd\n";
 433     );
 434     close_out chan;
 435     Unix.chmod remote_template_wrapper 0o755 in
 436
 437   let cmd =
 438     sprintf "scp %s root@%s:%s"
 439       (quote remote_template_wrapper) (quote hostname)
 440       (quote remote_template_wrapper) in
 441   if verbose then printf "%s\n%!" cmd;
 442   if Sys.command cmd <> 0 then (
 443     eprintf "mclu: scp template wrapper to remote failed\n";
 444     exit 1
 445   );
 446
 447   let cmd =
 448     sprintf "ssh root@%s %s" (quote hostname) (quote remote_template_wrapper) in
 449   if verbose then printf "%s\n%!" cmd;
 450   if Sys.command cmd <> 0 then (
 451     eprintf "mclu: remote build failed\n";
 452     exit 1
 453   );
 454
 455   (* Start the guest. *)
 456   let dom =
 457     try
 458       let conn =
 459         let name = node.MS.node_status.MS.node.Mclu_conf.libvirt_uri in
 460         C.connect ~name () in
 461       let dom = D.create_xml conn xml [] in
 462       printf "mclu: %s:%s started\n" hostname (D.get_name dom);
 463       dom
 464     with Libvirt.Virterror msg ->
 465       eprintf "mclu: %s: %s\n" hostname (Libvirt.Virterror.to_string msg);
 466       exit 1 in
 467
 468   (* Graphical console? *)
 469   if !open_viewer then
 470     Mclu_viewer.viewer ~verbose ~host:hostname (D.get_name dom);
 471
 472   (* Serial console?  (Interactive, so run it last) *)
 473   if !open_console then
 474     Mclu_console.console ~verbose ~host:hostname (D.get_name dom)
 475
 476 let run ~verbose = function
 477   | [ template; name ] ->
 478     boot ~verbose template name
 479   | _ ->
 480     eprintf "Usage: mclu boot <template> <[host:]name>\n";
 481     exit 1