mclu_status.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 status'. *)
  20
  21 open Printf
  22
  23 open Utils
  24
  25 module C = Libvirt.Connect
  26 module D = Libvirt.Domain
  27
  28 let get_arg_speclist () = Arg.align [
  29 ]
  30
  31 type node_status = {
  32   node : Mclu_conf.node;
  33   node_on : bool;               (* true = appears to be switched on *)
  34   node_info : C.node_info;
  35 }
  36
  37 let node_statuses ?(verbose = false) ?(nodes = Mclu_conf.nodes ()) () =
  38   let nodes =
  39     Parallel.map (
  40       fun node ->
  41         let hostname = node.Mclu_conf.hostname
  42         and name = node.Mclu_conf.libvirt_uri in
  43         let conn =
  44           try Some (C.connect_readonly ~name ())
  45           with Libvirt.Virterror msg ->
  46             if verbose then
  47               eprintf "mclu: %s: %s (ignored)\n" hostname
  48                 (Libvirt.Virterror.to_string msg);
  49             None in
  50         let node_info =
  51           match conn with
  52           | Some conn -> C.get_node_info conn
  53           | None -> { C.model = ""; memory = 0L; cpus = 0;
  54                       mhz = 0; nodes = 0;
  55                       sockets = 0; cores = 0; threads = 0 } in
  56         { node = node; node_on = conn <> None; node_info = node_info }
  57     ) nodes in
  58   List.map (fun s -> Marshal.from_bytes s 0) nodes
  59
  60 type node_guest_summary = {
  61   node_status : node_status;
  62   active_guests : Mclu_list.dom_info list;
  63   used_memory : int64;
  64   used_vcpus : int;
  65   free_memory : int64;
  66 }
  67
  68 let node_guest_summary ?(verbose = false) () =
  69   let node_statuses = node_statuses ~verbose () in
  70
  71   (* Get list of active guests for nodes which are on. *)
  72   let active_guests =
  73     let nodes = List.filter (fun { node_on = on } -> on) node_statuses in
  74     let nodes = List.map (fun { node = node } -> node) nodes in
  75     Mclu_list.active_guests ~verbose ~nodes () in
  76
  77   List.map (
  78     fun node_status ->
  79       let guests =
  80         try List.assoc node_status.node active_guests with Not_found -> [] in
  81       let used_vcpus, used_memory_kb =
  82         List.fold_left (
  83           fun (used_vcpus, used_memory_kb)
  84           { Mclu_list.dom_info = { D.nr_virt_cpu = vcpus;
  85                                    memory = memory_kb } } ->
  86             (used_vcpus + vcpus, used_memory_kb +^ memory_kb)
  87         ) (0, 0L) guests in
  88       let used_memory = used_memory_kb *^ 1024L in
  89       let total_memory =
  90         node_status.node_info.C.memory *^ 1024L in
  91       let total_memory =
  92         max (total_memory -^ 1024L *^ 1024L *^ 1024L) 0L in
  93       let free_memory = total_memory -^ used_memory in
  94       { node_status = node_status;
  95         active_guests = guests;
  96         used_memory = used_memory;
  97         used_vcpus = used_vcpus;
  98         free_memory = free_memory }
  99   ) node_statuses
 100
 101 let status ~verbose () =
 102   let summary = node_guest_summary ~verbose () in
 103
 104   List.iter (
 105     function
 106     | { node_status = { node_on = false;
 107                         node = { Mclu_conf.hostname = hostname } } } ->
 108       printf "%-28s off\n" hostname
 109     | { node_status = { node_on = true;
 110                         node = { Mclu_conf.hostname = hostname };
 111                         node_info = node_info };
 112         active_guests = guests;
 113         used_vcpus = used_vcpus;
 114         used_memory = used_memory;
 115         free_memory = free_memory } ->
 116       printf "%-28s on\n" hostname;
 117       printf "                               ";
 118       printf "total: %dpcpus %s\n"
 119         node_info.C.cpus (human_size (node_info.C.memory *^ 1024L));
 120       if guests <> [] then (
 121         printf "                                ";
 122         printf "used: %dvcpus %s by %d guest(s)\n"
 123           used_vcpus (human_size used_memory) (List.length guests)
 124       );
 125       printf "                                ";
 126       printf "free: %s\n" (human_size free_memory)
 127   ) summary;
 128
 129   ()
 130
 131 let run ~verbose = function
 132   | [] -> status ~verbose ()
 133   | _ ->
 134     eprintf "mclu status: Too many arguments\n";
 135     exit 1