code.grnet.gr Git - ganeti-local/blob - htools/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, 2010, 2011 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     , shTemplate
  35     , defaultLuxiSocket
  36     , maybePrintNodes
  37     , maybePrintInsts
  38     -- * The options
  39     , oDataFile
  40     , oDiskMoves
  41     , oSelInst
  42     , oInstMoves
  43     , oDynuFile
  44     , oEvacMode
  45     , oExInst
  46     , oExTags
  47     , oExecJobs
  48     , oGroup
  49     , oIDisk
  50     , oIMem
  51     , oINodes
  52     , oIVcpus
  53     , oLuxiSocket
  54     , oMaxCpu
  55     , oMaxSolLength
  56     , oMinDisk
  57     , oMinGain
  58     , oMinGainLim
  59     , oMinScore
  60     , oNoHeaders
  61     , oNodeSim
  62     , oOfflineNode
  63     , oOneline
  64     , oOutputDir
  65     , oPrintCommands
  66     , oPrintInsts
  67     , oPrintNodes
  68     , oQuiet
  69     , oRapiMaster
  70     , oReplay
  71     , oSaveCluster
  72     , oShowHelp
  73     , oShowVer
  74     , oTieredSpec
  75     , oVerbose
  76     ) where
  77
  78 import Control.Monad
  79 import Data.Maybe (fromMaybe)
  80 import qualified Data.Version
  81 import System.Console.GetOpt
  82 import System.IO
  83 import System.Info
  84 import System
  85 import Text.Printf (printf)
  86
  87 import qualified Ganeti.HTools.Version as Version(version)
  88 import qualified Ganeti.Constants as C
  89 import Ganeti.HTools.Types
  90 import Ganeti.HTools.Utils
  91
  92 -- | The default value for the luxi socket
  93 defaultLuxiSocket :: FilePath
  94 defaultLuxiSocket = C.masterSocket
  95
  96 -- | Command line options structure.
  97 data Options = Options
  98     { optDataFile    :: Maybe FilePath -- ^ Path to the cluster data file
  99     , optDiskMoves   :: Bool           -- ^ Allow disk moves
 100     , optInstMoves   :: Bool           -- ^ Allow instance moves
 101     , optDynuFile    :: Maybe FilePath -- ^ Optional file with dynamic use data
 102     , optEvacMode    :: Bool           -- ^ Enable evacuation mode
 103     , optExInst      :: [String]       -- ^ Instances to be excluded
 104     , optExTags      :: Maybe [String] -- ^ Tags to use for exclusion
 105     , optExecJobs    :: Bool           -- ^ Execute the commands via Luxi
 106     , optGroup       :: Maybe GroupID  -- ^ The UUID of the group to process
 107     , optSelInst     :: [String]       -- ^ Instances to be excluded
 108     , optINodes      :: Int            -- ^ Nodes required for an instance
 109     , optISpec       :: RSpec          -- ^ Requested instance specs
 110     , optLuxi        :: Maybe FilePath -- ^ Collect data from Luxi
 111     , optMaster      :: String         -- ^ Collect data from RAPI
 112     , optMaxLength   :: Int            -- ^ Stop after this many steps
 113     , optMcpu        :: Double         -- ^ Max cpu ratio for nodes
 114     , optMdsk        :: Double         -- ^ Max disk usage ratio for nodes
 115     , optMinGain     :: Score          -- ^ Min gain we aim for in a step
 116     , optMinGainLim  :: Score          -- ^ Limit below which we apply mingain
 117     , optMinScore    :: Score          -- ^ The minimum score we aim for
 118     , optNoHeaders   :: Bool           -- ^ Do not show a header line
 119     , optNodeSim     :: [String]       -- ^ Cluster simulation mode
 120     , optOffline     :: [String]       -- ^ Names of offline nodes
 121     , optOneline     :: Bool           -- ^ Switch output to a single line
 122     , optOutPath     :: FilePath       -- ^ Path to the output directory
 123     , optSaveCluster :: Maybe FilePath -- ^ Save cluster state to this file
 124     , optShowCmds    :: Maybe FilePath -- ^ Whether to show the command list
 125     , optShowHelp    :: Bool           -- ^ Just show the help
 126     , optShowInsts   :: Bool           -- ^ Whether to show the instance map
 127     , optShowNodes   :: Maybe [String] -- ^ Whether to show node status
 128     , optShowVer     :: Bool           -- ^ Just show the program version
 129     , optTieredSpec  :: Maybe RSpec    -- ^ Requested specs for tiered mode
 130     , optReplay      :: Maybe String   -- ^ Unittests: RNG state
 131     , optVerbose     :: Int            -- ^ Verbosity level
 132     } deriving Show
 133
 134 -- | Default values for the command line options.
 135 defaultOptions :: Options
 136 defaultOptions  = Options
 137  { optDataFile    = Nothing
 138  , optDiskMoves   = True
 139  , optInstMoves   = True
 140  , optDynuFile    = Nothing
 141  , optEvacMode    = False
 142  , optExInst      = []
 143  , optExTags      = Nothing
 144  , optExecJobs    = False
 145  , optGroup       = Nothing
 146  , optSelInst     = []
 147  , optINodes      = 2
 148  , optISpec       = RSpec 1 4096 102400
 149  , optLuxi        = Nothing
 150  , optMaster      = ""
 151  , optMaxLength   = -1
 152  , optMcpu        = defVcpuRatio
 153  , optMdsk        = defReservedDiskRatio
 154  , optMinGain     = 1e-2
 155  , optMinGainLim  = 1e-1
 156  , optMinScore    = 1e-9
 157  , optNoHeaders   = False
 158  , optNodeSim     = []
 159  , optOffline     = []
 160  , optOneline     = False
 161  , optOutPath     = "."
 162  , optSaveCluster = Nothing
 163  , optShowCmds    = Nothing
 164  , optShowHelp    = False
 165  , optShowInsts   = False
 166  , optShowNodes   = Nothing
 167  , optShowVer     = False
 168  , optTieredSpec  = Nothing
 169  , optReplay      = Nothing
 170  , optVerbose     = 1
 171  }
 172
 173 -- | Abrreviation for the option type
 174 type OptType = OptDescr (Options -> Result Options)
 175
 176 oDataFile :: OptType
 177 oDataFile = Option "t" ["text-data"]
 178             (ReqArg (\ f o -> Ok o { optDataFile = Just f }) "FILE")
 179             "the cluster data FILE"
 180
 181 oDiskMoves :: OptType
 182 oDiskMoves = Option "" ["no-disk-moves"]
 183              (NoArg (\ opts -> Ok opts { optDiskMoves = False}))
 184              "disallow disk moves from the list of allowed instance changes,\
 185              \ thus allowing only the 'cheap' failover/migrate operations"
 186
 187 oSelInst :: OptType
 188 oSelInst = Option "" ["select-instances"]
 189           (ReqArg (\ f opts -> Ok opts { optSelInst = sepSplit ',' f }) "INSTS")
 190           "only select given instances for any moves"
 191
 192 oInstMoves :: OptType
 193 oInstMoves = Option "" ["no-instance-moves"]
 194              (NoArg (\ opts -> Ok opts { optInstMoves = False}))
 195              "disallow instance (primary node) moves from the list of allowed,\
 196              \ instance changes, thus allowing only slower, but sometimes\
 197              \ safer, drbd secondary changes"
 198
 199 oDynuFile :: OptType
 200 oDynuFile = Option "U" ["dynu-file"]
 201             (ReqArg (\ f opts -> Ok opts { optDynuFile = Just f }) "FILE")
 202             "Import dynamic utilisation data from the given FILE"
 203
 204 oEvacMode :: OptType
 205 oEvacMode = Option "E" ["evac-mode"]
 206             (NoArg (\opts -> Ok opts { optEvacMode = True }))
 207             "enable evacuation mode, where the algorithm only moves \
 208             \ instances away from offline and drained nodes"
 209
 210 oExInst :: OptType
 211 oExInst = Option "" ["exclude-instances"]
 212           (ReqArg (\ f opts -> Ok opts { optExInst = sepSplit ',' f }) "INSTS")
 213           "exclude given instances from any moves"
 214
 215 oExTags :: OptType
 216 oExTags = Option "" ["exclusion-tags"]
 217             (ReqArg (\ f opts -> Ok opts { optExTags = Just $ sepSplit ',' f })
 218              "TAG,...") "Enable instance exclusion based on given tag prefix"
 219
 220 oExecJobs :: OptType
 221 oExecJobs = Option "X" ["exec"]
 222              (NoArg (\ opts -> Ok opts { optExecJobs = True}))
 223              "execute the suggested moves via Luxi (only available when using\
 224              \ it for data gathering)"
 225
 226 oGroup :: OptType
 227 oGroup = Option "G" ["group"]
 228             (ReqArg (\ f o -> Ok o { optGroup = Just f }) "ID")
 229             "the ID of the group to balance"
 230
 231 oIDisk :: OptType
 232 oIDisk = Option "" ["disk"]
 233          (ReqArg (\ d opts ->
 234                      let ospec = optISpec opts
 235                          nspec = ospec { rspecDsk = read d }
 236                      in Ok opts { optISpec = nspec }) "DISK")
 237          "disk size for instances"
 238
 239 oIMem :: OptType
 240 oIMem = Option "" ["memory"]
 241         (ReqArg (\ m opts ->
 242                      let ospec = optISpec opts
 243                          nspec = ospec { rspecMem = read m }
 244                      in Ok opts { optISpec = nspec }) "MEMORY")
 245         "memory size for instances"
 246
 247 oINodes :: OptType
 248 oINodes = Option "" ["req-nodes"]
 249           (ReqArg (\ n opts -> Ok opts { optINodes = read n }) "NODES")
 250           "number of nodes for the new instances (1=plain, 2=mirrored)"
 251
 252 oIVcpus :: OptType
 253 oIVcpus = Option "" ["vcpus"]
 254           (ReqArg (\ p opts ->
 255                        let ospec = optISpec opts
 256                            nspec = ospec { rspecCpu = read p }
 257                        in Ok opts { optISpec = nspec }) "NUM")
 258           "number of virtual cpus for instances"
 259
 260 oLuxiSocket :: OptType
 261 oLuxiSocket = Option "L" ["luxi"]
 262               (OptArg ((\ f opts -> Ok opts { optLuxi = Just f }) .
 263                        fromMaybe defaultLuxiSocket) "SOCKET")
 264               "collect data via Luxi, optionally using the given SOCKET path"
 265
 266 oMaxCpu :: OptType
 267 oMaxCpu = Option "" ["max-cpu"]
 268           (ReqArg (\ n opts -> Ok opts { optMcpu = read n }) "RATIO")
 269           "maximum virtual-to-physical cpu ratio for nodes (from 1\
 270           \ upwards) [64]"
 271
 272 oMaxSolLength :: OptType
 273 oMaxSolLength = Option "l" ["max-length"]
 274                 (ReqArg (\ i opts -> Ok opts { optMaxLength = read i }) "N")
 275                 "cap the solution at this many moves (useful for very\
 276                 \ unbalanced clusters)"
 277
 278 oMinDisk :: OptType
 279 oMinDisk = Option "" ["min-disk"]
 280            (ReqArg (\ n opts -> Ok opts { optMdsk = read n }) "RATIO")
 281            "minimum free disk space for nodes (between 0 and 1) [0]"
 282
 283 oMinGain :: OptType
 284 oMinGain = Option "g" ["min-gain"]
 285             (ReqArg (\ g opts -> Ok opts { optMinGain = read g }) "DELTA")
 286             "minimum gain to aim for in a balancing step before giving up"
 287
 288 oMinGainLim :: OptType
 289 oMinGainLim = Option "" ["min-gain-limit"]
 290             (ReqArg (\ g opts -> Ok opts { optMinGainLim = read g }) "SCORE")
 291             "minimum cluster score for which we start checking the min-gain"
 292
 293 oMinScore :: OptType
 294 oMinScore = Option "e" ["min-score"]
 295             (ReqArg (\ e opts -> Ok opts { optMinScore = read e }) "EPSILON")
 296             "mininum score to aim for"
 297
 298 oNoHeaders :: OptType
 299 oNoHeaders = Option "" ["no-headers"]
 300              (NoArg (\ opts -> Ok opts { optNoHeaders = True }))
 301              "do not show a header line"
 302
 303 oNodeSim :: OptType
 304 oNodeSim = Option "" ["simulate"]
 305             (ReqArg (\ f o -> Ok o { optNodeSim = f:optNodeSim o }) "SPEC")
 306             "simulate an empty cluster, given as 'num_nodes,disk,ram,cpu'"
 307
 308 oOfflineNode :: OptType
 309 oOfflineNode = Option "O" ["offline"]
 310                (ReqArg (\ n o -> Ok o { optOffline = n:optOffline o }) "NODE")
 311                "set node as offline"
 312
 313 oOneline :: OptType
 314 oOneline = Option "o" ["oneline"]
 315            (NoArg (\ opts -> Ok opts { optOneline = True }))
 316            "print the ganeti command list for reaching the solution"
 317
 318 oOutputDir :: OptType
 319 oOutputDir = Option "d" ["output-dir"]
 320              (ReqArg (\ d opts -> Ok opts { optOutPath = d }) "PATH")
 321              "directory in which to write output files"
 322
 323 oPrintCommands :: OptType
 324 oPrintCommands = Option "C" ["print-commands"]
 325                  (OptArg ((\ f opts -> Ok opts { optShowCmds = Just f }) .
 326                           fromMaybe "-")
 327                   "FILE")
 328                  "print the ganeti command list for reaching the solution,\
 329                  \ if an argument is passed then write the commands to a\
 330                  \ file named as such"
 331
 332 oPrintInsts :: OptType
 333 oPrintInsts = Option "" ["print-instances"]
 334               (NoArg (\ opts -> Ok opts { optShowInsts = True }))
 335               "print the final instance map"
 336
 337 oPrintNodes :: OptType
 338 oPrintNodes = Option "p" ["print-nodes"]
 339               (OptArg ((\ f opts ->
 340                             let (prefix, realf) = case f of
 341                                   '+':rest -> (["+"], rest)
 342                                   _ -> ([], f)
 343                                 splitted = prefix ++ sepSplit ',' realf
 344                             in Ok opts { optShowNodes = Just splitted }) .
 345                        fromMaybe []) "FIELDS")
 346               "print the final node list"
 347
 348 oQuiet :: OptType
 349 oQuiet = Option "q" ["quiet"]
 350          (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts - 1 }))
 351          "decrease the verbosity level"
 352
 353 oRapiMaster :: OptType
 354 oRapiMaster = Option "m" ["master"]
 355               (ReqArg (\ m opts -> Ok opts { optMaster = m }) "ADDRESS")
 356               "collect data via RAPI at the given ADDRESS"
 357
 358 oSaveCluster :: OptType
 359 oSaveCluster = Option "S" ["save"]
 360             (ReqArg (\ f opts -> Ok opts { optSaveCluster = Just f }) "FILE")
 361             "Save cluster state at the end of the processing to FILE"
 362
 363 oShowHelp :: OptType
 364 oShowHelp = Option "h" ["help"]
 365             (NoArg (\ opts -> Ok opts { optShowHelp = True}))
 366             "show help"
 367
 368 oShowVer :: OptType
 369 oShowVer = Option "V" ["version"]
 370            (NoArg (\ opts -> Ok opts { optShowVer = True}))
 371            "show the version of the program"
 372
 373 oTieredSpec :: OptType
 374 oTieredSpec = Option "" ["tiered-alloc"]
 375              (ReqArg (\ inp opts -> do
 376                           let sp = sepSplit ',' inp
 377                           prs <- mapM (tryRead "tiered specs") sp
 378                           tspec <-
 379                               case prs of
 380                                 [dsk, ram, cpu] -> return $ RSpec cpu ram dsk
 381                                 _ -> Bad $ "Invalid specification: " ++ inp ++
 382                                      ", expected disk,ram,cpu"
 383                           return $ opts { optTieredSpec = Just tspec } )
 384               "TSPEC")
 385              "enable tiered specs allocation, given as 'disk,ram,cpu'"
 386
 387 oReplay :: OptType
 388 oReplay = Option "" ["replay"]
 389           (ReqArg (\ stat opts -> Ok opts { optReplay = Just stat } ) "STATE")
 390           "Pre-seed the random number generator with STATE"
 391
 392 oVerbose :: OptType
 393 oVerbose = Option "v" ["verbose"]
 394            (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts + 1 }))
 395            "increase the verbosity level"
 396
 397 -- | Usage info
 398 usageHelp :: String -> [OptType] -> String
 399 usageHelp progname =
 400     usageInfo (printf "%s %s\nUsage: %s [OPTION...]"
 401                progname Version.version progname)
 402
 403 -- | Command line parser, using the 'options' structure.
 404 parseOpts :: [String]               -- ^ The command line arguments
 405           -> String                 -- ^ The program name
 406           -> [OptType]              -- ^ The supported command line options
 407           -> IO (Options, [String]) -- ^ The resulting options and leftover
 408                                     -- arguments
 409 parseOpts argv progname options =
 410     case getOpt Permute options argv of
 411       (o, n, []) ->
 412           do
 413             let (pr, args) = (foldM (flip id) defaultOptions o, n)
 414             po <- (case pr of
 415                      Bad msg -> do
 416                        hPutStrLn stderr "Error while parsing command\
 417                                         \line arguments:"
 418                        hPutStrLn stderr msg
 419                        exitWith $ ExitFailure 1
 420                      Ok val -> return val)
 421             when (optShowHelp po) $ do
 422               putStr $ usageHelp progname options
 423               exitWith ExitSuccess
 424             when (optShowVer po) $ do
 425               printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
 426                      progname Version.version
 427                      compilerName (Data.Version.showVersion compilerVersion)
 428                      os arch :: IO ()
 429               exitWith ExitSuccess
 430             return (po, args)
 431       (_, _, errs) -> do
 432         hPutStrLn stderr $ "Command line error: "  ++ concat errs
 433         hPutStrLn stderr $ usageHelp progname options
 434         exitWith $ ExitFailure 2
 435
 436 -- | A shell script template for autogenerated scripts.
 437 shTemplate :: String
 438 shTemplate =
 439     printf "#!/bin/sh\n\n\
 440            \# Auto-generated script for executing cluster rebalancing\n\n\
 441            \# To stop, touch the file /tmp/stop-htools\n\n\
 442            \set -e\n\n\
 443            \check() {\n\
 444            \  if [ -f /tmp/stop-htools ]; then\n\
 445            \    echo 'Stop requested, exiting'\n\
 446            \    exit 0\n\
 447            \  fi\n\
 448            \}\n\n"
 449
 450 -- | Optionally print the node list.
 451 maybePrintNodes :: Maybe [String]       -- ^ The field list
 452                 -> String               -- ^ Informational message
 453                 -> ([String] -> String) -- ^ Function to generate the listing
 454                 -> IO ()
 455 maybePrintNodes Nothing _ _ = return ()
 456 maybePrintNodes (Just fields) msg fn = do
 457   hPutStrLn stderr ""
 458   hPutStrLn stderr (msg ++ " status:")
 459   hPutStrLn stderr $ fn fields
 460
 461
 462 -- | Optionally print the instance list.
 463 maybePrintInsts :: Bool   -- ^ Whether to print the instance list
 464                 -> String -- ^ Type of the instance map (e.g. initial)
 465                 -> String -- ^ The instance data
 466                 -> IO ()
 467 maybePrintInsts do_print msg instdata =
 468   when do_print $ do
 469     hPutStrLn stderr ""
 470     hPutStrLn stderr $ msg ++ " instance map:"
 471     hPutStr stderr instdata