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 ws_rex = Pcre.regexp "\\s+"
  30 let br_rex = Pcre.regexp "^br\\d+"
  31 let virbr_rex = Pcre.regexp "^virbr\\d+"
  32
  33 let memory = ref 0L                     (* 0 = choose for me *)
  34 let set_memory s =
  35   try memory := bytes_of_human_size s
  36   with Not_found ->
  37     eprintf "mclu: don't understand --memory parameter '%s'
  38 Try something like --memory 1G\n" s;
  39     exit 1
  40 let size = ref 0L                       (* 0 = default *)
  41 let set_size s =
  42   try size := bytes_of_human_size s
  43   with Not_found ->
  44     eprintf "mclu: don't understand --size parameter '%s'
  45 Try something like --size 20G\n" s;
  46     exit 1
  47 let timezone = ref ""                   (* "" = no timezone set *)
  48 let vcpus = ref 0                       (* 0 = choose for me *)
  49
  50 let open_console = ref false
  51 let open_viewer = ref false
  52
  53 let get_arg_speclist () = Arg.align [
  54   "--console",  Arg.Set open_console, " Open the serial console";
  55   "--cpus",     Arg.Set_int vcpus, "n Number of virtual CPUs";
  56   "--memory",   Arg.String set_memory, "nnG Amount of RAM to give guest";
  57   "--ram",      Arg.String set_memory, "nnG Amount of RAM to give guest";
  58   "--size",     Arg.String set_size, "nnG Size of disk to give guest";
  59   "--timezone", Arg.Set_string timezone, "TZ Set timezone of guest";
  60   "--vcpus",    Arg.Set_int vcpus, "n Number of virtual CPUs";
  61   "--viewer",   Arg.Set open_viewer, " Open the graphical console";
  62 ]
  63
  64 let boot ~verbose template name =
  65   let templates = Template.templates () in
  66
  67   (* Does the template exist? *)
  68   let template_filename =
  69     try List.assoc template templates
  70     with Not_found ->
  71       eprintf "mclu: template %s not found
  72 Try `mclu list --templates' to list all known templates.\n" template;
  73       exit 1 in
  74
  75   (* Probe the template for various features. *)
  76   let template_info = Template.probe ~verbose template_filename in
  77
  78   (* Check --size is not too small. *)
  79   let size =
  80     match !size, template_info.Template.minimum_size with
  81     | 0L, None -> 0L               (* virt-builder default *)
  82     | 0L, Some min_size ->         (* go with template minimum size *)
  83       min_size
  84     | size, Some min_size when size < min_size ->
  85       eprintf "mclu: --size parameter is smaller than the minimum specified by the template (%s).\n"
  86         (human_size min_size);
  87       exit 1
  88     | size, _ -> size in           (* go with user-specified size *)
  89
  90   (* Decide how much RAM we will give the guest.  This affects our
  91    * choice of node, so do it early.
  92    *)
  93   let memory = !memory in
  94   let memory =
  95     if memory > 0L then (
  96       (* User requested, just check it's above the minimum. *)
  97       match template_info.Template.minimum_memory with
  98       | None -> memory
  99       | Some min when min > memory ->
 100         eprintf "mclu: minimum memory for this template is %s\n"
 101           (human_size min);
 102         exit 1
 103       | Some _ -> memory
 104     ) else (
 105       (* User didn't request any memory setting, use the recommended. *)
 106       match template_info.Template.recommended_memory with
 107       | Some memory -> memory
 108       | None -> 4L *^ 1024L *^ 1024L *^ 1024L (* 4 GB *)
 109     ) in
 110
 111   (* Check what's running. *)
 112   let summary = MS.node_guest_summary ~verbose () in
 113
 114   (* Did the user request a specific host?  If not, choose one. *)
 115   let hostname, name =
 116     match name_parse name with
 117     | Some hostname, name -> hostname, name
 118     | None, name ->
 119       (* Choose the first host with enough free memory. *)
 120       let nodes = List.filter (
 121         fun { MS.free_memory = free_memory } -> free_memory >= memory
 122       ) summary in
 123       match nodes with
 124       | [] ->
 125         eprintf "mclu: no node with enough free memory found
 126 Try: `mclu status' and `mclu on <node>'\n";
 127         exit 1
 128       | node :: _ ->
 129         let hostname =
 130           node.MS.node_status.MS.node.Mclu_conf.hostname in
 131         hostname, name in
 132
 133   (* Check there isn't a guest with this name running anywhere
 134    * in the cluster already.
 135    *)
 136   List.iter (
 137     fun ({ MS.active_guests = guests } as node) ->
 138       List.iter (
 139         fun { Mclu_list.dom_name = n } ->
 140           if name = n then (
 141             let hostname =
 142               node.MS.node_status.MS.node.Mclu_conf.hostname
 143             in
 144             eprintf "mclu: there is already a guest called '%s' (running on %s)\n"
 145               name hostname;
 146             exit 1
 147           )
 148       ) guests
 149   ) summary;
 150
 151   (* Convert hostname to a specific node, and check it is up. *)
 152   let node =
 153     try List.find (
 154       fun node ->
 155         node.MS.node_status.MS.node.Mclu_conf.hostname = hostname
 156     ) summary
 157     with Not_found ->
 158       eprintf "mclu: no node is called '%s'\n" hostname;
 159       exit 1 in
 160   if not node.MS.node_status.MS.node_on then (
 161     eprintf "mclu: node '%s' is switched off
 162 Try: `mclu on %s'\n" hostname hostname;
 163     exit 1
 164   );
 165
 166   (* Where we upload the template and image on remote. *)
 167   let format, extension = "qcow2", "qcow2" in
 168   let remote_template = sprintf "/tmp/mclu%s.sh" (string_random8 ()) in
 169   let remote_template_wrapper = sprintf "/tmp/mclu%s.sh" (string_random8 ()) in
 170   let xml_template_wrapper = sprintf "/tmp/mclu%s.sh" (string_random8 ()) in
 171   let remote_image = sprintf "/var/tmp/%s.%s" name extension in
 172   let remote_external_kernel_dir = sprintf "/var/tmp/%s.boot" name in
 173   let remote_external_kernel = sprintf "/var/tmp/%s.boot/kernel" name in
 174   let remote_external_initrd = sprintf "/var/tmp/%s.boot/initrd" name in
 175   let remote_arch = node.MS.node_status.node_info.model in
 176
 177   (* Guest arch defaults to the node host arch, but can be overridden
 178    * in the template.
 179    *)
 180   let guest_arch =
 181     match template_info.Template.guest_arch with
 182     | Some arch -> arch
 183     | None -> remote_arch in
 184
 185   (* UEFI firmware and NVRAM on remote, if required. *)
 186   let nvram =
 187     match guest_arch with
 188     | "aarch64" ->
 189        Some ("/usr/share/edk2/aarch64/QEMU_EFI-pflash.raw",
 190              "/usr/share/edk2/aarch64/vars-template-pflash.raw",
 191              remote_image ^ ".nvram")
 192     | _ -> None in
 193
 194   (* Get the name of the remote bridge. *)
 195   let bridge =
 196     let cmd =
 197       sprintf "ssh root@%s brctl show | sort" (quote hostname) in
 198     if verbose then printf "%s\n%!" cmd;
 199     let chan = Unix.open_process_in cmd in
 200     let lines = ref [] in
 201     (try while true do lines := input_line chan :: !lines done
 202      with End_of_file -> ());
 203     let stat = Unix.close_process_in chan in
 204     (match stat with
 205      | Unix.WEXITED 0 -> ()
 206      | Unix.WEXITED i ->
 207         eprintf "mclu: 'brctl show' exited with error %d\n" i;
 208         exit 1
 209      | Unix.WSIGNALED i ->
 210         eprintf "mclu: 'brctl show' killed by signal %d\n" i;
 211         exit 1
 212      | Unix.WSTOPPED i ->
 213         eprintf "mclu: 'brctl show' stopped by signal %d\n" i;
 214         exit 1
 215     );
 216     let lines = List.rev !lines in
 217     (* A heuristic: Use brX, but if none exist, try virbrX. *)
 218     let brname = ref None in
 219     let virbrname = ref None in
 220     List.iter (
 221       fun line ->
 222         match Pcre.split ~rex:ws_rex line with
 223         | str :: _ when Pcre.pmatch ~rex:br_rex str ->
 224            if !brname = None then
 225              brname := Some str
 226         | str :: _ when Pcre.pmatch ~rex:virbr_rex str ->
 227            if !virbrname = None then
 228              virbrname := Some str
 229         | _ -> ()
 230     ) lines;
 231
 232     match !brname with
 233     | Some br -> br
 234     | None ->
 235        match !virbrname with
 236        | Some br -> br
 237        | None ->
 238           eprintf "mclu: Could not get remote bridge name\n";
 239           exit 1 in
 240
 241   (* Get ready to generate the guest XML. *)
 242   let vcpus = !vcpus in
 243   let vcpus =
 244     if vcpus > 0 then vcpus
 245     else min 4 node.MS.node_status.MS.node_info.C.cpus in
 246   let mac_addr =
 247     sprintf "52:54:00:%02x:%02x:%02x"
 248       (Random.int 256) (Random.int 256) (Random.int 256) in
 249
 250   (* Generate the guest XML. *)
 251   let generate_standard_xml () =
 252     (* XXX Better quoting. *)
 253     let xml = sprintf "\
 254 <domain type='kvm'>
 255   <name>%s</name>
 256   <memory unit='KiB'>%Ld</memory>
 257   <currentMemory unit='KiB'>%Ld</currentMemory>
 258   <vcpu>%d</vcpu>
 259 " name (memory /^ 1024L) (memory /^ 1024L) vcpus in
 260
 261     let xml = xml ^ "\
 262   <os>
 263     <boot dev='hd'/>
 264 " in
 265     let xml =
 266       match guest_arch with
 267       | "arm" | "armv7" | "armv7l" | "armv7hl" ->
 268          xml ^ "\
 269     <type arch='armv7l' machine='virt'>hvm</type>
 270 "
 271       | "aarch64" ->
 272          xml ^ "\
 273     <type machine='virt'>hvm</type>
 274 "
 275       | _ ->
 276          xml ^ "\
 277     <type>hvm</type>
 278 " in
 279
 280     let xml =
 281       match nvram with
 282       | Some (loader, nvram_template, nvram) ->
 283          xml ^ sprintf "\
 284     <loader readonly='yes' type='pflash'>%s</loader>
 285     <nvram template='%s'>%s</nvram>
 286 " loader nvram_template nvram
 287       | None -> xml in
 288
 289     let xml = xml ^
 290       if template_info.Template.needs_external_kernel then
 291         sprintf "\
 292     <kernel>%s</kernel>
 293     <initrd>%s</initrd>
 294 " remote_external_kernel remote_external_initrd
 295       else "" in
 296
 297     let xml = xml ^
 298       match template_info.Template.cmdline with
 299       | Some cmdline -> sprintf "    <cmdline>%s</cmdline>\n" cmdline
 300       | None -> "" in
 301
 302     let xml = xml ^ "\
 303   </os>
 304   <features>
 305     <acpi/>
 306     <apic/>
 307     <pae/>
 308   </features>
 309   <cpu mode='host-passthrough'/> <!-- -cpu host, also allows nested -->
 310   <clock offset='utc'>
 311     <timer name='rtc' tickpolicy='catchup'/>
 312     <timer name='pit' tickpolicy='delay'/>
 313     <timer name='hpet' present='no'/>
 314   </clock>
 315   <on_poweroff>destroy</on_poweroff>
 316   <on_reboot>restart</on_reboot>
 317   <on_crash>restart</on_crash>
 318   <devices>
 319 " in
 320
 321     let xml = xml ^ sprintf "\
 322   <disk type='file' device='disk'>
 323     <driver name='qemu' type='%s' cache='none' io='native'/>
 324     <source file='%s'/>
 325 " format remote_image in
 326     let xml = xml ^
 327     match template_info.Template.disk_bus with
 328     | Some "ide" ->
 329       "      <target dev='sda' bus='ide'/>\n"
 330     | Some "virtio" ->
 331       "      <target dev='vda' bus='virtio'/>\n"
 332     | Some "virtio-scsi" | None ->
 333       "      <target dev='sda' bus='scsi'/>\n"
 334     | Some bus ->
 335       eprintf "mclu: unknown disk-bus: %s\n" bus;
 336       exit 1 in
 337     let xml = xml ^ "\
 338     </disk>
 339 " in
 340
 341     let xml =
 342       xml ^
 343         if template_info.Template.disk_bus = Some "virtio-scsi" then
 344           "  <controller type='scsi' index='0' model='virtio-scsi'/>\n"
 345         else
 346           "" in
 347
 348     let network_model =
 349       match template_info with
 350       | { Template.network_model = None } -> "virtio"
 351       | { Template.network_model = Some d } -> d in
 352     let xml = xml ^ sprintf "\
 353     <interface type='bridge'>
 354       <mac address='%s'/>
 355       <source bridge='%s'/>
 356       <model type='%s'/>
 357     </interface>
 358 " mac_addr bridge network_model in
 359
 360     let xml = xml ^ "\
 361     <serial type='pty'>
 362       <target port='0'/>
 363     </serial>
 364     <console type='pty'>
 365       <target type='serial' port='0'/>
 366     </console>
 367 " in
 368     let xml =
 369       match guest_arch with
 370       | "i386" | "i486" | "i586" | "i686"
 371       | "x86_64" ->
 372          xml ^ "\
 373     <input type='tablet' bus='usb'/>
 374     <input type='mouse' bus='ps2'/>
 375     <input type='keyboard' bus='ps2'/>
 376     <graphics type='vnc' autoport='yes'/>
 377     <video>
 378       <model type='cirrus' vram='9216' heads='1'/>
 379     </video>
 380 "
 381       | _ -> xml in
 382     let xml = xml ^ "\
 383   </devices>
 384 </domain>" in
 385     xml
 386
 387   and generate_custom_xml () =
 388     (* Generate a wrapper script to make passing the variables
 389      * to the template easier.
 390      *)
 391     let () =
 392       let chan = open_out xml_template_wrapper in
 393       let fpf fs = fprintf chan fs in
 394       fpf "#!/bin/sh\n";
 395       fpf "export format=%s\n" (quote format);
 396       fpf "export initrd=%s\n" (quote remote_external_initrd);
 397       fpf "export kernel=%s\n" (quote remote_external_kernel);
 398       fpf "export mac_addr=%s\n" (quote mac_addr);
 399       fpf "export memory_kb=%Ld\n" (memory /^ 1024L);
 400       fpf "export name=%s\n" (quote name);
 401       fpf "export output=%s\n" (quote remote_image);
 402       fpf "export vcpus=%d\n" vcpus;
 403       fpf "%s xml\n" template_filename;
 404       close_out chan;
 405       Unix.chmod xml_template_wrapper 0o755 in
 406
 407     if verbose then printf "%s\n%!" xml_template_wrapper;
 408     let chan = Unix.open_process_in xml_template_wrapper in
 409     let lines = ref [] in
 410     (try while true do lines := input_line chan :: !lines done
 411      with End_of_file -> ());
 412     let stat = Unix.close_process_in chan in
 413     (match stat with
 414      | Unix.WEXITED 0 -> ()
 415      | Unix.WEXITED i ->
 416         eprintf "mclu: template '%s' subcmd xml exited with error %d\n"
 417                 template_filename i;
 418         exit 1
 419      | Unix.WSIGNALED i ->
 420         eprintf "mclu: template '%s' subcmd xml killed by signal %d\n"
 421                 template_filename i;
 422         exit 1
 423      | Unix.WSTOPPED i ->
 424         eprintf "mclu: template '%s' subcmd xml stopped by signal %d\n"
 425                 template_filename i;
 426         exit 1
 427     );
 428     let xml = String.concat "\n" (List.rev !lines) in
 429     xml
 430   in
 431
 432   let xml =
 433     if not template_info.Template.has_xml_target then
 434       generate_standard_xml ()
 435     else
 436       generate_custom_xml () in
 437
 438   (* Copy the template to remote. *)
 439   let cmd =
 440     sprintf "scp %s root@%s:%s"
 441       (quote template_filename) (quote hostname) remote_template in
 442   if verbose then printf "%s\n%!" cmd;
 443   if Sys.command cmd <> 0 then (
 444     eprintf "mclu: scp template to remote failed\n";
 445     exit 1
 446   );
 447
 448   (* Create a wrapper script that sets the variables and runs the
 449    * template.  This just avoids complex quoting.
 450    *)
 451   let () =
 452     let chan = open_out remote_template_wrapper in
 453     let fpf fs = fprintf chan fs in
 454     fpf "#!/bin/bash\n";
 455     fpf "set -e\n";
 456     fpf "export LIBGUESTFS_BACKEND_SETTINGS=network_bridge=%s\n" bridge;
 457     fpf "export base_image=%s\n" (quote template_info.Template.base_image);
 458     fpf "export format=%s\n" (quote format);
 459     fpf "export guest_arch=%s\n" (quote guest_arch);
 460     fpf "export name=%s\n" (quote name);
 461     fpf "export output=%s\n" (quote remote_image);
 462     (match size with
 463     | 0L -> ()
 464     | size -> fpf "export size=%s\n" (quote (sprintf "--size %Ldb" size))
 465     );
 466     (match !timezone with
 467     | "" -> ()
 468     | tz -> fpf "export timezone=%s\n" (quote (sprintf "--timezone %s" tz))
 469     );
 470     (match nvram with
 471      | Some (_, nvram_template, nvram) ->
 472         fpf "cp %s %s\n" (quote nvram_template) (quote nvram)
 473      | None -> ()
 474     );
 475     fpf "%s build\n" remote_template;
 476     if template_info.Template.needs_external_kernel then (
 477       fpf "rm -rf %s\n" (quote remote_external_kernel_dir);
 478       fpf "mkdir %s\n" (quote remote_external_kernel_dir);
 479       fpf "pushd %s\n" (quote remote_external_kernel_dir);
 480       fpf "virt-builder --get-kernel %s\n" (quote remote_image);
 481       fpf "ln vmlinuz-* kernel\n";
 482       fpf "ln init* initrd\n";
 483       fpf "popd\n";
 484     );
 485     close_out chan;
 486     Unix.chmod remote_template_wrapper 0o755 in
 487
 488   let cmd =
 489     sprintf "scp %s root@%s:%s"
 490       (quote remote_template_wrapper) (quote hostname)
 491       (quote remote_template_wrapper) in
 492   if verbose then printf "%s\n%!" cmd;
 493   if Sys.command cmd <> 0 then (
 494     eprintf "mclu: scp template wrapper to remote failed\n";
 495     exit 1
 496   );
 497
 498   let cmd =
 499     sprintf "ssh root@%s %s" (quote hostname) (quote remote_template_wrapper) in
 500   if verbose then printf "%s\n%!" cmd;
 501   if Sys.command cmd <> 0 then (
 502     eprintf "mclu: remote build failed\n";
 503     exit 1
 504   );
 505
 506   (* Start the guest. *)
 507   let dom =
 508     try
 509       let conn =
 510         let name = node.MS.node_status.MS.node.Mclu_conf.libvirt_uri in
 511         C.connect ~name () in
 512       let dom = D.create_xml conn xml [] in
 513       printf "mclu: %s:%s started\n" hostname (D.get_name dom);
 514       dom
 515     with Libvirt.Virterror msg ->
 516       eprintf "mclu: %s: %s\n" hostname (Libvirt.Virterror.to_string msg);
 517       exit 1 in
 518
 519   (* Graphical console? *)
 520   if !open_viewer then
 521     Mclu_viewer.viewer ~verbose ~host:hostname (D.get_name dom);
 522
 523   (* Serial console?  (Interactive, so run it last) *)
 524   if !open_console then
 525     Mclu_console.console ~verbose ~host:hostname (D.get_name dom)
 526
 527 let run ~verbose = function
 528   | [ template; name ] ->
 529     boot ~verbose template name
 530   | _ ->
 531     eprintf "Usage: mclu boot <template> <[host:]name>\n";
 532     exit 1