(* 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 size = ref 0L                       (* 0 = default *)
let set_size s =
  try size := bytes_of_human_size s
  with Not_found ->
    eprintf "mclu: don't understand --size parameter '%s'
Try something like --size 20G\n" s;
    exit 1
let timezone = ref ""                   (* "" = no timezone set *)
let vcpus = ref 0                       (* 0 = choose for me *)

let open_console = ref false
let open_viewer = ref false

let get_arg_speclist () = Arg.align [
  "--console",  Arg.Set open_console, " Open the serial console";
  "--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";
  "--size",     Arg.String set_size, "nnG Size of disk to give guest";
  "--timezone", Arg.Set_string timezone, "TZ Set timezone of guest";
  "--vcpus",    Arg.Set_int vcpus, "n Number of virtual CPUs";
  "--viewer",   Arg.Set open_viewer, " Open the graphical console";
]

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_template = sprintf "/tmp/mclu%s.sh" (string_random8 ()) in
  let remote_template_wrapper = 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 ^ "\
    <serial type='pty'>
      <target port='0'/>
    </serial>
    <console type='pty'>
      <target type='serial' 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. *)
  let cmd =
    sprintf "scp %s root@%s:%s"
      (quote template_filename) (quote hostname) remote_template in
  if verbose then printf "%s\n%!" cmd;
  if Sys.command cmd <> 0 then (
    eprintf "mclu: scp template to remote failed\n";
    exit 1
  );

  (* Create a wrapper script that sets the variables and runs the
   * template.  This just avoids complex quoting.
   *)
  let () =
    let chan = open_out remote_template_wrapper in
    let fpf fs = fprintf chan fs in
    fpf "#!/bin/sh\n";
    (* XXX Don't hard-code network_bridge here. *)
    fpf "export LIBGUESTFS_BACKEND_SETTINGS=network_bridge=br0\n";
    fpf "export base_image=%s\n" (quote template_info.Template.base_image);
    fpf "export format=%s\n" (quote format);
    fpf "export name=%s\n" (quote name);
    fpf "export output=%s\n" (quote remote_image);
    (match !size with
    | 0L -> ()
    | size -> fpf "export size=%s\n" (quote (sprintf "--size %Ldb" size))
    );
    (match !timezone with
    | "" -> ()
    | tz -> fpf "export timezone=%s\n" (quote (sprintf "--timezone %s" tz))
    );
    fpf "%s build\n" remote_template;
    close_out chan;
    Unix.chmod remote_template_wrapper 0o755 in

  let cmd =
    sprintf "scp %s root@%s:%s"
      (quote remote_template_wrapper) (quote hostname)
      (quote remote_template_wrapper) in
  if verbose then printf "%s\n%!" cmd;
  if Sys.command cmd <> 0 then (
    eprintf "mclu: scp template wrapper to remote failed\n";
    exit 1
  );

  let cmd =
    sprintf "ssh root@%s %s" (quote hostname) (quote remote_template_wrapper) 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. *)
  let dom =
    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);
      dom
    with Libvirt.Virterror msg ->
      eprintf "mclu: %s: %s\n" hostname (Libvirt.Virterror.to_string msg);
      exit 1 in

  (* Graphical console? *)
  if !open_viewer then
    Mclu_viewer.viewer ~verbose ~host:hostname (D.get_name dom);

  (* Serial console?  (Interactive, so run it last) *)
  if !open_console then
    Mclu_console.console ~verbose ~host:hostname (D.get_name dom)

let run ~verbose = function
  | [ template; name ] ->
    boot ~verbose template name
  | _ ->
    eprintf "Usage: mclu boot <template> <[host:]name>\n";
    exit 1