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     ( Options(..)
  32     , OptType
  33     , parseOpts
  34     , parseEnv
  35     , shTemplate
  36     , loadExternalData
  37     , defaultLuxiSocket
  38     -- * The options
  39     , oPrintNodes
  40     , oPrintCommands
  41     , oOneline
  42     , oNoHeaders
  43     , oOutputDir
  44     , oNodeFile
  45     , oInstFile
  46     , oNodeSim
  47     , oRapiMaster
  48     , oLuxiSocket
  49     , oMaxSolLength
  50     , oVerbose
  51     , oQuiet
  52     , oOfflineNode
  53     , oMinScore
  54     , oIMem
  55     , oIDisk
  56     , oIVcpus
  57     , oINodes
  58     , oMaxCpu
  59     , oMinDisk
  60     , oDiskMoves
  61     , oShowVer
  62     , oShowHelp
  63     ) where
  64
  65 import Control.Exception
  66 import Data.Maybe (isJust, fromJust, fromMaybe)
  67 import qualified Data.Version
  68 import Monad
  69 import System.Console.GetOpt
  70 import System.Posix.Env
  71 import System.IO
  72 import System.Info
  73 import System
  74 import Text.Printf (printf, hPrintf)
  75
  76 import qualified Ganeti.HTools.Version as Version(version)
  77 import qualified Ganeti.HTools.Luxi as Luxi
  78 import qualified Ganeti.HTools.Rapi as Rapi
  79 import qualified Ganeti.HTools.Simu as Simu
  80 import qualified Ganeti.HTools.Text as Text
  81 import qualified Ganeti.HTools.Loader as Loader
  82 import qualified Ganeti.HTools.Instance as Instance
  83 import qualified Ganeti.HTools.Node as Node
  84 import qualified Ganeti.HTools.Cluster as Cluster
  85
  86 import Ganeti.HTools.Types
  87
  88 -- | The default value for the luxi socket
  89 defaultLuxiSocket :: FilePath
  90 defaultLuxiSocket = "/var/run/ganeti/socket/ganeti-master"
  91
  92 -- | Command line options structure.
  93 data Options = Options
  94     { optShowNodes :: Bool           -- ^ Whether to show node status
  95     , optShowCmds  :: Maybe FilePath -- ^ Whether to show the command list
  96     , optOneline   :: Bool           -- ^ Switch output to a single line
  97     , optOutPath   :: FilePath       -- ^ Path to the output directory
  98     , optNoHeaders :: Bool           -- ^ Do not show a header line
  99     , optNodeFile  :: FilePath       -- ^ Path to the nodes file
 100     , optNodeSet   :: Bool           -- ^ The nodes have been set by options
 101     , optInstFile  :: FilePath       -- ^ Path to the instances file
 102     , optInstSet   :: Bool           -- ^ The insts have been set by options
 103     , optNodeSim   :: Maybe String   -- ^ Cluster simulation mode
 104     , optMaxLength :: Int            -- ^ Stop after this many steps
 105     , optMaster    :: String         -- ^ Collect data from RAPI
 106     , optLuxi      :: Maybe FilePath -- ^ Collect data from Luxi
 107     , optOffline   :: [String]       -- ^ Names of offline nodes
 108     , optIMem      :: Int            -- ^ Instance memory
 109     , optIDsk      :: Int            -- ^ Instance disk
 110     , optIVCPUs    :: Int            -- ^ Instance VCPUs
 111     , optINodes    :: Int            -- ^ Nodes required for an instance
 112     , optMinScore  :: Cluster.Score  -- ^ The minimum score we aim for
 113     , optMcpu      :: Double         -- ^ Max cpu ratio for nodes
 114     , optMdsk      :: Double         -- ^ Max disk usage ratio for nodes
 115     , optDiskMoves :: Bool           -- ^ Allow disk moves
 116     , optVerbose   :: Int            -- ^ Verbosity level
 117     , optShowVer   :: Bool           -- ^ Just show the program version
 118     , optShowHelp  :: Bool           -- ^ Just show the help
 119     } deriving Show
 120
 121 -- | Default values for the command line options.
 122 defaultOptions :: Options
 123 defaultOptions  = Options
 124  { optShowNodes = False
 125  , optShowCmds  = Nothing
 126  , optOneline   = False
 127  , optNoHeaders = False
 128  , optOutPath   = "."
 129  , optNodeFile  = "nodes"
 130  , optNodeSet   = False
 131  , optInstFile  = "instances"
 132  , optInstSet   = False
 133  , optNodeSim   = Nothing
 134  , optMaxLength = -1
 135  , optMaster    = ""
 136  , optLuxi      = Nothing
 137  , optOffline   = []
 138  , optIMem      = 4096
 139  , optIDsk      = 102400
 140  , optIVCPUs    = 1
 141  , optINodes    = 2
 142  , optMinScore  = 1e-9
 143  , optMcpu      = -1
 144  , optMdsk      = -1
 145  , optDiskMoves = True
 146  , optVerbose   = 1
 147  , optShowVer   = False
 148  , optShowHelp  = False
 149  }
 150
 151 -- | Abrreviation for the option type
 152 type OptType = OptDescr (Options -> Options)
 153
 154 oPrintNodes :: OptType
 155 oPrintNodes = Option "p" ["print-nodes"]
 156               (NoArg (\ opts -> opts { optShowNodes = True }))
 157               "print the final node list"
 158
 159 oPrintCommands :: OptType
 160 oPrintCommands = Option "C" ["print-commands"]
 161                  (OptArg ((\ f opts -> opts { optShowCmds = Just f }) .
 162                           fromMaybe "-")
 163                   "FILE")
 164                  "print the ganeti command list for reaching the solution,\
 165                  \ if an argument is passed then write the commands to a\
 166                  \ file named as such"
 167
 168 oOneline :: OptType
 169 oOneline = Option "o" ["oneline"]
 170            (NoArg (\ opts -> opts { optOneline = True }))
 171            "print the ganeti command list for reaching the solution"
 172
 173 oNoHeaders :: OptType
 174 oNoHeaders = Option "" ["no-headers"]
 175              (NoArg (\ opts -> opts { optNoHeaders = True }))
 176              "do not show a header line"
 177
 178 oOutputDir :: OptType
 179 oOutputDir = Option "d" ["output-dir"]
 180              (ReqArg (\ d opts -> opts { optOutPath = d }) "PATH")
 181              "directory in which to write output files"
 182
 183 oNodeFile :: OptType
 184 oNodeFile = Option "n" ["nodes"]
 185             (ReqArg (\ f o -> o { optNodeFile = f, optNodeSet = True }) "FILE")
 186             "the node list FILE"
 187
 188 oInstFile :: OptType
 189 oInstFile = Option "i" ["instances"]
 190             (ReqArg (\ f o -> o { optInstFile = f, optInstSet = True }) "FILE")
 191             "the instance list FILE"
 192
 193 oNodeSim :: OptType
 194 oNodeSim = Option "" ["simulate"]
 195             (ReqArg (\ f o -> o { optNodeSim = Just f }) "SPEC")
 196             "simulate an empty cluster, given as 'num_nodes,disk,memory,cpus'"
 197
 198 oRapiMaster :: OptType
 199 oRapiMaster = Option "m" ["master"]
 200               (ReqArg (\ m opts -> opts { optMaster = m }) "ADDRESS")
 201               "collect data via RAPI at the given ADDRESS"
 202
 203 oLuxiSocket :: OptType
 204 oLuxiSocket = Option "L" ["luxi"]
 205               (OptArg ((\ f opts -> opts { optLuxi = Just f }) .
 206                        fromMaybe defaultLuxiSocket) "SOCKET")
 207               "collect data via Luxi, optionally using the given SOCKET path"
 208
 209 oVerbose :: OptType
 210 oVerbose = Option "v" ["verbose"]
 211            (NoArg (\ opts -> opts { optVerbose = optVerbose opts + 1 }))
 212            "increase the verbosity level"
 213
 214 oQuiet :: OptType
 215 oQuiet = Option "q" ["quiet"]
 216          (NoArg (\ opts -> opts { optVerbose = optVerbose opts - 1 }))
 217          "decrease the verbosity level"
 218
 219 oOfflineNode :: OptType
 220 oOfflineNode = Option "O" ["offline"]
 221                (ReqArg (\ n o -> o { optOffline = n:optOffline o }) "NODE")
 222                "set node as offline"
 223
 224 oMaxSolLength :: OptType
 225 oMaxSolLength = Option "l" ["max-length"]
 226                 (ReqArg (\ i opts -> opts { optMaxLength =  read i::Int }) "N")
 227                 "cap the solution at this many moves (useful for very\
 228                 \ unbalanced clusters)"
 229
 230 oMinScore :: OptType
 231 oMinScore = Option "e" ["min-score"]
 232             (ReqArg (\ e opts -> opts { optMinScore = read e }) "EPSILON")
 233             " mininum score to aim for"
 234
 235 oIMem :: OptType
 236 oIMem = Option "" ["memory"]
 237         (ReqArg (\ m opts -> opts { optIMem = read m }) "MEMORY")
 238         "memory size for instances"
 239
 240 oIDisk :: OptType
 241 oIDisk = Option "" ["disk"]
 242          (ReqArg (\ d opts -> opts { optIDsk = read d }) "DISK")
 243          "disk size for instances"
 244
 245 oIVcpus :: OptType
 246 oIVcpus = Option "" ["vcpus"]
 247           (ReqArg (\ p opts -> opts { optIVCPUs = read p }) "NUM")
 248           "number of virtual cpus for instances"
 249
 250 oINodes :: OptType
 251 oINodes = Option "" ["req-nodes"]
 252           (ReqArg (\ n opts -> opts { optINodes = read n }) "NODES")
 253           "number of nodes for the new instances (1=plain, 2=mirrored)"
 254
 255 oMaxCpu :: OptType
 256 oMaxCpu = Option "" ["max-cpu"]
 257           (ReqArg (\ n opts -> opts { optMcpu = read n }) "RATIO")
 258           "maximum virtual-to-physical cpu ratio for nodes"
 259
 260 oMinDisk :: OptType
 261 oMinDisk = Option "" ["min-disk"]
 262            (ReqArg (\ n opts -> opts { optMdsk = read n }) "RATIO")
 263            "minimum free disk space for nodes (between 0 and 1)"
 264
 265 oDiskMoves :: OptType
 266 oDiskMoves = Option "" ["no-disk-moves"]
 267              (NoArg (\ opts -> opts { optDiskMoves = False}))
 268              "disallow disk moves from the list of allowed instance changes,\
 269              \ thus allowing only the 'cheap' failover/migrate operations"
 270
 271 oShowVer :: OptType
 272 oShowVer = Option "V" ["version"]
 273            (NoArg (\ opts -> opts { optShowVer = True}))
 274            "show the version of the program"
 275
 276 oShowHelp :: OptType
 277 oShowHelp = Option "h" ["help"]
 278             (NoArg (\ opts -> opts { optShowHelp = True}))
 279             "show help"
 280
 281 -- | Usage info
 282 usageHelp :: String -> [OptType] -> String
 283 usageHelp progname =
 284     usageInfo (printf "%s %s\nUsage: %s [OPTION...]"
 285                progname Version.version progname)
 286
 287 -- | Command line parser, using the 'options' structure.
 288 parseOpts :: [String]               -- ^ The command line arguments
 289           -> String                 -- ^ The program name
 290           -> [OptType]              -- ^ The supported command line options
 291           -> IO (Options, [String]) -- ^ The resulting options and leftover
 292                                     -- arguments
 293 parseOpts argv progname options =
 294     case getOpt Permute options argv of
 295       (o, n, []) ->
 296           do
 297             let resu@(po, _) = (foldl (flip id) defaultOptions o, n)
 298             when (optShowHelp po) $ do
 299               putStr $ usageHelp progname options
 300               exitWith ExitSuccess
 301             when (optShowVer po) $ do
 302               printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
 303                      progname Version.version
 304                      compilerName (Data.Version.showVersion compilerVersion)
 305                      os arch
 306               exitWith ExitSuccess
 307             return resu
 308       (_, _, errs) -> do
 309         hPutStrLn stderr $ "Command line error: "  ++ concat errs
 310         hPutStrLn stderr $ usageHelp progname options
 311         exitWith $ ExitFailure 2
 312
 313 -- | Parse the environment and return the node\/instance names.
 314 --
 315 -- This also hardcodes here the default node\/instance file names.
 316 parseEnv :: () -> IO (String, String)
 317 parseEnv () = do
 318   a <- getEnvDefault "HTOOLS_NODES" "nodes"
 319   b <- getEnvDefault "HTOOLS_INSTANCES" "instances"
 320   return (a, b)
 321
 322 -- | A shell script template for autogenerated scripts.
 323 shTemplate :: String
 324 shTemplate =
 325     printf "#!/bin/sh\n\n\
 326            \# Auto-generated script for executing cluster rebalancing\n\n\
 327            \# To stop, touch the file /tmp/stop-htools\n\n\
 328            \set -e\n\n\
 329            \check() {\n\
 330            \  if [ -f /tmp/stop-htools ]; then\n\
 331            \    echo 'Stop requested, exiting'\n\
 332            \    exit 0\n\
 333            \  fi\n\
 334            \}\n\n"
 335
 336 -- | Error beautifier
 337 wrapIO :: IO (Result a) -> IO (Result a)
 338 wrapIO = handle (return . Bad . show)
 339
 340 -- | External tool data loader from a variety of sources.
 341 loadExternalData :: Options
 342                  -> IO (Node.List, Instance.List, String)
 343 loadExternalData opts = do
 344   (env_node, env_inst) <- parseEnv ()
 345   let nodef = if optNodeSet opts then optNodeFile opts
 346               else env_node
 347       instf = if optInstSet opts then optInstFile opts
 348               else env_inst
 349       mhost = optMaster opts
 350       lsock = optLuxi opts
 351       simdata = optNodeSim opts
 352       setRapi = mhost /= ""
 353       setLuxi = isJust lsock
 354       setSim = isJust simdata
 355       setFiles = optNodeSet opts || optInstSet opts
 356       allSet = filter id [setRapi, setLuxi, setFiles]
 357   when (length allSet > 1) $
 358        do
 359          hPutStrLn stderr "Error: Only one of the rapi, luxi, and data\
 360                           \ files options should be given."
 361          exitWith $ ExitFailure 1
 362
 363   input_data <-
 364       case () of
 365         _ | setRapi -> wrapIO $ Rapi.loadData mhost
 366           | setLuxi -> wrapIO $ Luxi.loadData $ fromJust lsock
 367           | setSim -> Simu.loadData $ fromJust simdata
 368           | otherwise -> wrapIO $ Text.loadData nodef instf
 369
 370   let ldresult = input_data >>= Loader.mergeData
 371   (loaded_nl, il, csf) <-
 372       (case ldresult of
 373          Ok x -> return x
 374          Bad s -> do
 375            hPrintf stderr "Error: failed to load data. Details:\n%s\n" s
 376            exitWith $ ExitFailure 1
 377       )
 378   let (fix_msgs, fixed_nl) = Loader.checkData loaded_nl il
 379
 380   unless (null fix_msgs || optVerbose opts == 0) $ do
 381          hPutStrLn stderr "Warning: cluster has inconsistent data:"
 382          hPutStrLn stderr . unlines . map (printf "  - %s") $ fix_msgs
 383
 384   return (fixed_nl, il, csf)