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