(* 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 list'. *)

open Printf

open Utils

module C = Libvirt.Connect
module D = Libvirt.Domain

let list_what = ref `All
let set_all () = list_what := `All
let set_active () = list_what := `ActiveOnly
let set_templates () = list_what := `TemplatesOnly

let get_arg_speclist () = Arg.align [
  "--active", Arg.Unit set_active, " List only active/running guests";
  "--all", Arg.Unit set_all, " List active guests and templates (default)";
  "--inactive", Arg.Unit set_templates, " List only templates";
  "--running", Arg.Unit set_active, " List only active/running guests";
  "--templates", Arg.Unit set_templates, " List only templates";
]

type dom_info = {
  dom_name : string;
  dom_info : D.info;
}

(* Return the active (running) guests.  This utility function is
 * also called from other places.
 *)
let active_guests ?(verbose = false) ?(nodes = Mclu_conf.nodes ()) () =
  (* A list of running guests, indexed by each node. *)
  let active_guests =
    Parallel.map (
      fun node ->
        let hostname = node.Mclu_conf.hostname
        and name = node.Mclu_conf.libvirt_uri in
        let conn =
          try Some (C.connect_readonly ~name ())
          with Libvirt.Virterror msg ->
            if verbose then
              eprintf "mclu: %s: %s (ignored)\n" hostname
                (Libvirt.Virterror.to_string msg);
            None in
        let dominfo =
          match conn with
          | Some conn ->
            let dominfos = D.get_domains_and_infos conn [D.ListActive] in
            (* D.t is abstract so we cannot marshal it. *)
            List.map (
              fun (dom, info) ->
                { dom_name = D.get_name dom; dom_info = info }
            ) dominfos
          | None -> [] in
        (node, dominfo)
    ) nodes in
  List.map (fun s -> Marshal.from_bytes s 0) active_guests

let list ~verbose () =
  let list_what = !list_what in

  (match list_what with
  | `TemplatesOnly -> ()
  | `All | `ActiveOnly ->
    let active_guests = active_guests ~verbose () in

    List.iter (
      fun ({ Mclu_conf.hostname = hostname }, dominfos) ->
        List.iter (
          fun { dom_name = name;
                dom_info = { D.nr_virt_cpu = vcpus;
                             D.memory = memory_kb;
                             D.state = state } } ->
            let host_dom_name = sprintf "%s:%s" hostname name in
            printf "%-28s %s %dvcpus %s\n"
              host_dom_name (string_of_dom_state state)
              vcpus (human_size (memory_kb *^ 1024L))
        ) dominfos
    ) active_guests
  );

  (* For quasi-historical reasons, this command also lists the inactive
   * guests, which in mclu v2 are templates.
   *)
  (match list_what with
  | `ActiveOnly -> ()
  | `All | `TemplatesOnly ->
    let templates = Template.template_names () in

    List.iter (
      fun name ->
        printf "%-28s template\n" name
    ) templates
  )

let run ~verbose = function
  | [] -> list ~verbose ()
  | _ ->
    eprintf "mclu list: Too many arguments\n";
    exit 1