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