+(* mclu: Mini Cloud
+ * Copyright (C) 2014-2015 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+(* Implement 'mclu boot'. *)
+
+module C = Libvirt.Connect
+module D = Libvirt.Domain
+module MS = Mclu_status
+
+open Printf
+
+open Utils
+
+let memory = ref 0L (* 0 = choose for me *)
+let set_memory s =
+ try memory := bytes_of_human_size s
+ with Not_found ->
+ eprintf "mclu: don't understand --memory parameter '%s'
+Try something like --memory 1G\n" s;
+ exit 1
+let vcpus = ref 0 (* 0 = choose for me *)
+
+let get_arg_speclist () = Arg.align [
+ "--cpus", Arg.Set_int vcpus, "n Number of virtual CPUs";
+ "--memory", Arg.String set_memory, "nnG Amount of RAM to give guest";
+ "--ram", Arg.String set_memory, "nnG Amount of RAM to give guest";
+ "--vcpus", Arg.Set_int vcpus, "n Number of virtual CPUs";
+]
+
+let boot ~verbose template name =
+ let templates = Template.templates () in
+
+ (* Does the template exist? *)
+ let template_filename =
+ try List.assoc template templates
+ with Not_found ->
+ eprintf "mclu: template %s not found
+Try `mclu list --templates' to list all known templates.\n" template;
+ exit 1 in
+
+ (* Probe the template for various features. *)
+ let template_info = Template.probe ~verbose template_filename in
+
+ (* Decide how much RAM we will give the guest. This affects our
+ * choice of node, so do it early.
+ *)
+ let memory = !memory in
+ let memory =
+ if memory > 0L then (
+ (* User requested, just check it's above the minimum. *)
+ match template_info.Template.minimum_memory with
+ | None -> memory
+ | Some min when min > memory ->
+ eprintf "mclu: minimum memory for this template is %s\n"
+ (human_size min);
+ exit 1
+ | Some _ -> memory
+ ) else (
+ (* User didn't request any memory setting, use the recommended. *)
+ match template_info.Template.recommended_memory with
+ | Some memory -> memory
+ | None -> 4L *^ 1024L *^ 1024L *^ 1024L (* 4 GB *)
+ ) in
+
+ (* Check what's running. *)
+ let summary = MS.node_guest_summary ~verbose () in
+
+ (* Did the user request a specific host? If not, choose one. *)
+ let hostname, name =
+ match name_parse name with
+ | Some hostname, name -> hostname, name
+ | None, name ->
+ (* Choose the first host with enough free memory. *)
+ let nodes = List.filter (
+ fun { MS.free_memory = free_memory } -> free_memory >= memory
+ ) summary in
+ match nodes with
+ | [] ->
+ eprintf "mclu: no node with enough free memory found
+Try: `mclu status' and `mclu on <node>'\n";
+ exit 1
+ | node :: _ ->
+ let hostname =
+ node.MS.node_status.MS.node.Mclu_conf.hostname in
+ hostname, name in
+
+ (* Check there isn't a guest with this name running anywhere
+ * in the cluster already.
+ *)
+ List.iter (
+ fun ({ MS.active_guests = guests } as node) ->
+ List.iter (
+ fun { Mclu_list.dom_name = n } ->
+ if name = n then (
+ let hostname =
+ node.MS.node_status.MS.node.Mclu_conf.hostname
+ in
+ eprintf "mclu: there is already a guest called '%s' (running on %s)\n"
+ name hostname;
+ exit 1
+ )
+ ) guests
+ ) summary;
+
+ (* Convert hostname to a specific node, and check it is up. *)
+ let node =
+ try List.find (
+ fun node ->
+ node.MS.node_status.MS.node.Mclu_conf.hostname = hostname
+ ) summary
+ with Not_found ->
+ eprintf "mclu: no node is called '%s'\n" hostname;
+ exit 1 in
+ if not node.MS.node_status.MS.node_on then (
+ eprintf "mclu: node '%s' is switched off
+Try: `mclu on %s'\n" hostname hostname;
+ exit 1
+ );
+
+ (* Where we upload the template and image on remote. *)
+ let format, extension = "qcow2", "qcow2" in
+ let remote_filename = sprintf "/tmp/mclu%s.sh" (string_random8 ()) in
+ let remote_image = sprintf "/var/tmp/%s.%s" name extension in
+
+ (* Get ready to generate the guest XML. *)
+ let vcpus = !vcpus in
+ let vcpus =
+ if vcpus > 0 then vcpus
+ else min 4 node.MS.node_status.MS.node_info.C.cpus in
+ let mac_addr =
+ sprintf "52:54:00:%02x:%02x:%02x"
+ (Random.int 256) (Random.int 256) (Random.int 256) in
+
+ (* Generate the guest XML. XXX Quoting. *)
+ let xml = sprintf "\
+<domain type='kvm'>
+ <name>%s</name>
+ <memory unit='KiB'>%Ld</memory>
+ <currentMemory unit='KiB'>%Ld</currentMemory>
+ <vcpu>%d</vcpu>
+ <os>
+ <type>hvm</type>
+ <boot dev='hd'/>
+ </os>
+ <features>
+ <acpi/>
+ <apic/>
+ <pae/>
+ </features>
+ <cpu mode='host-model' fallback='allow' />
+ <clock offset='utc'>
+ <timer name='rtc' tickpolicy='catchup'/>
+ <timer name='pit' tickpolicy='delay'/>
+ <timer name='hpet' present='no'/>
+ </clock>
+ <on_poweroff>destroy</on_poweroff>
+ <on_reboot>restart</on_reboot>
+ <on_crash>restart</on_crash>
+ <devices>
+" name (memory /^ 1024L) (memory /^ 1024L) vcpus in
+
+ let xml = xml ^ sprintf "\
+ <disk type='file' device='disk'>
+ <driver name='qemu' type='%s' cache='none' io='native'/>
+ <source file='%s'/>
+" format remote_image in
+ let xml = xml ^
+ match template_info.Template.disk_bus with
+ | Some "ide" ->
+ " <target dev='sda' bus='ide'/>\n"
+ | Some "virtio-scsi" | None ->
+ " <target dev='sda' bus='scsi'/>\n"
+ | Some bus ->
+ eprintf "mclu: unknown disk-bus: %s\n" bus;
+ exit 1 in
+ let xml = xml ^ "\
+ </disk>
+" in
+
+ let xml = xml ^
+ if template_info.Template.disk_bus = Some "virtio-scsi" then
+ " <controller type='scsi' index='0' model='virtio-scsi'/>\n"
+ else
+ "" in
+
+ (* XXX Don't hard-code bridge name here. *)
+ let network_model =
+ match template_info with
+ | { Template.network_model = None } -> "virtio"
+ | { Template.network_model = Some d } -> d in
+ let xml = xml ^ sprintf "\
+ <interface type='bridge'>
+ <mac address='%s'/>
+ <source bridge='br0'/>
+ <model type='%s'/>
+ </interface>
+" mac_addr network_model in
+
+ let xml = xml ^ "\
+ <console type='pty'>
+ <target type='virtio' port='0'/>
+ </console>
+ <input type='tablet' bus='usb'/>
+ <input type='mouse' bus='ps2'/>
+ <input type='keyboard' bus='ps2'/>
+ <graphics type='vnc' autoport='yes'/>
+ <video>
+ <model type='cirrus' vram='9216' heads='1'/>
+ </video>
+ </devices>
+</domain>" in
+
+ (* Copy the template to remote and build the guest. *)
+ let cmd =
+ sprintf "scp %s root@%s:%s"
+ (quote template_filename) (quote hostname) remote_filename in
+ if verbose then printf "%s\n%!" cmd;
+ if Sys.command cmd <> 0 then (
+ eprintf "mclu: scp template to remote failed\n";
+ exit 1
+ );
+ let cmd =
+ (* XXX Don't hard-code network_bridge here. *)
+ sprintf "ssh root@%s LIBGUESTFS_BACKEND_SETTINGS=network_bridge=br0 %s build %s %s %s"
+ (quote hostname) remote_filename
+ (quote template_info.Template.base_image) (quote remote_image)
+ format in
+ if verbose then printf "%s\n%!" cmd;
+ if Sys.command cmd <> 0 then (
+ eprintf "mclu: remote build failed\n";
+ exit 1
+ );
+
+ (* Start the guest. *)
+ try
+ let conn =
+ let name = node.MS.node_status.MS.node.Mclu_conf.libvirt_uri in
+ C.connect ~name () in
+ let dom = D.create_xml conn xml [] in
+ printf "mclu: %s:%s started\n" hostname (D.get_name dom)
+ with Libvirt.Virterror msg ->
+ eprintf "mclu: %s: %s\n" hostname (Libvirt.Virterror.to_string msg);
+ exit 1
+
+let run ~verbose = function
+ | [ template; name ] ->
+ boot ~verbose template name
+ | _ ->
+ eprintf "Usage: mclu boot <template> <[host:]name>\n";
+ exit 1