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 module Ganeti.HTools.CLI
  10     ( CLIOptions(..)
  11     , EToolOptions(..)
  12     , parseOpts
  13     , parseEnv
  14     , shTemplate
  15     , loadExternalData
  16     ) where
  17
  18 import System.Console.GetOpt
  19 import System.Posix.Env
  20 import System.IO
  21 import System.Info
  22 import System
  23 import Monad
  24 import Text.Printf (printf)
  25 import qualified Data.Version
  26
  27 import qualified Ganeti.HTools.Version as Version(version)
  28 import qualified Ganeti.HTools.Rapi as Rapi
  29 import qualified Ganeti.HTools.Text as Text
  30 import qualified Ganeti.HTools.Loader as Loader
  31 import qualified Ganeti.HTools.Instance as Instance
  32 import qualified Ganeti.HTools.Node as Node
  33
  34 import Ganeti.HTools.Types
  35
  36 -- | Class for types which support show help and show version.
  37 class CLIOptions a where
  38     -- | Denotes whether the show help option has been passed.
  39     showHelp    :: a -> Bool
  40     -- | Denotes whether the show version option has been passed.
  41     showVersion :: a -> Bool
  42
  43 -- | Class for types which support the -i\/-n\/-m options.
  44 class EToolOptions a where
  45     -- | Returns the node file name.
  46     nodeFile   :: a -> FilePath
  47     -- | Tells whether the node file has been passed as an option.
  48     nodeSet    :: a -> Bool
  49     -- | Returns the instance file name.
  50     instFile   :: a -> FilePath
  51     -- | Tells whether the instance file has been passed as an option.
  52     instSet    :: a -> Bool
  53     -- | Rapi target, if one has been passed.
  54     masterName :: a -> String
  55     -- | Whether to be less verbose.
  56     silent     :: a -> Bool
  57
  58 -- | Command line parser, using the 'options' structure.
  59 parseOpts :: (CLIOptions b) =>
  60              [String]            -- ^ The command line arguments
  61           -> String              -- ^ The program name
  62           -> [OptDescr (b -> b)] -- ^ The supported command line options
  63           -> b                   -- ^ The default options record
  64           -> IO (b, [String])    -- ^ The resulting options a leftover
  65                                  -- arguments
  66 parseOpts argv progname options defaultOptions =
  67     case getOpt Permute options argv of
  68       (o, n, []) ->
  69           do
  70             let resu@(po, _) = (foldl (flip id) defaultOptions o, n)
  71             when (showHelp po) $ do
  72               putStr $ usageInfo header options
  73               exitWith ExitSuccess
  74             when (showVersion po) $ do
  75               printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
  76                      progname Version.version
  77                      compilerName (Data.Version.showVersion compilerVersion)
  78                      os arch
  79               exitWith ExitSuccess
  80             return resu
  81       (_, _, errs) ->
  82           ioError (userError (concat errs ++ usageInfo header options))
  83       where header = printf "%s %s\nUsage: %s [OPTION...]"
  84                      progname Version.version progname
  85
  86 -- | Parse the environment and return the node\/instance names.
  87 --
  88 -- This also hardcodes here the default node\/instance file names.
  89 parseEnv :: () -> IO (String, String)
  90 parseEnv () = do
  91   a <- getEnvDefault "HTOOLS_NODES" "nodes"
  92   b <- getEnvDefault "HTOOLS_INSTANCES" "instances"
  93   return (a, b)
  94
  95 -- | A shell script template for autogenerated scripts.
  96 shTemplate :: String
  97 shTemplate =
  98     printf "#!/bin/sh\n\n\
  99            \# Auto-generated script for executing cluster rebalancing\n\n\
 100            \# To stop, touch the file /tmp/stop-htools\n\n\
 101            \set -e\n\n\
 102            \check() {\n\
 103            \  if [ -f /tmp/stop-htools ]; then\n\
 104            \    echo 'Stop requested, exiting'\n\
 105            \    exit 0\n\
 106            \  fi\n\
 107            \}\n\n"
 108
 109 -- | External tool data loader from a variety of sources.
 110 loadExternalData :: (EToolOptions a) =>
 111                     a
 112                  -> IO (Node.List, Instance.List, String)
 113 loadExternalData opts = do
 114   (env_node, env_inst) <- parseEnv ()
 115   let nodef = if nodeSet opts then nodeFile opts
 116               else env_node
 117       instf = if instSet opts then instFile opts
 118               else env_inst
 119   input_data <-
 120       case masterName opts of
 121         "" -> Text.loadData nodef instf
 122         host -> Rapi.loadData host
 123
 124   let ldresult = input_data >>= Loader.mergeData
 125   (loaded_nl, il, csf) <-
 126       (case ldresult of
 127          Ok x -> return x
 128          Bad s -> do
 129            printf "Error: failed to load data. Details:\n%s\n" s
 130            exitWith $ ExitFailure 1
 131       )
 132   let (fix_msgs, fixed_nl) = Loader.checkData loaded_nl il
 133
 134   unless (null fix_msgs || silent opts) $ do
 135          putStrLn "Warning: cluster has inconsistent data:"
 136          putStrLn . unlines . map (\s -> printf "  - %s" s) $ fix_msgs
 137
 138   return (fixed_nl, il, csf)