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     , oDiskTemplate
  42     , oDynuFile
  43     , oEvacMode
  44     , oExInst
  45     , oExTags
  46     , oExecJobs
  47     , oGroup
  48     , oIDisk
  49     , oIMem
  50     , oIVcpus
  51     , oInstMoves
  52     , oLuxiSocket
  53     , oMaxCpu
  54     , oMaxSolLength
  55     , oMinDisk
  56     , oMinGain
  57     , oMinGainLim
  58     , oMinScore
  59     , oNoHeaders
  60     , oNodeSim
  61     , oOfflineNode
  62     , oOneline
  63     , oOutputDir
  64     , oPrintCommands
  65     , oPrintInsts
  66     , oPrintNodes
  67     , oQuiet
  68     , oRapiMaster
  69     , oReplay
  70     , oSaveCluster
  71     , oSelInst
  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     , optDiskTemplate :: DiskTemplate  -- ^ The requested disk template
 108     , optDynuFile    :: Maybe FilePath -- ^ Optional file with dynamic use data
 109     , optEvacMode    :: Bool           -- ^ Enable evacuation mode
 110     , optExInst      :: [String]       -- ^ Instances to be excluded
 111     , optExTags      :: Maybe [String] -- ^ Tags to use for exclusion
 112     , optExecJobs    :: Bool           -- ^ Execute the commands via Luxi
 113     , optGroup       :: Maybe GroupID  -- ^ The UUID of the group to process
 114     , optSelInst     :: [String]       -- ^ Instances to be excluded
 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  , optDiskTemplate = DTDrbd8
 147  , optDynuFile    = Nothing
 148  , optEvacMode    = False
 149  , optExInst      = []
 150  , optExTags      = Nothing
 151  , optExecJobs    = False
 152  , optGroup       = Nothing
 153  , optSelInst     = []
 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 oDiskTemplate :: OptType
 196 oDiskTemplate = Option "" ["disk-template"]
 197                 (ReqArg (\ t opts -> do
 198                            dt <- dtFromString t
 199                            return $ opts { optDiskTemplate = dt }) "TEMPLATE")
 200                 "select the desired disk template"
 201
 202 oSelInst :: OptType
 203 oSelInst = Option "" ["select-instances"]
 204           (ReqArg (\ f opts -> Ok opts { optSelInst = sepSplit ',' f }) "INSTS")
 205           "only select given instances for any moves"
 206
 207 oInstMoves :: OptType
 208 oInstMoves = Option "" ["no-instance-moves"]
 209              (NoArg (\ opts -> Ok opts { optInstMoves = False}))
 210              "disallow instance (primary node) moves from the list of allowed,\
 211              \ instance changes, thus allowing only slower, but sometimes\
 212              \ safer, drbd secondary changes"
 213
 214 oDynuFile :: OptType
 215 oDynuFile = Option "U" ["dynu-file"]
 216             (ReqArg (\ f opts -> Ok opts { optDynuFile = Just f }) "FILE")
 217             "Import dynamic utilisation data from the given FILE"
 218
 219 oEvacMode :: OptType
 220 oEvacMode = Option "E" ["evac-mode"]
 221             (NoArg (\opts -> Ok opts { optEvacMode = True }))
 222             "enable evacuation mode, where the algorithm only moves \
 223             \ instances away from offline and drained nodes"
 224
 225 oExInst :: OptType
 226 oExInst = Option "" ["exclude-instances"]
 227           (ReqArg (\ f opts -> Ok opts { optExInst = sepSplit ',' f }) "INSTS")
 228           "exclude given instances from any moves"
 229
 230 oExTags :: OptType
 231 oExTags = Option "" ["exclusion-tags"]
 232             (ReqArg (\ f opts -> Ok opts { optExTags = Just $ sepSplit ',' f })
 233              "TAG,...") "Enable instance exclusion based on given tag prefix"
 234
 235 oExecJobs :: OptType
 236 oExecJobs = Option "X" ["exec"]
 237              (NoArg (\ opts -> Ok opts { optExecJobs = True}))
 238              "execute the suggested moves via Luxi (only available when using\
 239              \ it for data gathering)"
 240
 241 oGroup :: OptType
 242 oGroup = Option "G" ["group"]
 243             (ReqArg (\ f o -> Ok o { optGroup = Just f }) "ID")
 244             "the ID of the group to balance"
 245
 246 oIDisk :: OptType
 247 oIDisk = Option "" ["disk"]
 248          (ReqArg (\ d opts ->
 249                      let ospec = optISpec opts
 250                          nspec = ospec { rspecDsk = read d }
 251                      in Ok opts { optISpec = nspec }) "DISK")
 252          "disk size for instances"
 253
 254 oIMem :: OptType
 255 oIMem = Option "" ["memory"]
 256         (ReqArg (\ m opts ->
 257                      let ospec = optISpec opts
 258                          nspec = ospec { rspecMem = read m }
 259                      in Ok opts { optISpec = nspec }) "MEMORY")
 260         "memory size for instances"
 261
 262 oIVcpus :: OptType
 263 oIVcpus = Option "" ["vcpus"]
 264           (ReqArg (\ p opts ->
 265                        let ospec = optISpec opts
 266                            nspec = ospec { rspecCpu = read p }
 267                        in Ok opts { optISpec = nspec }) "NUM")
 268           "number of virtual cpus for instances"
 269
 270 oLuxiSocket :: OptType
 271 oLuxiSocket = Option "L" ["luxi"]
 272               (OptArg ((\ f opts -> Ok opts { optLuxi = Just f }) .
 273                        fromMaybe defaultLuxiSocket) "SOCKET")
 274               "collect data via Luxi, optionally using the given SOCKET path"
 275
 276 oMaxCpu :: OptType
 277 oMaxCpu = Option "" ["max-cpu"]
 278           (ReqArg (\ n opts -> Ok opts { optMcpu = read n }) "RATIO")
 279           "maximum virtual-to-physical cpu ratio for nodes (from 1\
 280           \ upwards) [64]"
 281
 282 oMaxSolLength :: OptType
 283 oMaxSolLength = Option "l" ["max-length"]
 284                 (ReqArg (\ i opts -> Ok opts { optMaxLength = read i }) "N")
 285                 "cap the solution at this many moves (useful for very\
 286                 \ unbalanced clusters)"
 287
 288 oMinDisk :: OptType
 289 oMinDisk = Option "" ["min-disk"]
 290            (ReqArg (\ n opts -> Ok opts { optMdsk = read n }) "RATIO")
 291            "minimum free disk space for nodes (between 0 and 1) [0]"
 292
 293 oMinGain :: OptType
 294 oMinGain = Option "g" ["min-gain"]
 295             (ReqArg (\ g opts -> Ok opts { optMinGain = read g }) "DELTA")
 296             "minimum gain to aim for in a balancing step before giving up"
 297
 298 oMinGainLim :: OptType
 299 oMinGainLim = Option "" ["min-gain-limit"]
 300             (ReqArg (\ g opts -> Ok opts { optMinGainLim = read g }) "SCORE")
 301             "minimum cluster score for which we start checking the min-gain"
 302
 303 oMinScore :: OptType
 304 oMinScore = Option "e" ["min-score"]
 305             (ReqArg (\ e opts -> Ok opts { optMinScore = read e }) "EPSILON")
 306             "mininum score to aim for"
 307
 308 oNoHeaders :: OptType
 309 oNoHeaders = Option "" ["no-headers"]
 310              (NoArg (\ opts -> Ok opts { optNoHeaders = True }))
 311              "do not show a header line"
 312
 313 oNodeSim :: OptType
 314 oNodeSim = Option "" ["simulate"]
 315             (ReqArg (\ f o -> Ok o { optNodeSim = f:optNodeSim o }) "SPEC")
 316             "simulate an empty cluster, given as 'num_nodes,disk,ram,cpu'"
 317
 318 oOfflineNode :: OptType
 319 oOfflineNode = Option "O" ["offline"]
 320                (ReqArg (\ n o -> Ok o { optOffline = n:optOffline o }) "NODE")
 321                "set node as offline"
 322
 323 oOneline :: OptType
 324 oOneline = Option "o" ["oneline"]
 325            (NoArg (\ opts -> Ok opts { optOneline = True }))
 326            "print the ganeti command list for reaching the solution"
 327
 328 oOutputDir :: OptType
 329 oOutputDir = Option "d" ["output-dir"]
 330              (ReqArg (\ d opts -> Ok opts { optOutPath = d }) "PATH")
 331              "directory in which to write output files"
 332
 333 oPrintCommands :: OptType
 334 oPrintCommands = Option "C" ["print-commands"]
 335                  (OptArg ((\ f opts -> Ok opts { optShowCmds = Just f }) .
 336                           fromMaybe "-")
 337                   "FILE")
 338                  "print the ganeti command list for reaching the solution,\
 339                  \ if an argument is passed then write the commands to a\
 340                  \ file named as such"
 341
 342 oPrintInsts :: OptType
 343 oPrintInsts = Option "" ["print-instances"]
 344               (NoArg (\ opts -> Ok opts { optShowInsts = True }))
 345               "print the final instance map"
 346
 347 oPrintNodes :: OptType
 348 oPrintNodes = Option "p" ["print-nodes"]
 349               (OptArg ((\ f opts ->
 350                             let (prefix, realf) = case f of
 351                                   '+':rest -> (["+"], rest)
 352                                   _ -> ([], f)
 353                                 splitted = prefix ++ sepSplit ',' realf
 354                             in Ok opts { optShowNodes = Just splitted }) .
 355                        fromMaybe []) "FIELDS")
 356               "print the final node list"
 357
 358 oQuiet :: OptType
 359 oQuiet = Option "q" ["quiet"]
 360          (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts - 1 }))
 361          "decrease the verbosity level"
 362
 363 oRapiMaster :: OptType
 364 oRapiMaster = Option "m" ["master"]
 365               (ReqArg (\ m opts -> Ok opts { optMaster = m }) "ADDRESS")
 366               "collect data via RAPI at the given ADDRESS"
 367
 368 oSaveCluster :: OptType
 369 oSaveCluster = Option "S" ["save"]
 370             (ReqArg (\ f opts -> Ok opts { optSaveCluster = Just f }) "FILE")
 371             "Save cluster state at the end of the processing to FILE"
 372
 373 oShowHelp :: OptType
 374 oShowHelp = Option "h" ["help"]
 375             (NoArg (\ opts -> Ok opts { optShowHelp = True}))
 376             "show help"
 377
 378 oShowVer :: OptType
 379 oShowVer = Option "V" ["version"]
 380            (NoArg (\ opts -> Ok opts { optShowVer = True}))
 381            "show the version of the program"
 382
 383 oTieredSpec :: OptType
 384 oTieredSpec = Option "" ["tiered-alloc"]
 385              (ReqArg (\ inp opts -> do
 386                           let sp = sepSplit ',' inp
 387                           prs <- mapM (tryRead "tiered specs") sp
 388                           tspec <-
 389                               case prs of
 390                                 [dsk, ram, cpu] -> return $ RSpec cpu ram dsk
 391                                 _ -> Bad $ "Invalid specification: " ++ inp ++
 392                                      ", expected disk,ram,cpu"
 393                           return $ opts { optTieredSpec = Just tspec } )
 394               "TSPEC")
 395              "enable tiered specs allocation, given as 'disk,ram,cpu'"
 396
 397 oReplay :: OptType
 398 oReplay = Option "" ["replay"]
 399           (ReqArg (\ stat opts -> Ok opts { optReplay = Just stat } ) "STATE")
 400           "Pre-seed the random number generator with STATE"
 401
 402 oVerbose :: OptType
 403 oVerbose = Option "v" ["verbose"]
 404            (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts + 1 }))
 405            "increase the verbosity level"
 406
 407 -- * Functions
 408
 409 -- | Usage info.
 410 usageHelp :: String -> [OptType] -> String
 411 usageHelp progname =
 412     usageInfo (printf "%s %s\nUsage: %s [OPTION...]"
 413                progname Version.version progname)
 414
 415 -- | Command line parser, using the 'Options' structure.
 416 parseOpts :: [String]               -- ^ The command line arguments
 417           -> String                 -- ^ The program name
 418           -> [OptType]              -- ^ The supported command line options
 419           -> IO (Options, [String]) -- ^ The resulting options and leftover
 420                                     -- arguments
 421 parseOpts argv progname options =
 422     case getOpt Permute options argv of
 423       (o, n, []) ->
 424           do
 425             let (pr, args) = (foldM (flip id) defaultOptions o, n)
 426             po <- (case pr of
 427                      Bad msg -> do
 428                        hPutStrLn stderr "Error while parsing command\
 429                                         \line arguments:"
 430                        hPutStrLn stderr msg
 431                        exitWith $ ExitFailure 1
 432                      Ok val -> return val)
 433             when (optShowHelp po) $ do
 434               putStr $ usageHelp progname options
 435               exitWith ExitSuccess
 436             when (optShowVer po) $ do
 437               printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
 438                      progname Version.version
 439                      compilerName (Data.Version.showVersion compilerVersion)
 440                      os arch :: IO ()
 441               exitWith ExitSuccess
 442             return (po, args)
 443       (_, _, errs) -> do
 444         hPutStrLn stderr $ "Command line error: "  ++ concat errs
 445         hPutStrLn stderr $ usageHelp progname options
 446         exitWith $ ExitFailure 2
 447
 448 -- | A shell script template for autogenerated scripts.
 449 shTemplate :: String
 450 shTemplate =
 451     printf "#!/bin/sh\n\n\
 452            \# Auto-generated script for executing cluster rebalancing\n\n\
 453            \# To stop, touch the file /tmp/stop-htools\n\n\
 454            \set -e\n\n\
 455            \check() {\n\
 456            \  if [ -f /tmp/stop-htools ]; then\n\
 457            \    echo 'Stop requested, exiting'\n\
 458            \    exit 0\n\
 459            \  fi\n\
 460            \}\n\n"
 461
 462 -- | Optionally print the node list.
 463 maybePrintNodes :: Maybe [String]       -- ^ The field list
 464                 -> String               -- ^ Informational message
 465                 -> ([String] -> String) -- ^ Function to generate the listing
 466                 -> IO ()
 467 maybePrintNodes Nothing _ _ = return ()
 468 maybePrintNodes (Just fields) msg fn = do
 469   hPutStrLn stderr ""
 470   hPutStrLn stderr (msg ++ " status:")
 471   hPutStrLn stderr $ fn fields
 472
 473
 474 -- | Optionally print the instance list.
 475 maybePrintInsts :: Bool   -- ^ Whether to print the instance list
 476                 -> String -- ^ Type of the instance map (e.g. initial)
 477                 -> String -- ^ The instance data
 478                 -> IO ()
 479 maybePrintInsts do_print msg instdata =
 480   when do_print $ do
 481     hPutStrLn stderr ""
 482     hPutStrLn stderr $ msg ++ " instance map:"
 483     hPutStr stderr instdata