mclu_onoff.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 on' and 'mclu off'. *)
  20
  21 open Printf
  22
  23 open Utils
  24
  25 let get_arg_speclist () = Arg.align [
  26 ]
  27
  28 let wake ~verbose nodes =
  29   let wol =
  30     match Config.path_wol with
  31     | Some wol -> wol
  32     | None ->
  33       eprintf "mclu: Wake-on-LAN is not available
  34 Recompile mclu with the 'wol' program installed\n";
  35       exit 1 in
  36
  37   (* Only wake nodes which are switched off. *)
  38   let nodes = List.filter (fun { Mclu_status.node_on = on } -> not on) nodes in
  39   let nodes = List.map (fun { Mclu_status.node = node } -> node) nodes in
  40
  41   List.iter (
  42     function
  43     | { Mclu_conf.mac_addr = Some mac_addr } ->
  44       let cmd = sprintf "%s %s" (quote wol) (quote mac_addr) in
  45       if verbose then printf "%s\n%!" cmd;
  46       if Sys.command cmd <> 0 then (
  47         eprintf "mclu: wol: command failed\n";
  48         exit 1
  49       )
  50     | { Mclu_conf.hostname = hostname; mac_addr = None } ->
  51       eprintf "mclu: Wake-on-LAN is not configured for node %s
  52 Edit mclu.conf and add 'mac=<MAC address>' to this host line.\n" hostname;
  53       exit 1
  54   ) nodes
  55
  56 let shutdown ~verbose nodes =
  57   (* Only shutdown nodes which are switched on. *)
  58   let nodes = List.filter (fun { Mclu_status.node_on = on } -> on) nodes in
  59   let nodes = List.map (fun { Mclu_status.node = node } -> node) nodes in
  60
  61   (* Get the active guests on these nodes. *)
  62   let active_guests = Mclu_list.active_guests ~verbose ~nodes () in
  63
  64   let errors = ref 0 in
  65
  66   List.iter (
  67     fun ({ Mclu_conf.hostname = hostname } as node) ->
  68       let guests = try List.assoc node active_guests with Not_found -> [] in
  69       if guests <> [] then (
  70         eprintf "mclu: node %s has %d guest(s) running: %s
  71 Shut down these guests before turning off the node.\n"
  72           hostname (List.length guests)
  73           (String.concat ", "
  74              (List.map (fun guest -> guest.Mclu_list.dom_name) guests));
  75         incr errors
  76       )
  77       else (
  78         (* We have to be cunning about this else ssh will return an error. *)
  79         let cmd =
  80           sprintf "ssh -o ForwardX11=no root@%s '(sleep 5; poweroff) </dev/null >/dev/null 2>&1 &'"
  81             (quote hostname) in
  82         if verbose then printf "%s\n%!" cmd;
  83         if Sys.command cmd <> 0 then (
  84           eprintf "mclu: %s: poweroff: command failed\n" hostname;
  85           incr errors
  86         )
  87       )
  88   ) nodes;
  89
  90   if !errors > 0 then
  91     exit 1
  92
  93 let expand_wildcards exprs =
  94   let regexps = List.map regexp_of_glob exprs in
  95   let regexps = List.map Pcre.regexp regexps in
  96
  97   let nodes = Mclu_status.node_statuses () in
  98
  99   let nodes =
 100     List.filter (
 101       fun { Mclu_status.node = { Mclu_conf.hostname = hostname } } ->
 102         List.exists (fun rex -> Pcre.pmatch ~rex hostname) regexps
 103     ) nodes in
 104
 105   if List.length nodes < List.length exprs then (
 106     eprintf "mclu: [on|off]: some wildcards don't match hostnames\n";
 107     exit 1
 108   );
 109
 110   nodes
 111
 112 let run ~verbose ~on = function
 113   | (_::_) as xs ->
 114     let nodes = expand_wildcards xs in
 115     (if on then wake else shutdown) ~verbose nodes
 116   | [] ->
 117     eprintf "Usage: mclu [on|off] node|wildcard ...\n";
 118     exit 1