CLI.hs 25.4 KB
Newer Older
1 2
{-| Implementation of command-line functions.

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

-}

Iustin Pop's avatar
Iustin Pop committed
9 10
{-

11
Copyright (C) 2009, 2010, 2011, 2012, 2013 Google Inc.
Iustin Pop's avatar
Iustin Pop committed
12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
02110-1301, USA.

-}

30
module Ganeti.HTools.CLI
Iustin Pop's avatar
Iustin Pop committed
31 32
  ( Options(..)
  , OptType
Iustin Pop's avatar
Iustin Pop committed
33 34
  , defaultOptions
  , Ganeti.HTools.CLI.parseOpts
35
  , parseOptsInner
Iustin Pop's avatar
Iustin Pop committed
36
  , parseYesNo
37
  , parseISpecString
Iustin Pop's avatar
Iustin Pop committed
38 39 40 41
  , shTemplate
  , maybePrintNodes
  , maybePrintInsts
  , maybeShowWarnings
42 43
  , printKeys
  , printFinal
Iustin Pop's avatar
Iustin Pop committed
44 45 46 47 48
  , setNodeStatus
  -- * The options
  , oDataFile
  , oDiskMoves
  , oDiskTemplate
49
  , oSpindleUse
Iustin Pop's avatar
Iustin Pop committed
50
  , oDynuFile
51
  , oMonD
Spyros Trigazis's avatar
Spyros Trigazis committed
52
  , oMonDDataFile
Iustin Pop's avatar
Iustin Pop committed
53 54 55 56
  , oEvacMode
  , oExInst
  , oExTags
  , oExecJobs
57
  , oForce
58
  , oFullEvacuation
Iustin Pop's avatar
Iustin Pop committed
59
  , oGroup
60
  , oIAllocSrc
61
  , oIgnoreDyn 
62
  , oIgnoreNonRedundant
Iustin Pop's avatar
Iustin Pop committed
63
  , oInstMoves
64
  , oJobDelay
Iustin Pop's avatar
Iustin Pop committed
65
  , genOLuxiSocket
Iustin Pop's avatar
Iustin Pop committed
66 67 68 69 70 71 72 73 74
  , oLuxiSocket
  , oMachineReadable
  , oMaxCpu
  , oMaxSolLength
  , oMinDisk
  , oMinGain
  , oMinGainLim
  , oMinScore
  , oNoHeaders
75
  , oNoSimulation
Iustin Pop's avatar
Iustin Pop committed
76
  , oNodeSim
77
  , oNodeTags
78
  , oOfflineMaintenance
Iustin Pop's avatar
Iustin Pop committed
79
  , oOfflineNode
80
  , oOneStepOnly
Iustin Pop's avatar
Iustin Pop committed
81 82 83
  , oOutputDir
  , oPrintCommands
  , oPrintInsts
84
  , oPrintMoves
Iustin Pop's avatar
Iustin Pop committed
85 86 87 88 89 90 91
  , oPrintNodes
  , oQuiet
  , oRapiMaster
  , oSaveCluster
  , oSelInst
  , oShowHelp
  , oShowVer
92
  , oShowComp
93
  , oSkipNonRedundant
94
  , oStdSpec
95
  , oTargetResources
Iustin Pop's avatar
Iustin Pop committed
96 97
  , oTieredSpec
  , oVerbose
98
  , oPriority
99
  , genericOpts
Iustin Pop's avatar
Iustin Pop committed
100
  ) where
101

Iustin Pop's avatar
Iustin Pop committed
102
import Control.Monad
103
import Data.Char (toUpper)
104
import Data.Maybe (fromMaybe)
105 106
import System.Console.GetOpt
import System.IO
Iustin Pop's avatar
Iustin Pop committed
107
import Text.Printf (printf)
108

Iustin Pop's avatar
Iustin Pop committed
109 110
import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Node as Node
111
import qualified Ganeti.Path as Path
112
import Ganeti.HTools.Types
Iustin Pop's avatar
Iustin Pop committed
113
import Ganeti.BasicTypes
Iustin Pop's avatar
Iustin Pop committed
114
import Ganeti.Common as Common
115
import Ganeti.Types
116
import Ganeti.Utils
117

118 119
-- * Data types

120 121
-- | Command line options structure.
data Options = Options
Iustin Pop's avatar
Iustin Pop committed
122 123 124
  { optDataFile    :: Maybe FilePath -- ^ Path to the cluster data file
  , optDiskMoves   :: Bool           -- ^ Allow disk moves
  , optInstMoves   :: Bool           -- ^ Allow instance moves
125
  , optDiskTemplate :: Maybe DiskTemplate  -- ^ Override for the disk template
126
  , optSpindleUse  :: Maybe Int      -- ^ Override for the spindle usage
Iustin Pop's avatar
Iustin Pop committed
127
  , optDynuFile    :: Maybe FilePath -- ^ Optional file with dynamic use data
128
  , optIgnoreDynu  :: Bool           -- ^ Do not use dynamic use data
129
  , optMonD        :: Bool           -- ^ Query MonDs
Spyros Trigazis's avatar
Spyros Trigazis committed
130 131
  , optMonDFile    :: Maybe FilePath -- ^ Optional file with data provided
                                     -- ^ by MonDs
Iustin Pop's avatar
Iustin Pop committed
132 133 134 135
  , optEvacMode    :: Bool           -- ^ Enable evacuation mode
  , optExInst      :: [String]       -- ^ Instances to be excluded
  , optExTags      :: Maybe [String] -- ^ Tags to use for exclusion
  , optExecJobs    :: Bool           -- ^ Execute the commands via Luxi
136
  , optForce       :: Bool           -- ^ Force the execution
137
  , optFullEvacuation :: Bool        -- ^ Fully evacuate nodes to be rebooted
Iustin Pop's avatar
Iustin Pop committed
138
  , optGroup       :: Maybe GroupID  -- ^ The UUID of the group to process
139
  , optIAllocSrc   :: Maybe FilePath -- ^ The iallocation spec
140
  , optIgnoreNonRedundant :: Bool    -- ^ Ignore non-redundant instances
Iustin Pop's avatar
Iustin Pop committed
141 142
  , optSelInst     :: [String]       -- ^ Instances to be excluded
  , optLuxi        :: Maybe FilePath -- ^ Collect data from Luxi
143
  , optJobDelay    :: Double         -- ^ Delay before executing first job
Iustin Pop's avatar
Iustin Pop committed
144 145 146
  , optMachineReadable :: Bool       -- ^ Output machine-readable format
  , optMaster      :: String         -- ^ Collect data from RAPI
  , optMaxLength   :: Int            -- ^ Stop after this many steps
147
  , optMcpu        :: Maybe Double   -- ^ Override max cpu ratio for nodes
Iustin Pop's avatar
Iustin Pop committed
148 149 150 151 152
  , optMdsk        :: Double         -- ^ Max disk usage ratio for nodes
  , optMinGain     :: Score          -- ^ Min gain we aim for in a step
  , optMinGainLim  :: Score          -- ^ Limit below which we apply mingain
  , optMinScore    :: Score          -- ^ The minimum score we aim for
  , optNoHeaders   :: Bool           -- ^ Do not show a header line
153
  , optNoSimulation :: Bool          -- ^ Skip the rebalancing dry-run
Iustin Pop's avatar
Iustin Pop committed
154
  , optNodeSim     :: [String]       -- ^ Cluster simulation mode
155
  , optNodeTags    :: Maybe [String] -- ^ List of node tags to restrict to 
Iustin Pop's avatar
Iustin Pop committed
156
  , optOffline     :: [String]       -- ^ Names of offline nodes
157
  , optOfflineMaintenance :: Bool    -- ^ Pretend all instances are offline
158
  , optOneStepOnly :: Bool           -- ^ Only do the first step
Iustin Pop's avatar
Iustin Pop committed
159
  , optOutPath     :: FilePath       -- ^ Path to the output directory
160
  , optPrintMoves  :: Bool           -- ^ Whether to show the instance moves
Iustin Pop's avatar
Iustin Pop committed
161 162 163
  , optSaveCluster :: Maybe FilePath -- ^ Save cluster state to this file
  , optShowCmds    :: Maybe FilePath -- ^ Whether to show the command list
  , optShowHelp    :: Bool           -- ^ Just show the help
164
  , optShowComp    :: Bool           -- ^ Just show the completion info
Iustin Pop's avatar
Iustin Pop committed
165 166 167
  , optShowInsts   :: Bool           -- ^ Whether to show the instance map
  , optShowNodes   :: Maybe [String] -- ^ Whether to show node status
  , optShowVer     :: Bool           -- ^ Just show the program version
168
  , optSkipNonRedundant :: Bool      -- ^ Skip nodes with non-redundant instance
169
  , optStdSpec     :: Maybe RSpec    -- ^ Requested standard specs
170
  , optTargetResources :: Double     -- ^ Target resources for squeezing
171
  , optTestCount   :: Maybe Int      -- ^ Optional test count override
Iustin Pop's avatar
Iustin Pop committed
172 173 174
  , optTieredSpec  :: Maybe RSpec    -- ^ Requested specs for tiered mode
  , optReplay      :: Maybe String   -- ^ Unittests: RNG state
  , optVerbose     :: Int            -- ^ Verbosity level
175
  , optPriority    :: Maybe OpSubmitPriority -- ^ OpCode submit priority
Iustin Pop's avatar
Iustin Pop committed
176
  } deriving Show
177 178 179 180

-- | Default values for the command line options.
defaultOptions :: Options
defaultOptions  = Options
Iustin Pop's avatar
Iustin Pop committed
181 182 183
  { optDataFile    = Nothing
  , optDiskMoves   = True
  , optInstMoves   = True
184
  , optDiskTemplate = Nothing
185
  , optSpindleUse  = Nothing
186
  , optIgnoreDynu  = False
Iustin Pop's avatar
Iustin Pop committed
187
  , optDynuFile    = Nothing
188
  , optMonD        = False
Spyros Trigazis's avatar
Spyros Trigazis committed
189
  , optMonDFile = Nothing
Iustin Pop's avatar
Iustin Pop committed
190 191 192 193
  , optEvacMode    = False
  , optExInst      = []
  , optExTags      = Nothing
  , optExecJobs    = False
194
  , optForce       = False
195
  , optFullEvacuation = False
Iustin Pop's avatar
Iustin Pop committed
196
  , optGroup       = Nothing
197
  , optIAllocSrc   = Nothing
198
  , optIgnoreNonRedundant = False
Iustin Pop's avatar
Iustin Pop committed
199 200
  , optSelInst     = []
  , optLuxi        = Nothing
201
  , optJobDelay    = 10
Iustin Pop's avatar
Iustin Pop committed
202 203 204
  , optMachineReadable = False
  , optMaster      = ""
  , optMaxLength   = -1
205
  , optMcpu        = Nothing
Iustin Pop's avatar
Iustin Pop committed
206 207 208 209 210
  , optMdsk        = defReservedDiskRatio
  , optMinGain     = 1e-2
  , optMinGainLim  = 1e-1
  , optMinScore    = 1e-9
  , optNoHeaders   = False
211
  , optNoSimulation = False
Iustin Pop's avatar
Iustin Pop committed
212
  , optNodeSim     = []
213
  , optNodeTags    = Nothing
214
  , optSkipNonRedundant = False
Iustin Pop's avatar
Iustin Pop committed
215
  , optOffline     = []
216
  , optOfflineMaintenance = False
217
  , optOneStepOnly = False
Iustin Pop's avatar
Iustin Pop committed
218
  , optOutPath     = "."
219
  , optPrintMoves  = False
Iustin Pop's avatar
Iustin Pop committed
220 221 222
  , optSaveCluster = Nothing
  , optShowCmds    = Nothing
  , optShowHelp    = False
223
  , optShowComp    = False
Iustin Pop's avatar
Iustin Pop committed
224 225 226
  , optShowInsts   = False
  , optShowNodes   = Nothing
  , optShowVer     = False
227
  , optStdSpec     = Nothing
228
  , optTargetResources = 2.0
229
  , optTestCount   = Nothing
Iustin Pop's avatar
Iustin Pop committed
230 231 232
  , optTieredSpec  = Nothing
  , optReplay      = Nothing
  , optVerbose     = 1
233
  , optPriority    = Nothing
Iustin Pop's avatar
Iustin Pop committed
234
  }
235

236
-- | Abbreviation for the option type.
Iustin Pop's avatar
Iustin Pop committed
237 238 239 240 241
type OptType = GenericOptType Options

instance StandardOptions Options where
  helpRequested = optShowHelp
  verRequested  = optShowVer
242
  compRequested = optShowComp
Iustin Pop's avatar
Iustin Pop committed
243 244
  requestHelp o = o { optShowHelp = True }
  requestVer  o = o { optShowVer  = True }
245
  requestComp o = o { optShowComp = True }
246

247 248 249 250 251
-- * Helper functions

parseISpecString :: String -> String -> Result RSpec
parseISpecString descr inp = do
  let sp = sepSplit ',' inp
252 253
      err = Bad ("Invalid " ++ descr ++ " specification: '" ++ inp ++
                 "', expected disk,ram,cpu")
254
  when (length sp < 3 || length sp > 4) err
255
  prs <- mapM (\(fn, val) -> fn val) $
256 257
         zip [ annotateResult (descr ++ " specs disk") . parseUnit
             , annotateResult (descr ++ " specs memory") . parseUnit
258
             , tryRead (descr ++ " specs cpus")
259
             , tryRead (descr ++ " specs spindles")
260 261
             ] sp
  case prs of
262 263 264 265 266 267 268
    {- Spindles are optional, so that they are not needed when exclusive storage
       is disabled. When exclusive storage is disabled, spindles are ignored,
       so the actual value doesn't matter. We use 1 as a default so that in
       case someone forgets and exclusive storage is enabled, we don't run into
       weird situations. -}
    [dsk, ram, cpu] -> return $ RSpec cpu ram dsk 1
    [dsk, ram, cpu, spn] -> return $ RSpec cpu ram dsk spn
269
    _ -> err
270

271 272 273 274 275
-- | Disk template choices.
optComplDiskTemplate :: OptCompletion
optComplDiskTemplate = OptComplChoices $
                       map diskTemplateToRaw [minBound..maxBound]

276 277
-- * Command line options

278
oDataFile :: OptType
279 280 281 282 283
oDataFile =
  (Option "t" ["text-data"]
   (ReqArg (\ f o -> Ok o { optDataFile = Just f }) "FILE")
   "the cluster data FILE",
   OptComplFile)
284

Iustin Pop's avatar
Iustin Pop committed
285
oDiskMoves :: OptType
286 287 288 289 290 291
oDiskMoves =
  (Option "" ["no-disk-moves"]
   (NoArg (\ opts -> Ok opts { optDiskMoves = False}))
   "disallow disk moves from the list of allowed instance changes,\
   \ thus allowing only the 'cheap' failover/migrate operations",
   OptComplNone)
292

293 294 295 296 297 298 299
oMonD :: OptType
oMonD =
  (Option "" ["mond"]
   (NoArg (\ opts -> Ok opts {optMonD = True}))
   "Query MonDs",
   OptComplNone)

Spyros Trigazis's avatar
Spyros Trigazis committed
300 301 302 303 304 305 306
oMonDDataFile :: OptType
oMonDDataFile =
  (Option "" ["mond-data"]
   (ReqArg (\ f opts -> Ok opts { optMonDFile = Just f }) "FILE")
   "Import data provided by MonDs from the given FILE",
   OptComplFile)

307
oDiskTemplate :: OptType
308 309 310 311 312 313
oDiskTemplate =
  (Option "" ["disk-template"]
   (reqWithConversion diskTemplateFromRaw
    (\dt opts -> Ok opts { optDiskTemplate = Just dt })
    "TEMPLATE") "select the desired disk template",
   optComplDiskTemplate)
314

315
oSpindleUse :: OptType
316 317 318 319 320 321 322 323 324
oSpindleUse =
  (Option "" ["spindle-use"]
   (reqWithConversion (tryRead "parsing spindle-use")
    (\su opts -> do
       when (su < 0) $
            fail "Invalid value of the spindle-use (expected >= 0)"
       return $ opts { optSpindleUse = Just su })
    "SPINDLES") "select how many virtual spindle instances use\
                \ [default read from cluster]",
325
   OptComplFloat)
326

327
oSelInst :: OptType
328 329 330 331 332
oSelInst =
  (Option "" ["select-instances"]
   (ReqArg (\ f opts -> Ok opts { optSelInst = sepSplit ',' f }) "INSTS")
   "only select given instances for any moves",
   OptComplManyInstances)
333

334
oInstMoves :: OptType
335 336 337 338 339 340 341
oInstMoves =
  (Option "" ["no-instance-moves"]
   (NoArg (\ opts -> Ok opts { optInstMoves = False}))
   "disallow instance (primary node) moves from the list of allowed,\
   \ instance changes, thus allowing only slower, but sometimes\
   \ safer, drbd secondary changes",
   OptComplNone)
342

Iustin Pop's avatar
Iustin Pop committed
343
oDynuFile :: OptType
344 345 346 347 348
oDynuFile =
  (Option "U" ["dynu-file"]
   (ReqArg (\ f opts -> Ok opts { optDynuFile = Just f }) "FILE")
   "Import dynamic utilisation data from the given FILE",
   OptComplFile)
349

350 351 352 353 354 355 356
oIgnoreDyn :: OptType
oIgnoreDyn =
  (Option "" ["ignore-dynu"]
   (NoArg (\ opts -> Ok opts {optIgnoreDynu = True}))
   "Ignore any dynamic utilisation information",
   OptComplNone)

Iustin Pop's avatar
Iustin Pop committed
357
oEvacMode :: OptType
358 359 360
oEvacMode =
  (Option "E" ["evac-mode"]
   (NoArg (\opts -> Ok opts { optEvacMode = True }))
361
   "enable evacuation mode, where the algorithm only moves\
362 363
   \ instances away from offline and drained nodes",
   OptComplNone)
Iustin Pop's avatar
Iustin Pop committed
364

365
oExInst :: OptType
366 367 368 369 370
oExInst =
  (Option "" ["exclude-instances"]
   (ReqArg (\ f opts -> Ok opts { optExInst = sepSplit ',' f }) "INSTS")
   "exclude given instances from any moves",
   OptComplManyInstances)
371

Iustin Pop's avatar
Iustin Pop committed
372
oExTags :: OptType
373 374 375 376 377
oExTags =
  (Option "" ["exclusion-tags"]
   (ReqArg (\ f opts -> Ok opts { optExTags = Just $ sepSplit ',' f })
    "TAG,...") "Enable instance exclusion based on given tag prefix",
   OptComplString)
378

379
oExecJobs :: OptType
380 381 382 383 384 385
oExecJobs =
  (Option "X" ["exec"]
   (NoArg (\ opts -> Ok opts { optExecJobs = True}))
   "execute the suggested moves via Luxi (only available when using\
   \ it for data gathering)",
   OptComplNone)
386

387 388 389 390 391 392 393 394
oForce :: OptType
oForce =
  (Option "f" ["force"]
   (NoArg (\ opts -> Ok opts {optForce = True}))
   "force the execution of this program, even if warnings would\
   \ otherwise prevent it",
   OptComplNone)

395 396 397 398 399 400 401
oFullEvacuation :: OptType
oFullEvacuation =
  (Option "" ["full-evacuation"]
   (NoArg (\ opts -> Ok opts { optFullEvacuation = True}))
   "fully evacuate the nodes to be rebooted",
   OptComplNone)

402
oGroup :: OptType
403 404 405
oGroup =
  (Option "G" ["group"]
   (ReqArg (\ f o -> Ok o { optGroup = Just f }) "ID")
Guido Trotter's avatar
Guido Trotter committed
406
   "the target node group (name or UUID)",
407
   OptComplOneGroup)
408

409
oIAllocSrc :: OptType
410 411 412 413 414
oIAllocSrc =
  (Option "I" ["ialloc-src"]
   (ReqArg (\ f opts -> Ok opts { optIAllocSrc = Just f }) "FILE")
   "Specify an iallocator spec as the cluster data source",
   OptComplFile)
415

416 417 418 419 420 421 422
oIgnoreNonRedundant :: OptType
oIgnoreNonRedundant =
  (Option "" ["ignore-non-redundant"]
   (NoArg (\ opts -> Ok opts { optIgnoreNonRedundant = True }))
    "Pretend that there are no non-redundant instances in the cluster",
    OptComplNone)

423 424 425 426 427 428 429 430 431
oJobDelay :: OptType
oJobDelay =
  (Option "" ["job-delay"]
   (reqWithConversion (tryRead "job delay")
    (\d opts -> Ok opts { optJobDelay = d }) "SECONDS")
   "insert this much delay before the execution of repair jobs\
   \ to allow the tool to continue processing instances",
   OptComplFloat)

Iustin Pop's avatar
Iustin Pop committed
432 433
genOLuxiSocket :: String -> OptType
genOLuxiSocket defSocket =
434 435
  (Option "L" ["luxi"]
   (OptArg ((\ f opts -> Ok opts { optLuxi = Just f }) .
Iustin Pop's avatar
Iustin Pop committed
436 437 438
            fromMaybe defSocket) "SOCKET")
   ("collect data via Luxi, optionally using the given SOCKET path [" ++
    defSocket ++ "]"),
439
   OptComplFile)
440

Iustin Pop's avatar
Iustin Pop committed
441
oLuxiSocket :: IO OptType
Iustin Pop's avatar
Iustin Pop committed
442
oLuxiSocket = liftM genOLuxiSocket Path.defaultLuxiSocket
Iustin Pop's avatar
Iustin Pop committed
443

444
oMachineReadable :: OptType
445 446 447 448 449 450 451
oMachineReadable =
  (Option "" ["machine-readable"]
   (OptArg (\ f opts -> do
              flag <- parseYesNo True f
              return $ opts { optMachineReadable = flag }) "CHOICE")
   "enable machine readable output (pass either 'yes' or 'no' to\
   \ explicitly control the flag, or without an argument defaults to\
452
   \ yes)",
453
   optComplYesNo)
454

455
oMaxCpu :: OptType
456 457 458 459 460 461 462 463 464
oMaxCpu =
  (Option "" ["max-cpu"]
   (reqWithConversion (tryRead "parsing max-cpu")
    (\mcpu opts -> do
       when (mcpu <= 0) $
            fail "Invalid value of the max-cpu ratio, expected >0"
       return $ opts { optMcpu = Just mcpu }) "RATIO")
   "maximum virtual-to-physical cpu ratio for nodes (from 0\
   \ upwards) [default read from cluster]",
465
   OptComplFloat)
466

Iustin Pop's avatar
Iustin Pop committed
467
oMaxSolLength :: OptType
468 469 470 471
oMaxSolLength =
  (Option "l" ["max-length"]
   (reqWithConversion (tryRead "max solution length")
    (\i opts -> Ok opts { optMaxLength = i }) "N")
472 473
   "cap the solution at this many balancing or allocation\
   \ rounds (useful for very unbalanced clusters or empty\
474
   \ clusters)",
475
   OptComplInteger)
Iustin Pop's avatar
Iustin Pop committed
476

477
oMinDisk :: OptType
478 479 480 481 482
oMinDisk =
  (Option "" ["min-disk"]
   (reqWithConversion (tryRead "min free disk space")
    (\n opts -> Ok opts { optMdsk = n }) "RATIO")
   "minimum free disk space for nodes (between 0 and 1) [0]",
483
   OptComplFloat)
484

485
oMinGain :: OptType
486 487 488 489 490
oMinGain =
  (Option "g" ["min-gain"]
   (reqWithConversion (tryRead "min gain")
    (\g opts -> Ok opts { optMinGain = g }) "DELTA")
   "minimum gain to aim for in a balancing step before giving up",
491
   OptComplFloat)
492 493

oMinGainLim :: OptType
494 495 496 497 498
oMinGainLim =
  (Option "" ["min-gain-limit"]
   (reqWithConversion (tryRead "min gain limit")
    (\g opts -> Ok opts { optMinGainLim = g }) "SCORE")
   "minimum cluster score for which we start checking the min-gain",
499
   OptComplFloat)
500

Iustin Pop's avatar
Iustin Pop committed
501
oMinScore :: OptType
502 503 504 505 506
oMinScore =
  (Option "e" ["min-score"]
   (reqWithConversion (tryRead "min score")
    (\e opts -> Ok opts { optMinScore = e }) "EPSILON")
   "mininum score to aim for",
507
   OptComplFloat)
508

Iustin Pop's avatar
Iustin Pop committed
509
oNoHeaders :: OptType
510 511 512 513 514
oNoHeaders =
  (Option "" ["no-headers"]
   (NoArg (\ opts -> Ok opts { optNoHeaders = True }))
   "do not show a header line",
   OptComplNone)
515

516
oNoSimulation :: OptType
517 518 519 520 521
oNoSimulation =
  (Option "" ["no-simulation"]
   (NoArg (\opts -> Ok opts {optNoSimulation = True}))
   "do not perform rebalancing simulation",
   OptComplNone)
522

Iustin Pop's avatar
Iustin Pop committed
523
oNodeSim :: OptType
524 525 526 527 528 529
oNodeSim =
  (Option "" ["simulate"]
   (ReqArg (\ f o -> Ok o { optNodeSim = f:optNodeSim o }) "SPEC")
   "simulate an empty cluster, given as\
   \ 'alloc_policy,num_nodes,disk,ram,cpu'",
   OptComplString)
Iustin Pop's avatar
Iustin Pop committed
530

531 532 533 534 535 536 537
oNodeTags :: OptType
oNodeTags =
  (Option "" ["node-tags"]
   (ReqArg (\ f opts -> Ok opts { optNodeTags = Just $ sepSplit ',' f })
    "TAG,...") "Restrict to nodes with the given tags",
   OptComplString)
     
538 539 540 541 542 543 544 545
oOfflineMaintenance :: OptType
oOfflineMaintenance =
  (Option "" ["offline-maintenance"]
   (NoArg (\ opts -> Ok opts {optOfflineMaintenance = True}))
   "Schedule offline maintenance, i.e., pretend that all instance are\
   \ offline.",
   OptComplNone)

Iustin Pop's avatar
Iustin Pop committed
546
oOfflineNode :: OptType
547 548 549 550 551
oOfflineNode =
  (Option "O" ["offline"]
   (ReqArg (\ n o -> Ok o { optOffline = n:optOffline o }) "NODE")
   "set node as offline",
   OptComplOneNode)
Iustin Pop's avatar
Iustin Pop committed
552

553 554 555 556 557 558 559
oOneStepOnly :: OptType
oOneStepOnly =
  (Option "" ["one-step-only"]
   (NoArg (\ opts -> Ok opts {optOneStepOnly = True}))
   "Only do the first step",
   OptComplNone)

Iustin Pop's avatar
Iustin Pop committed
560
oOutputDir :: OptType
561 562 563 564 565
oOutputDir =
  (Option "d" ["output-dir"]
   (ReqArg (\ d opts -> Ok opts { optOutPath = d }) "PATH")
   "directory in which to write output files",
   OptComplDir)
Iustin Pop's avatar
Iustin Pop committed
566 567

oPrintCommands :: OptType
568 569 570 571 572 573 574 575 576
oPrintCommands =
  (Option "C" ["print-commands"]
   (OptArg ((\ f opts -> Ok opts { optShowCmds = Just f }) .
            fromMaybe "-")
    "FILE")
   "print the ganeti command list for reaching the solution,\
   \ if an argument is passed then write the commands to a\
   \ file named as such",
   OptComplNone)
Iustin Pop's avatar
Iustin Pop committed
577 578

oPrintInsts :: OptType
579 580 581 582 583
oPrintInsts =
  (Option "" ["print-instances"]
   (NoArg (\ opts -> Ok opts { optShowInsts = True }))
   "print the final instance map",
   OptComplNone)
Iustin Pop's avatar
Iustin Pop committed
584

585 586 587 588 589 590 591
oPrintMoves :: OptType
oPrintMoves =
  (Option "" ["print-moves"]
   (NoArg (\ opts -> Ok opts { optPrintMoves = True }))
   "print the moves of the instances",
   OptComplNone)

Iustin Pop's avatar
Iustin Pop committed
592
oPrintNodes :: OptType
593 594 595 596 597 598 599 600 601 602 603
oPrintNodes =
  (Option "p" ["print-nodes"]
   (OptArg ((\ f opts ->
               let (prefix, realf) = case f of
                                       '+':rest -> (["+"], rest)
                                       _ -> ([], f)
                   splitted = prefix ++ sepSplit ',' realf
               in Ok opts { optShowNodes = Just splitted }) .
            fromMaybe []) "FIELDS")
   "print the final node list",
   OptComplNone)
Iustin Pop's avatar
Iustin Pop committed
604 605

oQuiet :: OptType
606 607 608 609 610
oQuiet =
  (Option "q" ["quiet"]
   (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts - 1 }))
   "decrease the verbosity level",
   OptComplNone)
Iustin Pop's avatar
Iustin Pop committed
611 612

oRapiMaster :: OptType
613 614 615 616 617
oRapiMaster =
  (Option "m" ["master"]
   (ReqArg (\ m opts -> Ok opts { optMaster = m }) "ADDRESS")
   "collect data via RAPI at the given ADDRESS",
   OptComplHost)
Iustin Pop's avatar
Iustin Pop committed
618

Iustin Pop's avatar
Iustin Pop committed
619
oSaveCluster :: OptType
620 621 622 623 624
oSaveCluster =
  (Option "S" ["save"]
   (ReqArg (\ f opts -> Ok opts { optSaveCluster = Just f }) "FILE")
   "Save cluster state at the end of the processing to FILE",
   OptComplNone)
Iustin Pop's avatar
Iustin Pop committed
625

626 627 628 629 630 631 632
oSkipNonRedundant :: OptType
oSkipNonRedundant =
  (Option "" ["skip-non-redundant"]
   (NoArg (\ opts -> Ok opts { optSkipNonRedundant = True }))
    "Skip nodes that host a non-redundant instance",
    OptComplNone)

633
oStdSpec :: OptType
634 635 636 637 638 639 640 641
oStdSpec =
  (Option "" ["standard-alloc"]
   (ReqArg (\ inp opts -> do
              tspec <- parseISpecString "standard" inp
              return $ opts { optStdSpec = Just tspec } )
    "STDSPEC")
   "enable standard specs allocation, given as 'disk,ram,cpu'",
   OptComplString)
642

643 644 645 646 647 648 649 650 651
oTargetResources :: OptType
oTargetResources =
  (Option "" ["target-resources"]
   (reqWithConversion (tryRead "target resources")
    (\d opts -> Ok opts { optTargetResources = d}) "FACTOR")
   "target resources to be left on each node after squeezing in\
   \ multiples of the standard allocation",
   OptComplFloat)

652
oTieredSpec :: OptType
653 654 655 656 657 658 659 660
oTieredSpec =
  (Option "" ["tiered-alloc"]
   (ReqArg (\ inp opts -> do
              tspec <- parseISpecString "tiered" inp
              return $ opts { optTieredSpec = Just tspec } )
    "TSPEC")
   "enable tiered specs allocation, given as 'disk,ram,cpu'",
   OptComplString)
661

Iustin Pop's avatar
Iustin Pop committed
662
oVerbose :: OptType
663 664 665 666 667
oVerbose =
  (Option "v" ["verbose"]
   (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts + 1 }))
   "increase the verbosity level",
   OptComplNone)
668

669 670 671 672 673 674 675 676 677
oPriority :: OptType
oPriority =
  (Option "" ["priority"]
   (ReqArg (\ inp opts -> do
              prio <- parseSubmitPriority inp
              Ok opts { optPriority = Just prio }) "PRIO")
   "set the priority of submitted jobs",
    OptComplChoices (map fmtSubmitPriority [minBound..maxBound]))

678 679 680 681
-- | Generic options.
genericOpts :: [GenericOptType Options]
genericOpts =  [ oShowVer
               , oShowHelp
682
               , oShowComp
683 684
               ]

685 686
-- * Functions

Iustin Pop's avatar
Iustin Pop committed
687
-- | Wrapper over 'Common.parseOpts' with our custom options.
688 689 690
parseOpts :: [String]               -- ^ The command line arguments
          -> String                 -- ^ The program name
          -> [OptType]              -- ^ The supported command line options
691
          -> [ArgCompletion]        -- ^ The supported command line arguments
692 693
          -> IO (Options, [String]) -- ^ The resulting options and leftover
                                    -- arguments
Iustin Pop's avatar
Iustin Pop committed
694 695
parseOpts = Common.parseOpts defaultOptions

696

Iustin Pop's avatar
Iustin Pop committed
697
-- | A shell script template for autogenerated scripts.
698 699
shTemplate :: String
shTemplate =
Iustin Pop's avatar
Iustin Pop committed
700 701 702 703 704 705 706 707 708 709
  printf "#!/bin/sh\n\n\
         \# Auto-generated script for executing cluster rebalancing\n\n\
         \# To stop, touch the file /tmp/stop-htools\n\n\
         \set -e\n\n\
         \check() {\n\
         \  if [ -f /tmp/stop-htools ]; then\n\
         \    echo 'Stop requested, exiting'\n\
         \    exit 0\n\
         \  fi\n\
         \}\n\n"
710 711 712 713 714 715 716 717 718 719 720

-- | Optionally print the node list.
maybePrintNodes :: Maybe [String]       -- ^ The field list
                -> String               -- ^ Informational message
                -> ([String] -> String) -- ^ Function to generate the listing
                -> IO ()
maybePrintNodes Nothing _ _ = return ()
maybePrintNodes (Just fields) msg fn = do
  hPutStrLn stderr ""
  hPutStrLn stderr (msg ++ " status:")
  hPutStrLn stderr $ fn fields
721 722 723 724 725 726 727 728 729 730 731

-- | Optionally print the instance list.
maybePrintInsts :: Bool   -- ^ Whether to print the instance list
                -> String -- ^ Type of the instance map (e.g. initial)
                -> String -- ^ The instance data
                -> IO ()
maybePrintInsts do_print msg instdata =
  when do_print $ do
    hPutStrLn stderr ""
    hPutStrLn stderr $ msg ++ " instance map:"
    hPutStr stderr instdata
732 733 734 735 736 737 738 739 740

-- | Function to display warning messages from parsing the cluster
-- state.
maybeShowWarnings :: [String] -- ^ The warning messages
                  -> IO ()
maybeShowWarnings fix_msgs =
  unless (null fix_msgs) $ do
    hPutStrLn stderr "Warning: cluster has inconsistent data:"
    hPutStrLn stderr . unlines . map (printf "  - %s") $ fix_msgs
Iustin Pop's avatar
Iustin Pop committed
741

742
-- | Format a list of key, value as a shell fragment.
743 744 745
printKeys :: String              -- ^ Prefix to printed variables
          -> [(String, String)]  -- ^ List of (key, value) pairs to be printed
          -> IO ()
Iustin Pop's avatar
Iustin Pop committed
746 747 748
printKeys prefix =
  mapM_ (\(k, v) ->
           printf "%s_%s=%s\n" prefix (map toUpper k) (ensureQuoted v))
749 750

-- | Prints the final @OK@ marker in machine readable output.
751
printFinal :: String    -- ^ Prefix to printed variable
Iustin Pop's avatar
Iustin Pop committed
752 753
           -> Bool      -- ^ Whether output should be machine readable;
                        -- note: if not, there is nothing to print
754
           -> IO ()
755 756 757 758 759 760
printFinal prefix True =
  -- this should be the final entry
  printKeys prefix [("OK", "1")]

printFinal _ False = return ()

761 762 763 764 765 766 767
-- | Potentially set the node as offline based on passed offline list.
setNodeOffline :: [Ndx] -> Node.Node -> Node.Node
setNodeOffline offline_indices n =
  if Node.idx n `elem` offline_indices
    then Node.setOffline n True
    else n

Iustin Pop's avatar
Iustin Pop committed
768 769 770 771 772 773 774 775 776 777 778 779 780 781
-- | Set node properties based on command line options.
setNodeStatus :: Options -> Node.List -> IO Node.List
setNodeStatus opts fixed_nl = do
  let offline_passed = optOffline opts
      all_nodes = Container.elems fixed_nl
      offline_lkp = map (lookupName (map Node.name all_nodes)) offline_passed
      offline_wrong = filter (not . goodLookupResult) offline_lkp
      offline_names = map lrContent offline_lkp
      offline_indices = map Node.idx $
                        filter (\n -> Node.name n `elem` offline_names)
                               all_nodes
      m_cpu = optMcpu opts
      m_dsk = optMdsk opts

Iustin Pop's avatar
Iustin Pop committed
782
  unless (null offline_wrong) .
Iustin Pop's avatar
Iustin Pop committed
783 784
         exitErr $ printf "wrong node name(s) set as offline: %s\n"
                   (commaJoin (map lrContent offline_wrong))
785 786 787 788 789 790 791
  let setMCpuFn = case m_cpu of
                    Nothing -> id
                    Just new_mcpu -> flip Node.setMcpu new_mcpu
  let nm = Container.map (setNodeOffline offline_indices .
                          flip Node.setMdsk m_dsk .
                          setMCpuFn) fixed_nl
  return nm