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, 2012 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   , defaultOptions
  34   , Ganeti.HTools.CLI.parseOpts
  35   , parseOptsInner
  36   , parseYesNo
  37   , parseISpecString
  38   , shTemplate
  39   , defaultLuxiSocket
  40   , maybePrintNodes
  41   , maybePrintInsts
  42   , maybeShowWarnings
  43   , printKeys
  44   , printFinal
  45   , setNodeStatus
  46   -- * The options
  47   , oDataFile
  48   , oDiskMoves
  49   , oDiskTemplate
  50   , oSpindleUse
  51   , oDynuFile
  52   , oEvacMode
  53   , oExInst
  54   , oExTags
  55   , oExecJobs
  56   , oGroup
  57   , oIAllocSrc
  58   , oInstMoves
  59   , oLuxiSocket
  60   , oMachineReadable
  61   , oMaxCpu
  62   , oMaxSolLength
  63   , oMinDisk
  64   , oMinGain
  65   , oMinGainLim
  66   , oMinScore
  67   , oNoHeaders
  68   , oNoSimulation
  69   , oNodeSim
  70   , oOfflineNode
  71   , oOutputDir
  72   , oPrintCommands
  73   , oPrintInsts
  74   , oPrintNodes
  75   , oQuiet
  76   , oRapiMaster
  77   , oSaveCluster
  78   , oSelInst
  79   , oShowHelp
  80   , oShowVer
  81   , oStdSpec
  82   , oTieredSpec
  83   , oVerbose
  84   ) where
  85
  86 import Control.Monad
  87 import Data.Char (toUpper)
  88 import Data.Maybe (fromMaybe)
  89 import System.Console.GetOpt
  90 import System.IO
  91 import Text.Printf (printf)
  92
  93 import qualified Ganeti.HTools.Container as Container
  94 import qualified Ganeti.HTools.Node as Node
  95 import qualified Ganeti.Constants as C
  96 import Ganeti.HTools.Types
  97 import Ganeti.HTools.Utils
  98 import Ganeti.BasicTypes
  99 import Ganeti.Common as Common
 100
 101 -- * Constants
 102
 103 -- | The default value for the luxi socket.
 104 --
 105 -- This is re-exported from the "Ganeti.Constants" module.
 106 defaultLuxiSocket :: FilePath
 107 defaultLuxiSocket = C.masterSocket
 108
 109 -- * Data types
 110
 111 -- | Command line options structure.
 112 data Options = Options
 113   { optDataFile    :: Maybe FilePath -- ^ Path to the cluster data file
 114   , optDiskMoves   :: Bool           -- ^ Allow disk moves
 115   , optInstMoves   :: Bool           -- ^ Allow instance moves
 116   , optDiskTemplate :: Maybe DiskTemplate  -- ^ Override for the disk template
 117   , optSpindleUse  :: Maybe Int      -- ^ Override for the spindle usage
 118   , optDynuFile    :: Maybe FilePath -- ^ Optional file with dynamic use data
 119   , optEvacMode    :: Bool           -- ^ Enable evacuation mode
 120   , optExInst      :: [String]       -- ^ Instances to be excluded
 121   , optExTags      :: Maybe [String] -- ^ Tags to use for exclusion
 122   , optExecJobs    :: Bool           -- ^ Execute the commands via Luxi
 123   , optGroup       :: Maybe GroupID  -- ^ The UUID of the group to process
 124   , optIAllocSrc   :: Maybe FilePath -- ^ The iallocation spec
 125   , optSelInst     :: [String]       -- ^ Instances to be excluded
 126   , optLuxi        :: Maybe FilePath -- ^ Collect data from Luxi
 127   , optMachineReadable :: Bool       -- ^ Output machine-readable format
 128   , optMaster      :: String         -- ^ Collect data from RAPI
 129   , optMaxLength   :: Int            -- ^ Stop after this many steps
 130   , optMcpu        :: Maybe Double   -- ^ Override max cpu ratio for nodes
 131   , optMdsk        :: Double         -- ^ Max disk usage ratio for nodes
 132   , optMinGain     :: Score          -- ^ Min gain we aim for in a step
 133   , optMinGainLim  :: Score          -- ^ Limit below which we apply mingain
 134   , optMinScore    :: Score          -- ^ The minimum score we aim for
 135   , optNoHeaders   :: Bool           -- ^ Do not show a header line
 136   , optNoSimulation :: Bool          -- ^ Skip the rebalancing dry-run
 137   , optNodeSim     :: [String]       -- ^ Cluster simulation mode
 138   , optOffline     :: [String]       -- ^ Names of offline nodes
 139   , optOutPath     :: FilePath       -- ^ Path to the output directory
 140   , optSaveCluster :: Maybe FilePath -- ^ Save cluster state to this file
 141   , optShowCmds    :: Maybe FilePath -- ^ Whether to show the command list
 142   , optShowHelp    :: Bool           -- ^ Just show the help
 143   , optShowInsts   :: Bool           -- ^ Whether to show the instance map
 144   , optShowNodes   :: Maybe [String] -- ^ Whether to show node status
 145   , optShowVer     :: Bool           -- ^ Just show the program version
 146   , optStdSpec     :: Maybe RSpec    -- ^ Requested standard specs
 147   , optTestCount   :: Maybe Int      -- ^ Optional test count override
 148   , optTieredSpec  :: Maybe RSpec    -- ^ Requested specs for tiered mode
 149   , optReplay      :: Maybe String   -- ^ Unittests: RNG state
 150   , optVerbose     :: Int            -- ^ Verbosity level
 151   } deriving Show
 152
 153 -- | Default values for the command line options.
 154 defaultOptions :: Options
 155 defaultOptions  = Options
 156   { optDataFile    = Nothing
 157   , optDiskMoves   = True
 158   , optInstMoves   = True
 159   , optDiskTemplate = Nothing
 160   , optSpindleUse  = Nothing
 161   , optDynuFile    = Nothing
 162   , optEvacMode    = False
 163   , optExInst      = []
 164   , optExTags      = Nothing
 165   , optExecJobs    = False
 166   , optGroup       = Nothing
 167   , optIAllocSrc   = Nothing
 168   , optSelInst     = []
 169   , optLuxi        = Nothing
 170   , optMachineReadable = False
 171   , optMaster      = ""
 172   , optMaxLength   = -1
 173   , optMcpu        = Nothing
 174   , optMdsk        = defReservedDiskRatio
 175   , optMinGain     = 1e-2
 176   , optMinGainLim  = 1e-1
 177   , optMinScore    = 1e-9
 178   , optNoHeaders   = False
 179   , optNoSimulation = False
 180   , optNodeSim     = []
 181   , optOffline     = []
 182   , optOutPath     = "."
 183   , optSaveCluster = Nothing
 184   , optShowCmds    = Nothing
 185   , optShowHelp    = False
 186   , optShowInsts   = False
 187   , optShowNodes   = Nothing
 188   , optShowVer     = False
 189   , optStdSpec     = Nothing
 190   , optTestCount   = Nothing
 191   , optTieredSpec  = Nothing
 192   , optReplay      = Nothing
 193   , optVerbose     = 1
 194   }
 195
 196 -- | Abrreviation for the option type.
 197 type OptType = GenericOptType Options
 198
 199 instance StandardOptions Options where
 200   helpRequested = optShowHelp
 201   verRequested  = optShowVer
 202   requestHelp   = \opts -> opts { optShowHelp = True }
 203   requestVer    = \opts -> opts { optShowVer  = True }
 204
 205 -- * Helper functions
 206
 207 parseISpecString :: String -> String -> Result RSpec
 208 parseISpecString descr inp = do
 209   let sp = sepSplit ',' inp
 210       err = Bad ("Invalid " ++ descr ++ " specification: '" ++ inp ++
 211                  "', expected disk,ram,cpu")
 212   when (length sp /= 3) err
 213   prs <- mapM (\(fn, val) -> fn val) $
 214          zip [ annotateResult (descr ++ " specs disk") . parseUnit
 215              , annotateResult (descr ++ " specs memory") . parseUnit
 216              , tryRead (descr ++ " specs cpus")
 217              ] sp
 218   case prs of
 219     [dsk, ram, cpu] -> return $ RSpec cpu ram dsk
 220     _ -> err
 221
 222 -- * Command line options
 223
 224 oDataFile :: OptType
 225 oDataFile = Option "t" ["text-data"]
 226             (ReqArg (\ f o -> Ok o { optDataFile = Just f }) "FILE")
 227             "the cluster data FILE"
 228
 229 oDiskMoves :: OptType
 230 oDiskMoves = Option "" ["no-disk-moves"]
 231              (NoArg (\ opts -> Ok opts { optDiskMoves = False}))
 232              "disallow disk moves from the list of allowed instance changes,\
 233              \ thus allowing only the 'cheap' failover/migrate operations"
 234
 235 oDiskTemplate :: OptType
 236 oDiskTemplate = Option "" ["disk-template"]
 237                 (reqWithConversion diskTemplateFromRaw
 238                  (\dt opts -> Ok opts { optDiskTemplate = Just dt })
 239                  "TEMPLATE") "select the desired disk template"
 240
 241 oSpindleUse :: OptType
 242 oSpindleUse = Option "" ["spindle-use"]
 243               (reqWithConversion (tryRead "parsing spindle-use")
 244                (\su opts -> do
 245                   when (su < 0) $
 246                        fail "Invalid value of the spindle-use\
 247                             \ (expected >= 0)"
 248                   return $ opts { optSpindleUse = Just su })
 249                "SPINDLES") "select how many virtual spindle instances use\
 250                            \ [default read from cluster]"
 251
 252 oSelInst :: OptType
 253 oSelInst = Option "" ["select-instances"]
 254           (ReqArg (\ f opts -> Ok opts { optSelInst = sepSplit ',' f }) "INSTS")
 255           "only select given instances for any moves"
 256
 257 oInstMoves :: OptType
 258 oInstMoves = Option "" ["no-instance-moves"]
 259              (NoArg (\ opts -> Ok opts { optInstMoves = False}))
 260              "disallow instance (primary node) moves from the list of allowed,\
 261              \ instance changes, thus allowing only slower, but sometimes\
 262              \ safer, drbd secondary changes"
 263
 264 oDynuFile :: OptType
 265 oDynuFile = Option "U" ["dynu-file"]
 266             (ReqArg (\ f opts -> Ok opts { optDynuFile = Just f }) "FILE")
 267             "Import dynamic utilisation data from the given FILE"
 268
 269 oEvacMode :: OptType
 270 oEvacMode = Option "E" ["evac-mode"]
 271             (NoArg (\opts -> Ok opts { optEvacMode = True }))
 272             "enable evacuation mode, where the algorithm only moves \
 273             \ instances away from offline and drained nodes"
 274
 275 oExInst :: OptType
 276 oExInst = Option "" ["exclude-instances"]
 277           (ReqArg (\ f opts -> Ok opts { optExInst = sepSplit ',' f }) "INSTS")
 278           "exclude given instances from any moves"
 279
 280 oExTags :: OptType
 281 oExTags = Option "" ["exclusion-tags"]
 282             (ReqArg (\ f opts -> Ok opts { optExTags = Just $ sepSplit ',' f })
 283              "TAG,...") "Enable instance exclusion based on given tag prefix"
 284
 285 oExecJobs :: OptType
 286 oExecJobs = Option "X" ["exec"]
 287              (NoArg (\ opts -> Ok opts { optExecJobs = True}))
 288              "execute the suggested moves via Luxi (only available when using\
 289              \ it for data gathering)"
 290
 291 oGroup :: OptType
 292 oGroup = Option "G" ["group"]
 293             (ReqArg (\ f o -> Ok o { optGroup = Just f }) "ID")
 294             "the ID of the group to balance"
 295
 296 oIAllocSrc :: OptType
 297 oIAllocSrc = Option "I" ["ialloc-src"]
 298              (ReqArg (\ f opts -> Ok opts { optIAllocSrc = Just f }) "FILE")
 299              "Specify an iallocator spec as the cluster data source"
 300
 301 oLuxiSocket :: OptType
 302 oLuxiSocket = Option "L" ["luxi"]
 303               (OptArg ((\ f opts -> Ok opts { optLuxi = Just f }) .
 304                        fromMaybe defaultLuxiSocket) "SOCKET")
 305               "collect data via Luxi, optionally using the given SOCKET path"
 306
 307 oMachineReadable :: OptType
 308 oMachineReadable = Option "" ["machine-readable"]
 309                    (OptArg (\ f opts -> do
 310                      flag <- parseYesNo True f
 311                      return $ opts { optMachineReadable = flag }) "CHOICE")
 312           "enable machine readable output (pass either 'yes' or 'no' to\
 313           \ explicitly control the flag, or without an argument defaults to\
 314           \ yes"
 315
 316 oMaxCpu :: OptType
 317 oMaxCpu = Option "" ["max-cpu"]
 318           (reqWithConversion (tryRead "parsing max-cpu")
 319            (\mcpu opts -> do
 320               when (mcpu <= 0) $
 321                    fail "Invalid value of the max-cpu ratio,\
 322                         \ expected >0"
 323               return $ opts { optMcpu = Just mcpu }) "RATIO")
 324           "maximum virtual-to-physical cpu ratio for nodes (from 0\
 325           \ upwards) [default read from cluster]"
 326
 327 oMaxSolLength :: OptType
 328 oMaxSolLength = Option "l" ["max-length"]
 329                 (reqWithConversion (tryRead "max solution length")
 330                  (\i opts -> Ok opts { optMaxLength = i }) "N")
 331                 "cap the solution at this many balancing or allocation \
 332                 \ rounds (useful for very unbalanced clusters or empty \
 333                 \ clusters)"
 334
 335 oMinDisk :: OptType
 336 oMinDisk = Option "" ["min-disk"]
 337            (reqWithConversion (tryRead "min free disk space")
 338             (\n opts -> Ok opts { optMdsk = n }) "RATIO")
 339            "minimum free disk space for nodes (between 0 and 1) [0]"
 340
 341 oMinGain :: OptType
 342 oMinGain = Option "g" ["min-gain"]
 343            (reqWithConversion (tryRead "min gain")
 344             (\g opts -> Ok opts { optMinGain = g }) "DELTA")
 345             "minimum gain to aim for in a balancing step before giving up"
 346
 347 oMinGainLim :: OptType
 348 oMinGainLim = Option "" ["min-gain-limit"]
 349             (reqWithConversion (tryRead "min gain limit")
 350              (\g opts -> Ok opts { optMinGainLim = g }) "SCORE")
 351             "minimum cluster score for which we start checking the min-gain"
 352
 353 oMinScore :: OptType
 354 oMinScore = Option "e" ["min-score"]
 355             (reqWithConversion (tryRead "min score")
 356              (\e opts -> Ok opts { optMinScore = e }) "EPSILON")
 357             "mininum score to aim for"
 358
 359 oNoHeaders :: OptType
 360 oNoHeaders = Option "" ["no-headers"]
 361              (NoArg (\ opts -> Ok opts { optNoHeaders = True }))
 362              "do not show a header line"
 363
 364 oNoSimulation :: OptType
 365 oNoSimulation = Option "" ["no-simulation"]
 366                 (NoArg (\opts -> Ok opts {optNoSimulation = True}))
 367                 "do not perform rebalancing simulation"
 368
 369 oNodeSim :: OptType
 370 oNodeSim = Option "" ["simulate"]
 371             (ReqArg (\ f o -> Ok o { optNodeSim = f:optNodeSim o }) "SPEC")
 372             "simulate an empty cluster, given as\
 373             \ 'alloc_policy,num_nodes,disk,ram,cpu'"
 374
 375 oOfflineNode :: OptType
 376 oOfflineNode = Option "O" ["offline"]
 377                (ReqArg (\ n o -> Ok o { optOffline = n:optOffline o }) "NODE")
 378                "set node as offline"
 379
 380 oOutputDir :: OptType
 381 oOutputDir = Option "d" ["output-dir"]
 382              (ReqArg (\ d opts -> Ok opts { optOutPath = d }) "PATH")
 383              "directory in which to write output files"
 384
 385 oPrintCommands :: OptType
 386 oPrintCommands = Option "C" ["print-commands"]
 387                  (OptArg ((\ f opts -> Ok opts { optShowCmds = Just f }) .
 388                           fromMaybe "-")
 389                   "FILE")
 390                  "print the ganeti command list for reaching the solution,\
 391                  \ if an argument is passed then write the commands to a\
 392                  \ file named as such"
 393
 394 oPrintInsts :: OptType
 395 oPrintInsts = Option "" ["print-instances"]
 396               (NoArg (\ opts -> Ok opts { optShowInsts = True }))
 397               "print the final instance map"
 398
 399 oPrintNodes :: OptType
 400 oPrintNodes = Option "p" ["print-nodes"]
 401               (OptArg ((\ f opts ->
 402                           let (prefix, realf) = case f of
 403                                                   '+':rest -> (["+"], rest)
 404                                                   _ -> ([], f)
 405                               splitted = prefix ++ sepSplit ',' realf
 406                           in Ok opts { optShowNodes = Just splitted }) .
 407                        fromMaybe []) "FIELDS")
 408               "print the final node list"
 409
 410 oQuiet :: OptType
 411 oQuiet = Option "q" ["quiet"]
 412          (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts - 1 }))
 413          "decrease the verbosity level"
 414
 415 oRapiMaster :: OptType
 416 oRapiMaster = Option "m" ["master"]
 417               (ReqArg (\ m opts -> Ok opts { optMaster = m }) "ADDRESS")
 418               "collect data via RAPI at the given ADDRESS"
 419
 420 oSaveCluster :: OptType
 421 oSaveCluster = Option "S" ["save"]
 422             (ReqArg (\ f opts -> Ok opts { optSaveCluster = Just f }) "FILE")
 423             "Save cluster state at the end of the processing to FILE"
 424
 425 oStdSpec :: OptType
 426 oStdSpec = Option "" ["standard-alloc"]
 427              (ReqArg (\ inp opts -> do
 428                         tspec <- parseISpecString "standard" inp
 429                         return $ opts { optStdSpec = Just tspec } )
 430               "STDSPEC")
 431              "enable standard specs allocation, given as 'disk,ram,cpu'"
 432
 433 oTieredSpec :: OptType
 434 oTieredSpec = Option "" ["tiered-alloc"]
 435              (ReqArg (\ inp opts -> do
 436                         tspec <- parseISpecString "tiered" inp
 437                         return $ opts { optTieredSpec = Just tspec } )
 438               "TSPEC")
 439              "enable tiered specs allocation, given as 'disk,ram,cpu'"
 440
 441 oVerbose :: OptType
 442 oVerbose = Option "v" ["verbose"]
 443            (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts + 1 }))
 444            "increase the verbosity level"
 445
 446 -- * Functions
 447
 448 -- | Wrapper over 'Common.parseOpts' with our custom options.
 449 parseOpts :: [String]               -- ^ The command line arguments
 450           -> String                 -- ^ The program name
 451           -> [OptType]              -- ^ The supported command line options
 452           -> IO (Options, [String]) -- ^ The resulting options and leftover
 453                                     -- arguments
 454 parseOpts = Common.parseOpts defaultOptions
 455
 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 -- | Optionally print the instance list.
 483 maybePrintInsts :: Bool   -- ^ Whether to print the instance list
 484                 -> String -- ^ Type of the instance map (e.g. initial)
 485                 -> String -- ^ The instance data
 486                 -> IO ()
 487 maybePrintInsts do_print msg instdata =
 488   when do_print $ do
 489     hPutStrLn stderr ""
 490     hPutStrLn stderr $ msg ++ " instance map:"
 491     hPutStr stderr instdata
 492
 493 -- | Function to display warning messages from parsing the cluster
 494 -- state.
 495 maybeShowWarnings :: [String] -- ^ The warning messages
 496                   -> IO ()
 497 maybeShowWarnings fix_msgs =
 498   unless (null fix_msgs) $ do
 499     hPutStrLn stderr "Warning: cluster has inconsistent data:"
 500     hPutStrLn stderr . unlines . map (printf "  - %s") $ fix_msgs
 501
 502 -- | Format a list of key, value as a shell fragment.
 503 printKeys :: String              -- ^ Prefix to printed variables
 504           -> [(String, String)]  -- ^ List of (key, value) pairs to be printed
 505           -> IO ()
 506 printKeys prefix =
 507   mapM_ (\(k, v) ->
 508            printf "%s_%s=%s\n" prefix (map toUpper k) (ensureQuoted v))
 509
 510 -- | Prints the final @OK@ marker in machine readable output.
 511 printFinal :: String    -- ^ Prefix to printed variable
 512            -> Bool      -- ^ Whether output should be machine readable;
 513                         -- note: if not, there is nothing to print
 514            -> IO ()
 515 printFinal prefix True =
 516   -- this should be the final entry
 517   printKeys prefix [("OK", "1")]
 518
 519 printFinal _ False = return ()
 520
 521 -- | Potentially set the node as offline based on passed offline list.
 522 setNodeOffline :: [Ndx] -> Node.Node -> Node.Node
 523 setNodeOffline offline_indices n =
 524   if Node.idx n `elem` offline_indices
 525     then Node.setOffline n True
 526     else n
 527
 528 -- | Set node properties based on command line options.
 529 setNodeStatus :: Options -> Node.List -> IO Node.List
 530 setNodeStatus opts fixed_nl = do
 531   let offline_passed = optOffline opts
 532       all_nodes = Container.elems fixed_nl
 533       offline_lkp = map (lookupName (map Node.name all_nodes)) offline_passed
 534       offline_wrong = filter (not . goodLookupResult) offline_lkp
 535       offline_names = map lrContent offline_lkp
 536       offline_indices = map Node.idx $
 537                         filter (\n -> Node.name n `elem` offline_names)
 538                                all_nodes
 539       m_cpu = optMcpu opts
 540       m_dsk = optMdsk opts
 541
 542   unless (null offline_wrong) $ do
 543          exitErr $ printf "wrong node name(s) set as offline: %s\n"
 544                    (commaJoin (map lrContent offline_wrong))
 545   let setMCpuFn = case m_cpu of
 546                     Nothing -> id
 547                     Just new_mcpu -> flip Node.setMcpu new_mcpu
 548   let nm = Container.map (setNodeOffline offline_indices .
 549                           flip Node.setMdsk m_dsk .
 550                           setMCpuFn) fixed_nl
 551   return nm