Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / HTools / CLI.hs @ 9131274c

History | View | Annotate | Download (26.5 kB)

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
  , maybeSaveCommands
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
  , oMonD
53
  , oMonDDataFile
54
  , oEvacMode
55
  , oExInst
56
  , oExTags
57
  , oExecJobs
58
  , oForce
59
  , oFullEvacuation
60
  , oGroup
61
  , oIAllocSrc
62
  , oIgnoreDyn
63
  , oIgnoreNonRedundant
64
  , oInstMoves
65
  , oJobDelay
66
  , genOLuxiSocket
67
  , oLuxiSocket
68
  , oMachineReadable
69
  , oMaxCpu
70
  , oMaxSolLength
71
  , oMinDisk
72
  , oMinGain
73
  , oMinGainLim
74
  , oMinResources
75
  , oMinScore
76
  , oNoHeaders
77
  , oNoSimulation
78
  , oNodeSim
79
  , oNodeTags
80
  , oOfflineMaintenance
81
  , oOfflineNode
82
  , oOneStepOnly
83
  , oOutputDir
84
  , oPrintCommands
85
  , oPrintInsts
86
  , oPrintMoves
87
  , oPrintNodes
88
  , oQuiet
89
  , oRapiMaster
90
  , oSaveCluster
91
  , oSelInst
92
  , oShowHelp
93
  , oShowVer
94
  , oShowComp
95
  , oSkipNonRedundant
96
  , oStdSpec
97
  , oTargetResources
98
  , oTieredSpec
99
  , oVerbose
100
  , oPriority
101
  , genericOpts
102
  ) where
103

    
104
import Control.Monad
105
import Data.Char (toUpper)
106
import Data.Maybe (fromMaybe)
107
import System.Console.GetOpt
108
import System.IO
109
import Text.Printf (printf)
110

    
111
import qualified Ganeti.HTools.Container as Container
112
import qualified Ganeti.HTools.Node as Node
113
import qualified Ganeti.Path as Path
114
import Ganeti.HTools.Types
115
import Ganeti.BasicTypes
116
import Ganeti.Common as Common
117
import Ganeti.Types
118
import Ganeti.Utils
119

    
120
-- * Data types
121

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

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

    
240
-- | Abbreviation for the option type.
241
type OptType = GenericOptType Options
242

    
243
instance StandardOptions Options where
244
  helpRequested = optShowHelp
245
  verRequested  = optShowVer
246
  compRequested = optShowComp
247
  requestHelp o = o { optShowHelp = True }
248
  requestVer  o = o { optShowVer  = True }
249
  requestComp o = o { optShowComp = True }
250

    
251
-- * Helper functions
252

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

    
275
-- | Disk template choices.
276
optComplDiskTemplate :: OptCompletion
277
optComplDiskTemplate = OptComplChoices $
278
                       map diskTemplateToRaw [minBound..maxBound]
279

    
280
-- * Command line options
281

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

    
289
oDiskMoves :: OptType
290
oDiskMoves =
291
  (Option "" ["no-disk-moves"]
292
   (NoArg (\ opts -> Ok opts { optDiskMoves = False}))
293
   "disallow disk moves from the list of allowed instance changes,\
294
   \ thus allowing only the 'cheap' failover/migrate operations",
295
   OptComplNone)
296

    
297
oMonD :: OptType
298
oMonD =
299
  (Option "" ["mond"]
300
   (OptArg (\ f opts -> do
301
              flag <- parseYesNo True f
302
              return $ opts { optMonD = flag }) "CHOICE")
303
   "pass either 'yes' or 'no' to query all monDs",
304
   optComplYesNo)
305

    
306
oMonDDataFile :: OptType
307
oMonDDataFile =
308
  (Option "" ["mond-data"]
309
   (ReqArg (\ f opts -> Ok opts { optMonDFile = Just f }) "FILE")
310
   "Import data provided by MonDs from the given FILE",
311
   OptComplFile)
312

    
313
oDiskTemplate :: OptType
314
oDiskTemplate =
315
  (Option "" ["disk-template"]
316
   (reqWithConversion diskTemplateFromRaw
317
    (\dt opts -> Ok opts { optDiskTemplate = Just dt })
318
    "TEMPLATE") "select the desired disk template",
319
   optComplDiskTemplate)
320

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

    
333
oSelInst :: OptType
334
oSelInst =
335
  (Option "" ["select-instances"]
336
   (ReqArg (\ f opts -> Ok opts { optSelInst = sepSplit ',' f }) "INSTS")
337
   "only select given instances for any moves",
338
   OptComplManyInstances)
339

    
340
oInstMoves :: OptType
341
oInstMoves =
342
  (Option "" ["no-instance-moves"]
343
   (NoArg (\ opts -> Ok opts { optInstMoves = False}))
344
   "disallow instance (primary node) moves from the list of allowed,\
345
   \ instance changes, thus allowing only slower, but sometimes\
346
   \ safer, drbd secondary changes",
347
   OptComplNone)
348

    
349
oDynuFile :: OptType
350
oDynuFile =
351
  (Option "U" ["dynu-file"]
352
   (ReqArg (\ f opts -> Ok opts { optDynuFile = Just f }) "FILE")
353
   "Import dynamic utilisation data from the given FILE",
354
   OptComplFile)
355

    
356
oIgnoreDyn :: OptType
357
oIgnoreDyn =
358
  (Option "" ["ignore-dynu"]
359
   (NoArg (\ opts -> Ok opts {optIgnoreDynu = True}))
360
   "Ignore any dynamic utilisation information",
361
   OptComplNone)
362

    
363
oEvacMode :: OptType
364
oEvacMode =
365
  (Option "E" ["evac-mode"]
366
   (NoArg (\opts -> Ok opts { optEvacMode = True }))
367
   "enable evacuation mode, where the algorithm only moves\
368
   \ instances away from offline and drained nodes",
369
   OptComplNone)
370

    
371
oExInst :: OptType
372
oExInst =
373
  (Option "" ["exclude-instances"]
374
   (ReqArg (\ f opts -> Ok opts { optExInst = sepSplit ',' f }) "INSTS")
375
   "exclude given instances from any moves",
376
   OptComplManyInstances)
377

    
378
oExTags :: OptType
379
oExTags =
380
  (Option "" ["exclusion-tags"]
381
   (ReqArg (\ f opts -> Ok opts { optExTags = Just $ sepSplit ',' f })
382
    "TAG,...") "Enable instance exclusion based on given tag prefix",
383
   OptComplString)
384

    
385
oExecJobs :: OptType
386
oExecJobs =
387
  (Option "X" ["exec"]
388
   (NoArg (\ opts -> Ok opts { optExecJobs = True}))
389
   "execute the suggested moves via Luxi (only available when using\
390
   \ it for data gathering)",
391
   OptComplNone)
392

    
393
oForce :: OptType
394
oForce =
395
  (Option "f" ["force"]
396
   (NoArg (\ opts -> Ok opts {optForce = True}))
397
   "force the execution of this program, even if warnings would\
398
   \ otherwise prevent it",
399
   OptComplNone)
400

    
401
oFullEvacuation :: OptType
402
oFullEvacuation =
403
  (Option "" ["full-evacuation"]
404
   (NoArg (\ opts -> Ok opts { optFullEvacuation = True}))
405
   "fully evacuate the nodes to be rebooted",
406
   OptComplNone)
407

    
408
oGroup :: OptType
409
oGroup =
410
  (Option "G" ["group"]
411
   (ReqArg (\ f o -> Ok o { optGroup = Just f }) "ID")
412
   "the target node group (name or UUID)",
413
   OptComplOneGroup)
414

    
415
oIAllocSrc :: OptType
416
oIAllocSrc =
417
  (Option "I" ["ialloc-src"]
418
   (ReqArg (\ f opts -> Ok opts { optIAllocSrc = Just f }) "FILE")
419
   "Specify an iallocator spec as the cluster data source",
420
   OptComplFile)
421

    
422
oIgnoreNonRedundant :: OptType
423
oIgnoreNonRedundant =
424
  (Option "" ["ignore-non-redundant"]
425
   (NoArg (\ opts -> Ok opts { optIgnoreNonRedundant = True }))
426
    "Pretend that there are no non-redundant instances in the cluster",
427
    OptComplNone)
428

    
429
oJobDelay :: OptType
430
oJobDelay =
431
  (Option "" ["job-delay"]
432
   (reqWithConversion (tryRead "job delay")
433
    (\d opts -> Ok opts { optJobDelay = d }) "SECONDS")
434
   "insert this much delay before the execution of repair jobs\
435
   \ to allow the tool to continue processing instances",
436
   OptComplFloat)
437

    
438
genOLuxiSocket :: String -> OptType
439
genOLuxiSocket defSocket =
440
  (Option "L" ["luxi"]
441
   (OptArg ((\ f opts -> Ok opts { optLuxi = Just f }) .
442
            fromMaybe defSocket) "SOCKET")
443
   ("collect data via Luxi, optionally using the given SOCKET path [" ++
444
    defSocket ++ "]"),
445
   OptComplFile)
446

    
447
oLuxiSocket :: IO OptType
448
oLuxiSocket = liftM genOLuxiSocket Path.defaultMasterSocket
449

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

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

    
473
oMaxSolLength :: OptType
474
oMaxSolLength =
475
  (Option "l" ["max-length"]
476
   (reqWithConversion (tryRead "max solution length")
477
    (\i opts -> Ok opts { optMaxLength = i }) "N")
478
   "cap the solution at this many balancing or allocation\
479
   \ rounds (useful for very unbalanced clusters or empty\
480
   \ clusters)",
481
   OptComplInteger)
482

    
483
oMinDisk :: OptType
484
oMinDisk =
485
  (Option "" ["min-disk"]
486
   (reqWithConversion (tryRead "min free disk space")
487
    (\n opts -> Ok opts { optMdsk = n }) "RATIO")
488
   "minimum free disk space for nodes (between 0 and 1) [0]",
489
   OptComplFloat)
490

    
491
oMinGain :: OptType
492
oMinGain =
493
  (Option "g" ["min-gain"]
494
   (reqWithConversion (tryRead "min gain")
495
    (\g opts -> Ok opts { optMinGain = g }) "DELTA")
496
   "minimum gain to aim for in a balancing step before giving up",
497
   OptComplFloat)
498

    
499
oMinGainLim :: OptType
500
oMinGainLim =
501
  (Option "" ["min-gain-limit"]
502
   (reqWithConversion (tryRead "min gain limit")
503
    (\g opts -> Ok opts { optMinGainLim = g }) "SCORE")
504
   "minimum cluster score for which we start checking the min-gain",
505
   OptComplFloat)
506

    
507
oMinResources :: OptType
508
oMinResources =
509
  (Option "" ["minimal-resources"]
510
   (reqWithConversion (tryRead "minimal resources")
511
    (\d opts -> Ok opts { optMinResources = d}) "FACTOR")
512
   "minimal resources to be present on each in multiples of\ 
513
   \ the standard allocation for not onlining standby nodes",
514
   OptComplFloat)
515

    
516
oMinScore :: OptType
517
oMinScore =
518
  (Option "e" ["min-score"]
519
   (reqWithConversion (tryRead "min score")
520
    (\e opts -> Ok opts { optMinScore = e }) "EPSILON")
521
   "mininum score to aim for",
522
   OptComplFloat)
523

    
524
oNoHeaders :: OptType
525
oNoHeaders =
526
  (Option "" ["no-headers"]
527
   (NoArg (\ opts -> Ok opts { optNoHeaders = True }))
528
   "do not show a header line",
529
   OptComplNone)
530

    
531
oNoSimulation :: OptType
532
oNoSimulation =
533
  (Option "" ["no-simulation"]
534
   (NoArg (\opts -> Ok opts {optNoSimulation = True}))
535
   "do not perform rebalancing simulation",
536
   OptComplNone)
537

    
538
oNodeSim :: OptType
539
oNodeSim =
540
  (Option "" ["simulate"]
541
   (ReqArg (\ f o -> Ok o { optNodeSim = f:optNodeSim o }) "SPEC")
542
   "simulate an empty cluster, given as\
543
   \ 'alloc_policy,num_nodes,disk,ram,cpu'",
544
   OptComplString)
545

    
546
oNodeTags :: OptType
547
oNodeTags =
548
  (Option "" ["node-tags"]
549
   (ReqArg (\ f opts -> Ok opts { optNodeTags = Just $ sepSplit ',' f })
550
    "TAG,...") "Restrict to nodes with the given tags",
551
   OptComplString)
552
     
553
oOfflineMaintenance :: OptType
554
oOfflineMaintenance =
555
  (Option "" ["offline-maintenance"]
556
   (NoArg (\ opts -> Ok opts {optOfflineMaintenance = True}))
557
   "Schedule offline maintenance, i.e., pretend that all instance are\
558
   \ offline.",
559
   OptComplNone)
560

    
561
oOfflineNode :: OptType
562
oOfflineNode =
563
  (Option "O" ["offline"]
564
   (ReqArg (\ n o -> Ok o { optOffline = n:optOffline o }) "NODE")
565
   "set node as offline",
566
   OptComplOneNode)
567

    
568
oOneStepOnly :: OptType
569
oOneStepOnly =
570
  (Option "" ["one-step-only"]
571
   (NoArg (\ opts -> Ok opts {optOneStepOnly = True}))
572
   "Only do the first step",
573
   OptComplNone)
574

    
575
oOutputDir :: OptType
576
oOutputDir =
577
  (Option "d" ["output-dir"]
578
   (ReqArg (\ d opts -> Ok opts { optOutPath = d }) "PATH")
579
   "directory in which to write output files",
580
   OptComplDir)
581

    
582
oPrintCommands :: OptType
583
oPrintCommands =
584
  (Option "C" ["print-commands"]
585
   (OptArg ((\ f opts -> Ok opts { optShowCmds = Just f }) .
586
            fromMaybe "-")
587
    "FILE")
588
   "print the ganeti command list for reaching the solution,\
589
   \ if an argument is passed then write the commands to a\
590
   \ file named as such",
591
   OptComplNone)
592

    
593
oPrintInsts :: OptType
594
oPrintInsts =
595
  (Option "" ["print-instances"]
596
   (NoArg (\ opts -> Ok opts { optShowInsts = True }))
597
   "print the final instance map",
598
   OptComplNone)
599

    
600
oPrintMoves :: OptType
601
oPrintMoves =
602
  (Option "" ["print-moves"]
603
   (NoArg (\ opts -> Ok opts { optPrintMoves = True }))
604
   "print the moves of the instances",
605
   OptComplNone)
606

    
607
oPrintNodes :: OptType
608
oPrintNodes =
609
  (Option "p" ["print-nodes"]
610
   (OptArg ((\ f opts ->
611
               let (prefix, realf) = case f of
612
                                       '+':rest -> (["+"], rest)
613
                                       _ -> ([], f)
614
                   splitted = prefix ++ sepSplit ',' realf
615
               in Ok opts { optShowNodes = Just splitted }) .
616
            fromMaybe []) "FIELDS")
617
   "print the final node list",
618
   OptComplNone)
619

    
620
oQuiet :: OptType
621
oQuiet =
622
  (Option "q" ["quiet"]
623
   (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts - 1 }))
624
   "decrease the verbosity level",
625
   OptComplNone)
626

    
627
oRapiMaster :: OptType
628
oRapiMaster =
629
  (Option "m" ["master"]
630
   (ReqArg (\ m opts -> Ok opts { optMaster = m }) "ADDRESS")
631
   "collect data via RAPI at the given ADDRESS",
632
   OptComplHost)
633

    
634
oSaveCluster :: OptType
635
oSaveCluster =
636
  (Option "S" ["save"]
637
   (ReqArg (\ f opts -> Ok opts { optSaveCluster = Just f }) "FILE")
638
   "Save cluster state at the end of the processing to FILE",
639
   OptComplNone)
640

    
641
oSkipNonRedundant :: OptType
642
oSkipNonRedundant =
643
  (Option "" ["skip-non-redundant"]
644
   (NoArg (\ opts -> Ok opts { optSkipNonRedundant = True }))
645
    "Skip nodes that host a non-redundant instance",
646
    OptComplNone)
647

    
648
oStdSpec :: OptType
649
oStdSpec =
650
  (Option "" ["standard-alloc"]
651
   (ReqArg (\ inp opts -> do
652
              tspec <- parseISpecString "standard" inp
653
              return $ opts { optStdSpec = Just tspec } )
654
    "STDSPEC")
655
   "enable standard specs allocation, given as 'disk,ram,cpu'",
656
   OptComplString)
657

    
658
oTargetResources :: OptType
659
oTargetResources =
660
  (Option "" ["target-resources"]
661
   (reqWithConversion (tryRead "target resources")
662
    (\d opts -> Ok opts { optTargetResources = d}) "FACTOR")
663
   "target resources to be left on each node after squeezing in\
664
   \ multiples of the standard allocation",
665
   OptComplFloat)
666

    
667
oTieredSpec :: OptType
668
oTieredSpec =
669
  (Option "" ["tiered-alloc"]
670
   (ReqArg (\ inp opts -> do
671
              tspec <- parseISpecString "tiered" inp
672
              return $ opts { optTieredSpec = Just tspec } )
673
    "TSPEC")
674
   "enable tiered specs allocation, given as 'disk,ram,cpu'",
675
   OptComplString)
676

    
677
oVerbose :: OptType
678
oVerbose =
679
  (Option "v" ["verbose"]
680
   (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts + 1 }))
681
   "increase the verbosity level",
682
   OptComplNone)
683

    
684
oPriority :: OptType
685
oPriority =
686
  (Option "" ["priority"]
687
   (ReqArg (\ inp opts -> do
688
              prio <- parseSubmitPriority inp
689
              Ok opts { optPriority = Just prio }) "PRIO")
690
   "set the priority of submitted jobs",
691
    OptComplChoices (map fmtSubmitPriority [minBound..maxBound]))
692

    
693
-- | Generic options.
694
genericOpts :: [GenericOptType Options]
695
genericOpts =  [ oShowVer
696
               , oShowHelp
697
               , oShowComp
698
               ]
699

    
700
-- * Functions
701

    
702
-- | Wrapper over 'Common.parseOpts' with our custom options.
703
parseOpts :: [String]               -- ^ The command line arguments
704
          -> String                 -- ^ The program name
705
          -> [OptType]              -- ^ The supported command line options
706
          -> [ArgCompletion]        -- ^ The supported command line arguments
707
          -> IO (Options, [String]) -- ^ The resulting options and leftover
708
                                    -- arguments
709
parseOpts = Common.parseOpts defaultOptions
710

    
711

    
712
-- | A shell script template for autogenerated scripts.
713
shTemplate :: String
714
shTemplate =
715
  printf "#!/bin/sh\n\n\
716
         \# Auto-generated script for executing cluster rebalancing\n\n\
717
         \# To stop, touch the file /tmp/stop-htools\n\n\
718
         \set -e\n\n\
719
         \check() {\n\
720
         \  if [ -f /tmp/stop-htools ]; then\n\
721
         \    echo 'Stop requested, exiting'\n\
722
         \    exit 0\n\
723
         \  fi\n\
724
         \}\n\n"
725

    
726
-- | Optionally show or save a list of commands
727
maybeSaveCommands :: String -- ^ Informal description
728
                  -> Options
729
                  -> String -- ^ commands
730
                  -> IO ()
731
maybeSaveCommands msg opts cmds =
732
  case optShowCmds opts of
733
    Nothing -> return ()
734
    Just "-" -> do
735
      putStrLn ""
736
      putStrLn msg
737
      putStr . unlines .  map ("  " ++) . filter (/= "  check") . lines $ cmds
738
    Just out_path -> do
739
      writeFile out_path (shTemplate ++ cmds)
740
      printf "The commands have been written to file '%s'\n" out_path
741

    
742
-- | Optionally print the node list.
743
maybePrintNodes :: Maybe [String]       -- ^ The field list
744
                -> String               -- ^ Informational message
745
                -> ([String] -> String) -- ^ Function to generate the listing
746
                -> IO ()
747
maybePrintNodes Nothing _ _ = return ()
748
maybePrintNodes (Just fields) msg fn = do
749
  hPutStrLn stderr ""
750
  hPutStrLn stderr (msg ++ " status:")
751
  hPutStrLn stderr $ fn fields
752

    
753
-- | Optionally print the instance list.
754
maybePrintInsts :: Bool   -- ^ Whether to print the instance list
755
                -> String -- ^ Type of the instance map (e.g. initial)
756
                -> String -- ^ The instance data
757
                -> IO ()
758
maybePrintInsts do_print msg instdata =
759
  when do_print $ do
760
    hPutStrLn stderr ""
761
    hPutStrLn stderr $ msg ++ " instance map:"
762
    hPutStr stderr instdata
763

    
764
-- | Function to display warning messages from parsing the cluster
765
-- state.
766
maybeShowWarnings :: [String] -- ^ The warning messages
767
                  -> IO ()
768
maybeShowWarnings fix_msgs =
769
  unless (null fix_msgs) $ do
770
    hPutStrLn stderr "Warning: cluster has inconsistent data:"
771
    hPutStrLn stderr . unlines . map (printf "  - %s") $ fix_msgs
772

    
773
-- | Format a list of key, value as a shell fragment.
774
printKeys :: String              -- ^ Prefix to printed variables
775
          -> [(String, String)]  -- ^ List of (key, value) pairs to be printed
776
          -> IO ()
777
printKeys prefix =
778
  mapM_ (\(k, v) ->
779
           printf "%s_%s=%s\n" prefix (map toUpper k) (ensureQuoted v))
780

    
781
-- | Prints the final @OK@ marker in machine readable output.
782
printFinal :: String    -- ^ Prefix to printed variable
783
           -> Bool      -- ^ Whether output should be machine readable;
784
                        -- note: if not, there is nothing to print
785
           -> IO ()
786
printFinal prefix True =
787
  -- this should be the final entry
788
  printKeys prefix [("OK", "1")]
789

    
790
printFinal _ False = return ()
791

    
792
-- | Potentially set the node as offline based on passed offline list.
793
setNodeOffline :: [Ndx] -> Node.Node -> Node.Node
794
setNodeOffline offline_indices n =
795
  if Node.idx n `elem` offline_indices
796
    then Node.setOffline n True
797
    else n
798

    
799
-- | Set node properties based on command line options.
800
setNodeStatus :: Options -> Node.List -> IO Node.List
801
setNodeStatus opts fixed_nl = do
802
  let offline_passed = optOffline opts
803
      all_nodes = Container.elems fixed_nl
804
      offline_lkp = map (lookupName (map Node.name all_nodes)) offline_passed
805
      offline_wrong = filter (not . goodLookupResult) offline_lkp
806
      offline_names = map lrContent offline_lkp
807
      offline_indices = map Node.idx $
808
                        filter (\n -> Node.name n `elem` offline_names)
809
                               all_nodes
810
      m_cpu = optMcpu opts
811
      m_dsk = optMdsk opts
812

    
813
  unless (null offline_wrong) .
814
         exitErr $ printf "wrong node name(s) set as offline: %s\n"
815
                   (commaJoin (map lrContent offline_wrong))
816
  let setMCpuFn = case m_cpu of
817
                    Nothing -> id
818
                    Just new_mcpu -> flip Node.setMcpu new_mcpu
819
  let nm = Container.map (setNodeOffline offline_indices .
820
                          flip Node.setMdsk m_dsk .
821
                          setMCpuFn) fixed_nl
822
  return nm