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 -> do
 249                     dsk <- annotateResult ("--disk option") (parseUnit d)
 250                     let ospec = optISpec opts
 251                         nspec = ospec { rspecDsk = dsk }
 252                     return $ opts { optISpec = nspec }) "DISK")
 253          "disk size for instances"
 254
 255 oIMem :: OptType
 256 oIMem = Option "" ["memory"]
 257         (ReqArg (\ m opts -> do
 258                    mem <- annotateResult ("--memory option") (parseUnit m)
 259                    let ospec = optISpec opts
 260                        nspec = ospec { rspecMem = mem }
 261                    return $ opts { optISpec = nspec }) "MEMORY")
 262         "memory size for instances"
 263
 264 oIVcpus :: OptType
 265 oIVcpus = Option "" ["vcpus"]
 266           (ReqArg (\ p opts -> do
 267                      vcpus <- tryRead "--vcpus option" p
 268                      let ospec = optISpec opts
 269                          nspec = ospec { rspecCpu = vcpus }
 270                      return $ opts { optISpec = nspec }) "NUM")
 271           "number of virtual cpus for instances"
 272
 273 oLuxiSocket :: OptType
 274 oLuxiSocket = Option "L" ["luxi"]
 275               (OptArg ((\ f opts -> Ok opts { optLuxi = Just f }) .
 276                        fromMaybe defaultLuxiSocket) "SOCKET")
 277               "collect data via Luxi, optionally using the given SOCKET path"
 278
 279 oMaxCpu :: OptType
 280 oMaxCpu = Option "" ["max-cpu"]
 281           (ReqArg (\ n opts -> Ok opts { optMcpu = read n }) "RATIO")
 282           "maximum virtual-to-physical cpu ratio for nodes (from 1\
 283           \ upwards) [64]"
 284
 285 oMaxSolLength :: OptType
 286 oMaxSolLength = Option "l" ["max-length"]
 287                 (ReqArg (\ i opts -> Ok opts { optMaxLength = read i }) "N")
 288                 "cap the solution at this many moves (useful for very\
 289                 \ unbalanced clusters)"
 290
 291 oMinDisk :: OptType
 292 oMinDisk = Option "" ["min-disk"]
 293            (ReqArg (\ n opts -> Ok opts { optMdsk = read n }) "RATIO")
 294            "minimum free disk space for nodes (between 0 and 1) [0]"
 295
 296 oMinGain :: OptType
 297 oMinGain = Option "g" ["min-gain"]
 298             (ReqArg (\ g opts -> Ok opts { optMinGain = read g }) "DELTA")
 299             "minimum gain to aim for in a balancing step before giving up"
 300
 301 oMinGainLim :: OptType
 302 oMinGainLim = Option "" ["min-gain-limit"]
 303             (ReqArg (\ g opts -> Ok opts { optMinGainLim = read g }) "SCORE")
 304             "minimum cluster score for which we start checking the min-gain"
 305
 306 oMinScore :: OptType
 307 oMinScore = Option "e" ["min-score"]
 308             (ReqArg (\ e opts -> Ok opts { optMinScore = read e }) "EPSILON")
 309             "mininum score to aim for"
 310
 311 oNoHeaders :: OptType
 312 oNoHeaders = Option "" ["no-headers"]
 313              (NoArg (\ opts -> Ok opts { optNoHeaders = True }))
 314              "do not show a header line"
 315
 316 oNodeSim :: OptType
 317 oNodeSim = Option "" ["simulate"]
 318             (ReqArg (\ f o -> Ok o { optNodeSim = f:optNodeSim o }) "SPEC")
 319             "simulate an empty cluster, given as 'num_nodes,disk,ram,cpu'"
 320
 321 oOfflineNode :: OptType
 322 oOfflineNode = Option "O" ["offline"]
 323                (ReqArg (\ n o -> Ok o { optOffline = n:optOffline o }) "NODE")
 324                "set node as offline"
 325
 326 oOneline :: OptType
 327 oOneline = Option "o" ["oneline"]
 328            (NoArg (\ opts -> Ok opts { optOneline = True }))
 329            "print the ganeti command list for reaching the solution"
 330
 331 oOutputDir :: OptType
 332 oOutputDir = Option "d" ["output-dir"]
 333              (ReqArg (\ d opts -> Ok opts { optOutPath = d }) "PATH")
 334              "directory in which to write output files"
 335
 336 oPrintCommands :: OptType
 337 oPrintCommands = Option "C" ["print-commands"]
 338                  (OptArg ((\ f opts -> Ok opts { optShowCmds = Just f }) .
 339                           fromMaybe "-")
 340                   "FILE")
 341                  "print the ganeti command list for reaching the solution,\
 342                  \ if an argument is passed then write the commands to a\
 343                  \ file named as such"
 344
 345 oPrintInsts :: OptType
 346 oPrintInsts = Option "" ["print-instances"]
 347               (NoArg (\ opts -> Ok opts { optShowInsts = True }))
 348               "print the final instance map"
 349
 350 oPrintNodes :: OptType
 351 oPrintNodes = Option "p" ["print-nodes"]
 352               (OptArg ((\ f opts ->
 353                             let (prefix, realf) = case f of
 354                                   '+':rest -> (["+"], rest)
 355                                   _ -> ([], f)
 356                                 splitted = prefix ++ sepSplit ',' realf
 357                             in Ok opts { optShowNodes = Just splitted }) .
 358                        fromMaybe []) "FIELDS")
 359               "print the final node list"
 360
 361 oQuiet :: OptType
 362 oQuiet = Option "q" ["quiet"]
 363          (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts - 1 }))
 364          "decrease the verbosity level"
 365
 366 oRapiMaster :: OptType
 367 oRapiMaster = Option "m" ["master"]
 368               (ReqArg (\ m opts -> Ok opts { optMaster = m }) "ADDRESS")
 369               "collect data via RAPI at the given ADDRESS"
 370
 371 oSaveCluster :: OptType
 372 oSaveCluster = Option "S" ["save"]
 373             (ReqArg (\ f opts -> Ok opts { optSaveCluster = Just f }) "FILE")
 374             "Save cluster state at the end of the processing to FILE"
 375
 376 oShowHelp :: OptType
 377 oShowHelp = Option "h" ["help"]
 378             (NoArg (\ opts -> Ok opts { optShowHelp = True}))
 379             "show help"
 380
 381 oShowVer :: OptType
 382 oShowVer = Option "V" ["version"]
 383            (NoArg (\ opts -> Ok opts { optShowVer = True}))
 384            "show the version of the program"
 385
 386 oTieredSpec :: OptType
 387 oTieredSpec = Option "" ["tiered-alloc"]
 388              (ReqArg (\ inp opts -> do
 389                           let sp = sepSplit ',' inp
 390                           prs <- mapM (\(fn, val) -> fn val) $
 391                                  zip [ annotateResult "tiered specs memory" .
 392                                        parseUnit
 393                                      , annotateResult "tiered specs disk" .
 394                                        parseUnit
 395                                      , tryRead "tiered specs cpus"
 396                                      ] sp
 397                           tspec <-
 398                               case prs of
 399                                 [dsk, ram, cpu] -> return $ RSpec cpu ram dsk
 400                                 _ -> Bad $ "Invalid specification: " ++ inp ++
 401                                      ", expected disk,ram,cpu"
 402                           return $ opts { optTieredSpec = Just tspec } )
 403               "TSPEC")
 404              "enable tiered specs allocation, given as 'disk,ram,cpu'"
 405
 406 oReplay :: OptType
 407 oReplay = Option "" ["replay"]
 408           (ReqArg (\ stat opts -> Ok opts { optReplay = Just stat } ) "STATE")
 409           "Pre-seed the random number generator with STATE"
 410
 411 oVerbose :: OptType
 412 oVerbose = Option "v" ["verbose"]
 413            (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts + 1 }))
 414            "increase the verbosity level"
 415
 416 -- * Functions
 417
 418 -- | Usage info.
 419 usageHelp :: String -> [OptType] -> String
 420 usageHelp progname =
 421     usageInfo (printf "%s %s\nUsage: %s [OPTION...]"
 422                progname Version.version progname)
 423
 424 -- | Command line parser, using the 'Options' structure.
 425 parseOpts :: [String]               -- ^ The command line arguments
 426           -> String                 -- ^ The program name
 427           -> [OptType]              -- ^ The supported command line options
 428           -> IO (Options, [String]) -- ^ The resulting options and leftover
 429                                     -- arguments
 430 parseOpts argv progname options =
 431     case getOpt Permute options argv of
 432       (o, n, []) ->
 433           do
 434             let (pr, args) = (foldM (flip id) defaultOptions o, n)
 435             po <- (case pr of
 436                      Bad msg -> do
 437                        hPutStrLn stderr "Error while parsing command\
 438                                         \line arguments:"
 439                        hPutStrLn stderr msg
 440                        exitWith $ ExitFailure 1
 441                      Ok val -> return val)
 442             when (optShowHelp po) $ do
 443               putStr $ usageHelp progname options
 444               exitWith ExitSuccess
 445             when (optShowVer po) $ do
 446               printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
 447                      progname Version.version
 448                      compilerName (Data.Version.showVersion compilerVersion)
 449                      os arch :: IO ()
 450               exitWith ExitSuccess
 451             return (po, args)
 452       (_, _, errs) -> do
 453         hPutStrLn stderr $ "Command line error: "  ++ concat errs
 454         hPutStrLn stderr $ usageHelp progname options
 455         exitWith $ ExitFailure 2
 456
 457 -- | A shell script template for autogenerated scripts.
 458 shTemplate :: String
 459 shTemplate =
 460     printf "#!/bin/sh\n\n\
 461            \# Auto-generated script for executing cluster rebalancing\n\n\
 462            \# To stop, touch the file /tmp/stop-htools\n\n\
 463            \set -e\n\n\
 464            \check() {\n\
 465            \  if [ -f /tmp/stop-htools ]; then\n\
 466            \    echo 'Stop requested, exiting'\n\
 467            \    exit 0\n\
 468            \  fi\n\
 469            \}\n\n"
 470
 471 -- | Optionally print the node list.
 472 maybePrintNodes :: Maybe [String]       -- ^ The field list
 473                 -> String               -- ^ Informational message
 474                 -> ([String] -> String) -- ^ Function to generate the listing
 475                 -> IO ()
 476 maybePrintNodes Nothing _ _ = return ()
 477 maybePrintNodes (Just fields) msg fn = do
 478   hPutStrLn stderr ""
 479   hPutStrLn stderr (msg ++ " status:")
 480   hPutStrLn stderr $ fn fields
 481
 482
 483 -- | Optionally print the instance list.
 484 maybePrintInsts :: Bool   -- ^ Whether to print the instance list
 485                 -> String -- ^ Type of the instance map (e.g. initial)
 486                 -> String -- ^ The instance data
 487                 -> IO ()
 488 maybePrintInsts do_print msg instdata =
 489   when do_print $ do
 490     hPutStrLn stderr ""
 491     hPutStrLn stderr $ msg ++ " instance map:"
 492     hPutStr stderr instdata