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