Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / HTools / CLI.hs @ 89363f98

History | View | Annotate | Download (22.7 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
  , 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