code.grnet.gr Git - ganeti-local/blob - src/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.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, 2013 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   , maybePrintNodes
  40   , maybePrintInsts
  41   , maybeShowWarnings
  42   , printKeys
  43   , printFinal
  44   , setNodeStatus
  45   -- * The options
  46   , oDataFile
  47   , oDiskMoves
  48   , oDiskTemplate
  49   , oSpindleUse
  50   , oDynuFile
  51   , oEvacMode
  52   , oExInst
  53   , oExTags
  54   , oExecJobs
  55   , oForce
  56   , oGroup
  57   , oIAllocSrc
  58   , oInstMoves
  59   , oJobDelay
  60   , genOLuxiSocket
  61   , oLuxiSocket
  62   , oMachineReadable
  63   , oMaxCpu
  64   , oMaxSolLength
  65   , oMinDisk
  66   , oMinGain
  67   , oMinGainLim
  68   , oMinScore
  69   , oNoHeaders
  70   , oNoSimulation
  71   , oNodeSim
  72   , oNodeTags
  73   , oOfflineMaintenance
  74   , oOfflineNode
  75   , oOneStepOnly
  76   , oOutputDir
  77   , oPrintCommands
  78   , oPrintInsts
  79   , oPrintNodes
  80   , oQuiet
  81   , oRapiMaster
  82   , oSaveCluster
  83   , oSelInst
  84   , oShowHelp
  85   , oShowVer
  86   , oShowComp
  87   , oSkipNonRedundant
  88   , oStdSpec
  89   , oTieredSpec
  90   , oVerbose
  91   , oPriority
  92   , genericOpts
  93   ) where
  94
  95 import Control.Monad
  96 import Data.Char (toUpper)
  97 import Data.Maybe (fromMaybe)
  98 import System.Console.GetOpt
  99 import System.IO
 100 import Text.Printf (printf)
 101
 102 import qualified Ganeti.HTools.Container as Container
 103 import qualified Ganeti.HTools.Node as Node
 104 import qualified Ganeti.Path as Path
 105 import Ganeti.HTools.Types
 106 import Ganeti.BasicTypes
 107 import Ganeti.Common as Common
 108 import Ganeti.Types
 109 import Ganeti.Utils
 110
 111 -- * Data types
 112
 113 -- | Command line options structure.
 114 data Options = Options
 115   { optDataFile    :: Maybe FilePath -- ^ Path to the cluster data file
 116   , optDiskMoves   :: Bool           -- ^ Allow disk moves
 117   , optInstMoves   :: Bool           -- ^ Allow instance moves
 118   , optDiskTemplate :: Maybe DiskTemplate  -- ^ Override for the disk template
 119   , optSpindleUse  :: Maybe Int      -- ^ Override for the spindle usage
 120   , optDynuFile    :: Maybe FilePath -- ^ Optional file with dynamic use data
 121   , optEvacMode    :: Bool           -- ^ Enable evacuation mode
 122   , optExInst      :: [String]       -- ^ Instances to be excluded
 123   , optExTags      :: Maybe [String] -- ^ Tags to use for exclusion
 124   , optExecJobs    :: Bool           -- ^ Execute the commands via Luxi
 125   , optForce       :: Bool           -- ^ Force the execution
 126   , optGroup       :: Maybe GroupID  -- ^ The UUID of the group to process
 127   , optIAllocSrc   :: Maybe FilePath -- ^ The iallocation spec
 128   , optSelInst     :: [String]       -- ^ Instances to be excluded
 129   , optLuxi        :: Maybe FilePath -- ^ Collect data from Luxi
 130   , optJobDelay    :: Double         -- ^ Delay before executing first job
 131   , optMachineReadable :: Bool       -- ^ Output machine-readable format
 132   , optMaster      :: String         -- ^ Collect data from RAPI
 133   , optMaxLength   :: Int            -- ^ Stop after this many steps
 134   , optMcpu        :: Maybe Double   -- ^ Override max cpu ratio for nodes
 135   , optMdsk        :: Double         -- ^ Max disk usage ratio for nodes
 136   , optMinGain     :: Score          -- ^ Min gain we aim for in a step
 137   , optMinGainLim  :: Score          -- ^ Limit below which we apply mingain
 138   , optMinScore    :: Score          -- ^ The minimum score we aim for
 139   , optNoHeaders   :: Bool           -- ^ Do not show a header line
 140   , optNoSimulation :: Bool          -- ^ Skip the rebalancing dry-run
 141   , optNodeSim     :: [String]       -- ^ Cluster simulation mode
 142   , optNodeTags    :: Maybe [String] -- ^ List of node tags to restrict to
 143   , optOffline     :: [String]       -- ^ Names of offline nodes
 144   , optOfflineMaintenance :: Bool    -- ^ Pretend all instances are offline
 145   , optOneStepOnly :: Bool           -- ^ Only do the first step
 146   , optOutPath     :: FilePath       -- ^ Path to the output directory
 147   , optSaveCluster :: Maybe FilePath -- ^ Save cluster state to this file
 148   , optShowCmds    :: Maybe FilePath -- ^ Whether to show the command list
 149   , optShowHelp    :: Bool           -- ^ Just show the help
 150   , optShowComp    :: Bool           -- ^ Just show the completion info
 151   , optShowInsts   :: Bool           -- ^ Whether to show the instance map
 152   , optShowNodes   :: Maybe [String] -- ^ Whether to show node status
 153   , optShowVer     :: Bool           -- ^ Just show the program version
 154   , optSkipNonRedundant :: Bool      -- ^ Skip nodes with non-redundant instance
 155   , optStdSpec     :: Maybe RSpec    -- ^ Requested standard specs
 156   , optTestCount   :: Maybe Int      -- ^ Optional test count override
 157   , optTieredSpec  :: Maybe RSpec    -- ^ Requested specs for tiered mode
 158   , optReplay      :: Maybe String   -- ^ Unittests: RNG state
 159   , optVerbose     :: Int            -- ^ Verbosity level
 160   , optPriority    :: Maybe OpSubmitPriority -- ^ OpCode submit priority
 161   } deriving Show
 162
 163 -- | Default values for the command line options.
 164 defaultOptions :: Options
 165 defaultOptions  = Options
 166   { optDataFile    = Nothing
 167   , optDiskMoves   = True
 168   , optInstMoves   = True
 169   , optDiskTemplate = Nothing
 170   , optSpindleUse  = Nothing
 171   , optDynuFile    = Nothing
 172   , optEvacMode    = False
 173   , optExInst      = []
 174   , optExTags      = Nothing
 175   , optExecJobs    = False
 176   , optForce       = False
 177   , optGroup       = Nothing
 178   , optIAllocSrc   = Nothing
 179   , optSelInst     = []
 180   , optLuxi        = Nothing
 181   , optJobDelay    = 10
 182   , optMachineReadable = False
 183   , optMaster      = ""
 184   , optMaxLength   = -1
 185   , optMcpu        = Nothing
 186   , optMdsk        = defReservedDiskRatio
 187   , optMinGain     = 1e-2
 188   , optMinGainLim  = 1e-1
 189   , optMinScore    = 1e-9
 190   , optNoHeaders   = False
 191   , optNoSimulation = False
 192   , optNodeSim     = []
 193   , optNodeTags    = Nothing
 194   , optSkipNonRedundant = False
 195   , optOffline     = []
 196   , optOfflineMaintenance = False
 197   , optOneStepOnly = False
 198   , optOutPath     = "."
 199   , optSaveCluster = Nothing
 200   , optShowCmds    = Nothing
 201   , optShowHelp    = False
 202   , optShowComp    = False
 203   , optShowInsts   = False
 204   , optShowNodes   = Nothing
 205   , optShowVer     = False
 206   , optStdSpec     = Nothing
 207   , optTestCount   = Nothing
 208   , optTieredSpec  = Nothing
 209   , optReplay      = Nothing
 210   , optVerbose     = 1
 211   , optPriority    = Nothing
 212   }
 213
 214 -- | Abbreviation for the option type.
 215 type OptType = GenericOptType Options
 216
 217 instance StandardOptions Options where
 218   helpRequested = optShowHelp
 219   verRequested  = optShowVer
 220   compRequested = optShowComp
 221   requestHelp o = o { optShowHelp = True }
 222   requestVer  o = o { optShowVer  = True }
 223   requestComp o = o { optShowComp = True }
 224
 225 -- * Helper functions
 226
 227 parseISpecString :: String -> String -> Result RSpec
 228 parseISpecString descr inp = do
 229   let sp = sepSplit ',' inp
 230       err = Bad ("Invalid " ++ descr ++ " specification: '" ++ inp ++
 231                  "', expected disk,ram,cpu")
 232   when (length sp /= 3) err
 233   prs <- mapM (\(fn, val) -> fn val) $
 234          zip [ annotateResult (descr ++ " specs disk") . parseUnit
 235              , annotateResult (descr ++ " specs memory") . parseUnit
 236              , tryRead (descr ++ " specs cpus")
 237              ] sp
 238   case prs of
 239     [dsk, ram, cpu] -> return $ RSpec cpu ram dsk
 240     _ -> err
 241
 242 -- | Disk template choices.
 243 optComplDiskTemplate :: OptCompletion
 244 optComplDiskTemplate = OptComplChoices $
 245                        map diskTemplateToRaw [minBound..maxBound]
 246
 247 -- * Command line options
 248
 249 oDataFile :: OptType
 250 oDataFile =
 251   (Option "t" ["text-data"]
 252    (ReqArg (\ f o -> Ok o { optDataFile = Just f }) "FILE")
 253    "the cluster data FILE",
 254    OptComplFile)
 255
 256 oDiskMoves :: OptType
 257 oDiskMoves =
 258   (Option "" ["no-disk-moves"]
 259    (NoArg (\ opts -> Ok opts { optDiskMoves = False}))
 260    "disallow disk moves from the list of allowed instance changes,\
 261    \ thus allowing only the 'cheap' failover/migrate operations",
 262    OptComplNone)
 263
 264 oDiskTemplate :: OptType
 265 oDiskTemplate =
 266   (Option "" ["disk-template"]
 267    (reqWithConversion diskTemplateFromRaw
 268     (\dt opts -> Ok opts { optDiskTemplate = Just dt })
 269     "TEMPLATE") "select the desired disk template",
 270    optComplDiskTemplate)
 271
 272 oSpindleUse :: OptType
 273 oSpindleUse =
 274   (Option "" ["spindle-use"]
 275    (reqWithConversion (tryRead "parsing spindle-use")
 276     (\su opts -> do
 277        when (su < 0) $
 278             fail "Invalid value of the spindle-use (expected >= 0)"
 279        return $ opts { optSpindleUse = Just su })
 280     "SPINDLES") "select how many virtual spindle instances use\
 281                 \ [default read from cluster]",
 282    OptComplFloat)
 283
 284 oSelInst :: OptType
 285 oSelInst =
 286   (Option "" ["select-instances"]
 287    (ReqArg (\ f opts -> Ok opts { optSelInst = sepSplit ',' f }) "INSTS")
 288    "only select given instances for any moves",
 289    OptComplManyInstances)
 290
 291 oInstMoves :: OptType
 292 oInstMoves =
 293   (Option "" ["no-instance-moves"]
 294    (NoArg (\ opts -> Ok opts { optInstMoves = False}))
 295    "disallow instance (primary node) moves from the list of allowed,\
 296    \ instance changes, thus allowing only slower, but sometimes\
 297    \ safer, drbd secondary changes",
 298    OptComplNone)
 299
 300 oDynuFile :: OptType
 301 oDynuFile =
 302   (Option "U" ["dynu-file"]
 303    (ReqArg (\ f opts -> Ok opts { optDynuFile = Just f }) "FILE")
 304    "Import dynamic utilisation data from the given FILE",
 305    OptComplFile)
 306
 307 oEvacMode :: OptType
 308 oEvacMode =
 309   (Option "E" ["evac-mode"]
 310    (NoArg (\opts -> Ok opts { optEvacMode = True }))
 311    "enable evacuation mode, where the algorithm only moves\
 312    \ instances away from offline and drained nodes",
 313    OptComplNone)
 314
 315 oExInst :: OptType
 316 oExInst =
 317   (Option "" ["exclude-instances"]
 318    (ReqArg (\ f opts -> Ok opts { optExInst = sepSplit ',' f }) "INSTS")
 319    "exclude given instances from any moves",
 320    OptComplManyInstances)
 321
 322 oExTags :: OptType
 323 oExTags =
 324   (Option "" ["exclusion-tags"]
 325    (ReqArg (\ f opts -> Ok opts { optExTags = Just $ sepSplit ',' f })
 326     "TAG,...") "Enable instance exclusion based on given tag prefix",
 327    OptComplString)
 328
 329 oExecJobs :: OptType
 330 oExecJobs =
 331   (Option "X" ["exec"]
 332    (NoArg (\ opts -> Ok opts { optExecJobs = True}))
 333    "execute the suggested moves via Luxi (only available when using\
 334    \ it for data gathering)",
 335    OptComplNone)
 336
 337 oForce :: OptType
 338 oForce =
 339   (Option "f" ["force"]
 340    (NoArg (\ opts -> Ok opts {optForce = True}))
 341    "force the execution of this program, even if warnings would\
 342    \ otherwise prevent it",
 343    OptComplNone)
 344
 345 oGroup :: OptType
 346 oGroup =
 347   (Option "G" ["group"]
 348    (ReqArg (\ f o -> Ok o { optGroup = Just f }) "ID")
 349    "the target node group (name or UUID)",
 350    OptComplOneGroup)
 351
 352 oIAllocSrc :: OptType
 353 oIAllocSrc =
 354   (Option "I" ["ialloc-src"]
 355    (ReqArg (\ f opts -> Ok opts { optIAllocSrc = Just f }) "FILE")
 356    "Specify an iallocator spec as the cluster data source",
 357    OptComplFile)
 358
 359 oJobDelay :: OptType
 360 oJobDelay =
 361   (Option "" ["job-delay"]
 362    (reqWithConversion (tryRead "job delay")
 363     (\d opts -> Ok opts { optJobDelay = d }) "SECONDS")
 364    "insert this much delay before the execution of repair jobs\
 365    \ to allow the tool to continue processing instances",
 366    OptComplFloat)
 367
 368 genOLuxiSocket :: String -> OptType
 369 genOLuxiSocket defSocket =
 370   (Option "L" ["luxi"]
 371    (OptArg ((\ f opts -> Ok opts { optLuxi = Just f }) .
 372             fromMaybe defSocket) "SOCKET")
 373    ("collect data via Luxi, optionally using the given SOCKET path [" ++
 374     defSocket ++ "]"),
 375    OptComplFile)
 376
 377 oLuxiSocket :: IO OptType
 378 oLuxiSocket = liftM genOLuxiSocket Path.defaultLuxiSocket
 379
 380 oMachineReadable :: OptType
 381 oMachineReadable =
 382   (Option "" ["machine-readable"]
 383    (OptArg (\ f opts -> do
 384               flag <- parseYesNo True f
 385               return $ opts { optMachineReadable = flag }) "CHOICE")
 386    "enable machine readable output (pass either 'yes' or 'no' to\
 387    \ explicitly control the flag, or without an argument defaults to\
 388    \ yes",
 389    optComplYesNo)
 390
 391 oMaxCpu :: OptType
 392 oMaxCpu =
 393   (Option "" ["max-cpu"]
 394    (reqWithConversion (tryRead "parsing max-cpu")
 395     (\mcpu opts -> do
 396        when (mcpu <= 0) $
 397             fail "Invalid value of the max-cpu ratio, expected >0"
 398        return $ opts { optMcpu = Just mcpu }) "RATIO")
 399    "maximum virtual-to-physical cpu ratio for nodes (from 0\
 400    \ upwards) [default read from cluster]",
 401    OptComplFloat)
 402
 403 oMaxSolLength :: OptType
 404 oMaxSolLength =
 405   (Option "l" ["max-length"]
 406    (reqWithConversion (tryRead "max solution length")
 407     (\i opts -> Ok opts { optMaxLength = i }) "N")
 408    "cap the solution at this many balancing or allocation\
 409    \ rounds (useful for very unbalanced clusters or empty\
 410    \ clusters)",
 411    OptComplInteger)
 412
 413 oMinDisk :: OptType
 414 oMinDisk =
 415   (Option "" ["min-disk"]
 416    (reqWithConversion (tryRead "min free disk space")
 417     (\n opts -> Ok opts { optMdsk = n }) "RATIO")
 418    "minimum free disk space for nodes (between 0 and 1) [0]",
 419    OptComplFloat)
 420
 421 oMinGain :: OptType
 422 oMinGain =
 423   (Option "g" ["min-gain"]
 424    (reqWithConversion (tryRead "min gain")
 425     (\g opts -> Ok opts { optMinGain = g }) "DELTA")
 426    "minimum gain to aim for in a balancing step before giving up",
 427    OptComplFloat)
 428
 429 oMinGainLim :: OptType
 430 oMinGainLim =
 431   (Option "" ["min-gain-limit"]
 432    (reqWithConversion (tryRead "min gain limit")
 433     (\g opts -> Ok opts { optMinGainLim = g }) "SCORE")
 434    "minimum cluster score for which we start checking the min-gain",
 435    OptComplFloat)
 436
 437 oMinScore :: OptType
 438 oMinScore =
 439   (Option "e" ["min-score"]
 440    (reqWithConversion (tryRead "min score")
 441     (\e opts -> Ok opts { optMinScore = e }) "EPSILON")
 442    "mininum score to aim for",
 443    OptComplFloat)
 444
 445 oNoHeaders :: OptType
 446 oNoHeaders =
 447   (Option "" ["no-headers"]
 448    (NoArg (\ opts -> Ok opts { optNoHeaders = True }))
 449    "do not show a header line",
 450    OptComplNone)
 451
 452 oNoSimulation :: OptType
 453 oNoSimulation =
 454   (Option "" ["no-simulation"]
 455    (NoArg (\opts -> Ok opts {optNoSimulation = True}))
 456    "do not perform rebalancing simulation",
 457    OptComplNone)
 458
 459 oNodeSim :: OptType
 460 oNodeSim =
 461   (Option "" ["simulate"]
 462    (ReqArg (\ f o -> Ok o { optNodeSim = f:optNodeSim o }) "SPEC")
 463    "simulate an empty cluster, given as\
 464    \ 'alloc_policy,num_nodes,disk,ram,cpu'",
 465    OptComplString)
 466
 467 oNodeTags :: OptType
 468 oNodeTags =
 469   (Option "" ["node-tags"]
 470    (ReqArg (\ f opts -> Ok opts { optNodeTags = Just $ sepSplit ',' f })
 471     "TAG,...") "Restrict to nodes with the given tags",
 472    OptComplString)
 473
 474 oOfflineMaintenance :: OptType
 475 oOfflineMaintenance =
 476   (Option "" ["offline-maintenance"]
 477    (NoArg (\ opts -> Ok opts {optOfflineMaintenance = True}))
 478    "Schedule offline maintenance, i.e., pretend that all instance are\
 479    \ offline.",
 480    OptComplNone)
 481
 482 oOfflineNode :: OptType
 483 oOfflineNode =
 484   (Option "O" ["offline"]
 485    (ReqArg (\ n o -> Ok o { optOffline = n:optOffline o }) "NODE")
 486    "set node as offline",
 487    OptComplOneNode)
 488
 489 oOneStepOnly :: OptType
 490 oOneStepOnly =
 491   (Option "" ["one-step-only"]
 492    (NoArg (\ opts -> Ok opts {optOneStepOnly = True}))
 493    "Only do the first step",
 494    OptComplNone)
 495
 496 oOutputDir :: OptType
 497 oOutputDir =
 498   (Option "d" ["output-dir"]
 499    (ReqArg (\ d opts -> Ok opts { optOutPath = d }) "PATH")
 500    "directory in which to write output files",
 501    OptComplDir)
 502
 503 oPrintCommands :: OptType
 504 oPrintCommands =
 505   (Option "C" ["print-commands"]
 506    (OptArg ((\ f opts -> Ok opts { optShowCmds = Just f }) .
 507             fromMaybe "-")
 508     "FILE")
 509    "print the ganeti command list for reaching the solution,\
 510    \ if an argument is passed then write the commands to a\
 511    \ file named as such",
 512    OptComplNone)
 513
 514 oPrintInsts :: OptType
 515 oPrintInsts =
 516   (Option "" ["print-instances"]
 517    (NoArg (\ opts -> Ok opts { optShowInsts = True }))
 518    "print the final instance map",
 519    OptComplNone)
 520
 521 oPrintNodes :: OptType
 522 oPrintNodes =
 523   (Option "p" ["print-nodes"]
 524    (OptArg ((\ f opts ->
 525                let (prefix, realf) = case f of
 526                                        '+':rest -> (["+"], rest)
 527                                        _ -> ([], f)
 528                    splitted = prefix ++ sepSplit ',' realf
 529                in Ok opts { optShowNodes = Just splitted }) .
 530             fromMaybe []) "FIELDS")
 531    "print the final node list",
 532    OptComplNone)
 533
 534 oQuiet :: OptType
 535 oQuiet =
 536   (Option "q" ["quiet"]
 537    (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts - 1 }))
 538    "decrease the verbosity level",
 539    OptComplNone)
 540
 541 oRapiMaster :: OptType
 542 oRapiMaster =
 543   (Option "m" ["master"]
 544    (ReqArg (\ m opts -> Ok opts { optMaster = m }) "ADDRESS")
 545    "collect data via RAPI at the given ADDRESS",
 546    OptComplHost)
 547
 548 oSaveCluster :: OptType
 549 oSaveCluster =
 550   (Option "S" ["save"]
 551    (ReqArg (\ f opts -> Ok opts { optSaveCluster = Just f }) "FILE")
 552    "Save cluster state at the end of the processing to FILE",
 553    OptComplNone)
 554
 555 oSkipNonRedundant :: OptType
 556 oSkipNonRedundant =
 557   (Option "" ["skip-non-redundant"]
 558    (NoArg (\ opts -> Ok opts { optSkipNonRedundant = True }))
 559     "Skip nodes that host a non-redundant instance",
 560     OptComplNone)
 561
 562 oStdSpec :: OptType
 563 oStdSpec =
 564   (Option "" ["standard-alloc"]
 565    (ReqArg (\ inp opts -> do
 566               tspec <- parseISpecString "standard" inp
 567               return $ opts { optStdSpec = Just tspec } )
 568     "STDSPEC")
 569    "enable standard specs allocation, given as 'disk,ram,cpu'",
 570    OptComplString)
 571
 572 oTieredSpec :: OptType
 573 oTieredSpec =
 574   (Option "" ["tiered-alloc"]
 575    (ReqArg (\ inp opts -> do
 576               tspec <- parseISpecString "tiered" inp
 577               return $ opts { optTieredSpec = Just tspec } )
 578     "TSPEC")
 579    "enable tiered specs allocation, given as 'disk,ram,cpu'",
 580    OptComplString)
 581
 582 oVerbose :: OptType
 583 oVerbose =
 584   (Option "v" ["verbose"]
 585    (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts + 1 }))
 586    "increase the verbosity level",
 587    OptComplNone)
 588
 589 oPriority :: OptType
 590 oPriority =
 591   (Option "" ["priority"]
 592    (ReqArg (\ inp opts -> do
 593               prio <- parseSubmitPriority inp
 594               Ok opts { optPriority = Just prio }) "PRIO")
 595    "set the priority of submitted jobs",
 596     OptComplChoices (map fmtSubmitPriority [minBound..maxBound]))
 597
 598 -- | Generic options.
 599 genericOpts :: [GenericOptType Options]
 600 genericOpts =  [ oShowVer
 601                , oShowHelp
 602                , oShowComp
 603                ]
 604
 605 -- * Functions
 606
 607 -- | Wrapper over 'Common.parseOpts' with our custom options.
 608 parseOpts :: [String]               -- ^ The command line arguments
 609           -> String                 -- ^ The program name
 610           -> [OptType]              -- ^ The supported command line options
 611           -> [ArgCompletion]        -- ^ The supported command line arguments
 612           -> IO (Options, [String]) -- ^ The resulting options and leftover
 613                                     -- arguments
 614 parseOpts = Common.parseOpts defaultOptions
 615
 616
 617 -- | A shell script template for autogenerated scripts.
 618 shTemplate :: String
 619 shTemplate =
 620   printf "#!/bin/sh\n\n\
 621          \# Auto-generated script for executing cluster rebalancing\n\n\
 622          \# To stop, touch the file /tmp/stop-htools\n\n\
 623          \set -e\n\n\
 624          \check() {\n\
 625          \  if [ -f /tmp/stop-htools ]; then\n\
 626          \    echo 'Stop requested, exiting'\n\
 627          \    exit 0\n\
 628          \  fi\n\
 629          \}\n\n"
 630
 631 -- | Optionally print the node list.
 632 maybePrintNodes :: Maybe [String]       -- ^ The field list
 633                 -> String               -- ^ Informational message
 634                 -> ([String] -> String) -- ^ Function to generate the listing
 635                 -> IO ()
 636 maybePrintNodes Nothing _ _ = return ()
 637 maybePrintNodes (Just fields) msg fn = do
 638   hPutStrLn stderr ""
 639   hPutStrLn stderr (msg ++ " status:")
 640   hPutStrLn stderr $ fn fields
 641
 642 -- | Optionally print the instance list.
 643 maybePrintInsts :: Bool   -- ^ Whether to print the instance list
 644                 -> String -- ^ Type of the instance map (e.g. initial)
 645                 -> String -- ^ The instance data
 646                 -> IO ()
 647 maybePrintInsts do_print msg instdata =
 648   when do_print $ do
 649     hPutStrLn stderr ""
 650     hPutStrLn stderr $ msg ++ " instance map:"
 651     hPutStr stderr instdata
 652
 653 -- | Function to display warning messages from parsing the cluster
 654 -- state.
 655 maybeShowWarnings :: [String] -- ^ The warning messages
 656                   -> IO ()
 657 maybeShowWarnings fix_msgs =
 658   unless (null fix_msgs) $ do
 659     hPutStrLn stderr "Warning: cluster has inconsistent data:"
 660     hPutStrLn stderr . unlines . map (printf "  - %s") $ fix_msgs
 661
 662 -- | Format a list of key, value as a shell fragment.
 663 printKeys :: String              -- ^ Prefix to printed variables
 664           -> [(String, String)]  -- ^ List of (key, value) pairs to be printed
 665           -> IO ()
 666 printKeys prefix =
 667   mapM_ (\(k, v) ->
 668            printf "%s_%s=%s\n" prefix (map toUpper k) (ensureQuoted v))
 669
 670 -- | Prints the final @OK@ marker in machine readable output.
 671 printFinal :: String    -- ^ Prefix to printed variable
 672            -> Bool      -- ^ Whether output should be machine readable;
 673                         -- note: if not, there is nothing to print
 674            -> IO ()
 675 printFinal prefix True =
 676   -- this should be the final entry
 677   printKeys prefix [("OK", "1")]
 678
 679 printFinal _ False = return ()
 680
 681 -- | Potentially set the node as offline based on passed offline list.
 682 setNodeOffline :: [Ndx] -> Node.Node -> Node.Node
 683 setNodeOffline offline_indices n =
 684   if Node.idx n `elem` offline_indices
 685     then Node.setOffline n True
 686     else n
 687
 688 -- | Set node properties based on command line options.
 689 setNodeStatus :: Options -> Node.List -> IO Node.List
 690 setNodeStatus opts fixed_nl = do
 691   let offline_passed = optOffline opts
 692       all_nodes = Container.elems fixed_nl
 693       offline_lkp = map (lookupName (map Node.name all_nodes)) offline_passed
 694       offline_wrong = filter (not . goodLookupResult) offline_lkp
 695       offline_names = map lrContent offline_lkp
 696       offline_indices = map Node.idx $
 697                         filter (\n -> Node.name n `elem` offline_names)
 698                                all_nodes
 699       m_cpu = optMcpu opts
 700       m_dsk = optMdsk opts
 701
 702   unless (null offline_wrong) .
 703          exitErr $ printf "wrong node name(s) set as offline: %s\n"
 704                    (commaJoin (map lrContent offline_wrong))
 705   let setMCpuFn = case m_cpu of
 706                     Nothing -> id
 707                     Just new_mcpu -> flip Node.setMcpu new_mcpu
 708   let nm = Container.map (setNodeOffline offline_indices .
 709                           flip Node.setMdsk m_dsk .
 710                           setMCpuFn) fixed_nl
 711   return nm