code.grnet.gr Git - ganeti-local/blob - Ganeti/HTools/CLI.hs

   1 {-| Implementation of command-line functions.
   2
   3 This module holds the common cli-related functions for the binaries,
   4 separated into this module since Utils.hs is used in many other places
   5 and this is more IO oriented.
   6
   7 -}
   8
   9 {-
  10
  11 Copyright (C) 2009 Google Inc.
  12
  13 This program is free software; you can redistribute it and/or modify
  14 it under the terms of the GNU General Public License as published by
  15 the Free Software Foundation; either version 2 of the License, or
  16 (at your option) any later version.
  17
  18 This program is distributed in the hope that it will be useful, but
  19 WITHOUT ANY WARRANTY; without even the implied warranty of
  20 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21 General Public License for more details.
  22
  23 You should have received a copy of the GNU General Public License
  24 along with this program; if not, write to the Free Software
  25 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  26 02110-1301, USA.
  27
  28 -}
  29
  30 module Ganeti.HTools.CLI
  31     ( CLIOptions(..)
  32     , EToolOptions(..)
  33     , parseOpts
  34     , parseEnv
  35     , shTemplate
  36     , loadExternalData
  37     ) where
  38
  39 import System.Console.GetOpt
  40 import System.Posix.Env
  41 import System.IO
  42 import System.Info
  43 import System
  44 import Monad
  45 import Text.Printf (printf)
  46 import qualified Data.Version
  47
  48 import qualified Ganeti.HTools.Version as Version(version)
  49 import qualified Ganeti.HTools.Rapi as Rapi
  50 import qualified Ganeti.HTools.Text as Text
  51 import qualified Ganeti.HTools.Loader as Loader
  52 import qualified Ganeti.HTools.Instance as Instance
  53 import qualified Ganeti.HTools.Node as Node
  54
  55 import Ganeti.HTools.Types
  56
  57 -- | Class for types which support show help and show version.
  58 class CLIOptions a where
  59     -- | Denotes whether the show help option has been passed.
  60     showHelp    :: a -> Bool
  61     -- | Denotes whether the show version option has been passed.
  62     showVersion :: a -> Bool
  63
  64 -- | Class for types which support the -i\/-n\/-m options.
  65 class EToolOptions a where
  66     -- | Returns the node file name.
  67     nodeFile   :: a -> FilePath
  68     -- | Tells whether the node file has been passed as an option.
  69     nodeSet    :: a -> Bool
  70     -- | Returns the instance file name.
  71     instFile   :: a -> FilePath
  72     -- | Tells whether the instance file has been passed as an option.
  73     instSet    :: a -> Bool
  74     -- | Rapi target, if one has been passed.
  75     masterName :: a -> String
  76     -- | Whether to be less verbose.
  77     silent     :: a -> Bool
  78
  79 -- | Command line parser, using the 'options' structure.
  80 parseOpts :: (CLIOptions b) =>
  81              [String]            -- ^ The command line arguments
  82           -> String              -- ^ The program name
  83           -> [OptDescr (b -> b)] -- ^ The supported command line options
  84           -> b                   -- ^ The default options record
  85           -> IO (b, [String])    -- ^ The resulting options a leftover
  86                                  -- arguments
  87 parseOpts argv progname options defaultOptions =
  88     case getOpt Permute options argv of
  89       (o, n, []) ->
  90           do
  91             let resu@(po, _) = (foldl (flip id) defaultOptions o, n)
  92             when (showHelp po) $ do
  93               putStr $ usageInfo header options
  94               exitWith ExitSuccess
  95             when (showVersion po) $ do
  96               printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
  97                      progname Version.version
  98                      compilerName (Data.Version.showVersion compilerVersion)
  99                      os arch
 100               exitWith ExitSuccess
 101             return resu
 102       (_, _, errs) ->
 103           ioError (userError (concat errs ++ usageInfo header options))
 104       where header = printf "%s %s\nUsage: %s [OPTION...]"
 105                      progname Version.version progname
 106
 107 -- | Parse the environment and return the node\/instance names.
 108 --
 109 -- This also hardcodes here the default node\/instance file names.
 110 parseEnv :: () -> IO (String, String)
 111 parseEnv () = do
 112   a <- getEnvDefault "HTOOLS_NODES" "nodes"
 113   b <- getEnvDefault "HTOOLS_INSTANCES" "instances"
 114   return (a, b)
 115
 116 -- | A shell script template for autogenerated scripts.
 117 shTemplate :: String
 118 shTemplate =
 119     printf "#!/bin/sh\n\n\
 120            \# Auto-generated script for executing cluster rebalancing\n\n\
 121            \# To stop, touch the file /tmp/stop-htools\n\n\
 122            \set -e\n\n\
 123            \check() {\n\
 124            \  if [ -f /tmp/stop-htools ]; then\n\
 125            \    echo 'Stop requested, exiting'\n\
 126            \    exit 0\n\
 127            \  fi\n\
 128            \}\n\n"
 129
 130 -- | External tool data loader from a variety of sources.
 131 loadExternalData :: (EToolOptions a) =>
 132                     a
 133                  -> IO (Node.List, Instance.List, String)
 134 loadExternalData opts = do
 135   (env_node, env_inst) <- parseEnv ()
 136   let nodef = if nodeSet opts then nodeFile opts
 137               else env_node
 138       instf = if instSet opts then instFile opts
 139               else env_inst
 140   input_data <-
 141       case masterName opts of
 142         "" -> Text.loadData nodef instf
 143         host -> Rapi.loadData host
 144
 145   let ldresult = input_data >>= Loader.mergeData
 146   (loaded_nl, il, csf) <-
 147       (case ldresult of
 148          Ok x -> return x
 149          Bad s -> do
 150            printf "Error: failed to load data. Details:\n%s\n" s
 151            exitWith $ ExitFailure 1
 152       )
 153   let (fix_msgs, fixed_nl) = Loader.checkData loaded_nl il
 154
 155   unless (null fix_msgs || silent opts) $ do
 156          putStrLn "Warning: cluster has inconsistent data:"
 157          putStrLn . unlines . map (\s -> printf "  - %s" s) $ fix_msgs
 158
 159   return (fixed_nl, il, csf)