Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / HTools / CLI.hs @ 7dbe4c72

History | View | Annotate | Download (21.3 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
  , oOfflineNode
73
  , oOutputDir
74
  , oPrintCommands
75
  , oPrintInsts
76
  , oPrintNodes
77
  , oQuiet
78
  , oRapiMaster
79
  , oSaveCluster
80
  , oSelInst
81
  , oShowHelp
82
  , oShowVer
83
  , oShowComp
84
  , oStdSpec
85
  , oTieredSpec
86
  , oVerbose
87
  , oPriority
88
  , genericOpts
89
  ) where
90

    
91
import Control.Monad
92
import Data.Char (toUpper)
93
import Data.Maybe (fromMaybe)
94
import System.Console.GetOpt
95
import System.IO
96
import Text.Printf (printf)
97

    
98
import qualified Ganeti.HTools.Container as Container
99
import qualified Ganeti.HTools.Node as Node
100
import qualified Ganeti.Path as Path
101
import Ganeti.HTools.Types
102
import Ganeti.BasicTypes
103
import Ganeti.Common as Common
104
import Ganeti.Types
105
import Ganeti.Utils
106

    
107
-- * Data types
108

    
109
-- | Command line options structure.
110
data Options = Options
111
  { optDataFile    :: Maybe FilePath -- ^ Path to the cluster data file
112
  , optDiskMoves   :: Bool           -- ^ Allow disk moves
113
  , optInstMoves   :: Bool           -- ^ Allow instance moves
114
  , optDiskTemplate :: Maybe DiskTemplate  -- ^ Override for the disk template
115
  , optSpindleUse  :: Maybe Int      -- ^ Override for the spindle usage
116
  , optDynuFile    :: Maybe FilePath -- ^ Optional file with dynamic use data
117
  , optEvacMode    :: Bool           -- ^ Enable evacuation mode
118
  , optExInst      :: [String]       -- ^ Instances to be excluded
119
  , optExTags      :: Maybe [String] -- ^ Tags to use for exclusion
120
  , optExecJobs    :: Bool           -- ^ Execute the commands via Luxi
121
  , optForce       :: Bool           -- ^ Force the execution
122
  , optGroup       :: Maybe GroupID  -- ^ The UUID of the group to process
123
  , optIAllocSrc   :: Maybe FilePath -- ^ The iallocation spec
124
  , optSelInst     :: [String]       -- ^ Instances to be excluded
125
  , optLuxi        :: Maybe FilePath -- ^ Collect data from Luxi
126
  , optJobDelay    :: Double         -- ^ Delay before executing first job
127
  , optMachineReadable :: Bool       -- ^ Output machine-readable format
128
  , optMaster      :: String         -- ^ Collect data from RAPI
129
  , optMaxLength   :: Int            -- ^ Stop after this many steps
130
  , optMcpu        :: Maybe Double   -- ^ Override max cpu ratio for nodes
131
  , optMdsk        :: Double         -- ^ Max disk usage ratio for nodes
132
  , optMinGain     :: Score          -- ^ Min gain we aim for in a step
133
  , optMinGainLim  :: Score          -- ^ Limit below which we apply mingain
134
  , optMinScore    :: Score          -- ^ The minimum score we aim for
135
  , optNoHeaders   :: Bool           -- ^ Do not show a header line
136
  , optNoSimulation :: Bool          -- ^ Skip the rebalancing dry-run
137
  , optNodeSim     :: [String]       -- ^ Cluster simulation mode
138
  , optOffline     :: [String]       -- ^ Names of offline nodes
139
  , optOutPath     :: FilePath       -- ^ Path to the output directory
140
  , optSaveCluster :: Maybe FilePath -- ^ Save cluster state to this file
141
  , optShowCmds    :: Maybe FilePath -- ^ Whether to show the command list
142
  , optShowHelp    :: Bool           -- ^ Just show the help
143
  , optShowComp    :: Bool           -- ^ Just show the completion info
144
  , optShowInsts   :: Bool           -- ^ Whether to show the instance map
145
  , optShowNodes   :: Maybe [String] -- ^ Whether to show node status
146
  , optShowVer     :: Bool           -- ^ Just show the program version
147
  , optStdSpec     :: Maybe RSpec    -- ^ Requested standard specs
148
  , optTestCount   :: Maybe Int      -- ^ Optional test count override
149
  , optTieredSpec  :: Maybe RSpec    -- ^ Requested specs for tiered mode
150
  , optReplay      :: Maybe String   -- ^ Unittests: RNG state
151
  , optVerbose     :: Int            -- ^ Verbosity level
152
  , optPriority    :: Maybe OpSubmitPriority -- ^ OpCode submit priority
153
  } deriving Show
154

    
155
-- | Default values for the command line options.
156
defaultOptions :: Options
157
defaultOptions  = Options
158
  { optDataFile    = Nothing
159
  , optDiskMoves   = True
160
  , optInstMoves   = True
161
  , optDiskTemplate = Nothing
162
  , optSpindleUse  = Nothing
163
  , optDynuFile    = Nothing
164
  , optEvacMode    = False
165
  , optExInst      = []
166
  , optExTags      = Nothing
167
  , optExecJobs    = False
168
  , optForce       = False
169
  , optGroup       = Nothing
170
  , optIAllocSrc   = Nothing
171
  , optSelInst     = []
172
  , optLuxi        = Nothing
173
  , optJobDelay    = 10
174
  , optMachineReadable = False
175
  , optMaster      = ""
176
  , optMaxLength   = -1
177
  , optMcpu        = Nothing
178
  , optMdsk        = defReservedDiskRatio
179
  , optMinGain     = 1e-2
180
  , optMinGainLim  = 1e-1
181
  , optMinScore    = 1e-9
182
  , optNoHeaders   = False
183
  , optNoSimulation = False
184
  , optNodeSim     = []
185
  , optOffline     = []
186
  , optOutPath     = "."
187
  , optSaveCluster = Nothing
188
  , optShowCmds    = Nothing
189
  , optShowHelp    = False
190
  , optShowComp    = False
191
  , optShowInsts   = False
192
  , optShowNodes   = Nothing
193
  , optShowVer     = False
194
  , optStdSpec     = Nothing
195
  , optTestCount   = Nothing
196
  , optTieredSpec  = Nothing
197
  , optReplay      = Nothing
198
  , optVerbose     = 1
199
  , optPriority    = Nothing
200
  }
201

    
202
-- | Abbreviation for the option type.
203
type OptType = GenericOptType Options
204

    
205
instance StandardOptions Options where
206
  helpRequested = optShowHelp
207
  verRequested  = optShowVer
208
  compRequested = optShowComp
209
  requestHelp o = o { optShowHelp = True }
210
  requestVer  o = o { optShowVer  = True }
211
  requestComp o = o { optShowComp = True }
212

    
213
-- * Helper functions
214

    
215
parseISpecString :: String -> String -> Result RSpec
216
parseISpecString descr inp = do
217
  let sp = sepSplit ',' inp
218
      err = Bad ("Invalid " ++ descr ++ " specification: '" ++ inp ++
219
                 "', expected disk,ram,cpu")
220
  when (length sp /= 3) err
221
  prs <- mapM (\(fn, val) -> fn val) $
222
         zip [ annotateResult (descr ++ " specs disk") . parseUnit
223
             , annotateResult (descr ++ " specs memory") . parseUnit
224
             , tryRead (descr ++ " specs cpus")
225
             ] sp
226
  case prs of
227
    [dsk, ram, cpu] -> return $ RSpec cpu ram dsk
228
    _ -> err
229

    
230
-- | Disk template choices.
231
optComplDiskTemplate :: OptCompletion
232
optComplDiskTemplate = OptComplChoices $
233
                       map diskTemplateToRaw [minBound..maxBound]
234

    
235
-- * Command line options
236

    
237
oDataFile :: OptType
238
oDataFile =
239
  (Option "t" ["text-data"]
240
   (ReqArg (\ f o -> Ok o { optDataFile = Just f }) "FILE")
241
   "the cluster data FILE",
242
   OptComplFile)
243

    
244
oDiskMoves :: OptType
245
oDiskMoves =
246
  (Option "" ["no-disk-moves"]
247
   (NoArg (\ opts -> Ok opts { optDiskMoves = False}))
248
   "disallow disk moves from the list of allowed instance changes,\
249
   \ thus allowing only the 'cheap' failover/migrate operations",
250
   OptComplNone)
251

    
252
oDiskTemplate :: OptType
253
oDiskTemplate =
254
  (Option "" ["disk-template"]
255
   (reqWithConversion diskTemplateFromRaw
256
    (\dt opts -> Ok opts { optDiskTemplate = Just dt })
257
    "TEMPLATE") "select the desired disk template",
258
   optComplDiskTemplate)
259

    
260
oSpindleUse :: OptType
261
oSpindleUse =
262
  (Option "" ["spindle-use"]
263
   (reqWithConversion (tryRead "parsing spindle-use")
264
    (\su opts -> do
265
       when (su < 0) $
266
            fail "Invalid value of the spindle-use (expected >= 0)"
267
       return $ opts { optSpindleUse = Just su })
268
    "SPINDLES") "select how many virtual spindle instances use\
269
                \ [default read from cluster]",
270
   OptComplFloat)
271

    
272
oSelInst :: OptType
273
oSelInst =
274
  (Option "" ["select-instances"]
275
   (ReqArg (\ f opts -> Ok opts { optSelInst = sepSplit ',' f }) "INSTS")
276
   "only select given instances for any moves",
277
   OptComplManyInstances)
278

    
279
oInstMoves :: OptType
280
oInstMoves =
281
  (Option "" ["no-instance-moves"]
282
   (NoArg (\ opts -> Ok opts { optInstMoves = False}))
283
   "disallow instance (primary node) moves from the list of allowed,\
284
   \ instance changes, thus allowing only slower, but sometimes\
285
   \ safer, drbd secondary changes",
286
   OptComplNone)
287

    
288
oDynuFile :: OptType
289
oDynuFile =
290
  (Option "U" ["dynu-file"]
291
   (ReqArg (\ f opts -> Ok opts { optDynuFile = Just f }) "FILE")
292
   "Import dynamic utilisation data from the given FILE",
293
   OptComplFile)
294

    
295
oEvacMode :: OptType
296
oEvacMode =
297
  (Option "E" ["evac-mode"]
298
   (NoArg (\opts -> Ok opts { optEvacMode = True }))
299
   "enable evacuation mode, where the algorithm only moves\
300
   \ instances away from offline and drained nodes",
301
   OptComplNone)
302

    
303
oExInst :: OptType
304
oExInst =
305
  (Option "" ["exclude-instances"]
306
   (ReqArg (\ f opts -> Ok opts { optExInst = sepSplit ',' f }) "INSTS")
307
   "exclude given instances from any moves",
308
   OptComplManyInstances)
309

    
310
oExTags :: OptType
311
oExTags =
312
  (Option "" ["exclusion-tags"]
313
   (ReqArg (\ f opts -> Ok opts { optExTags = Just $ sepSplit ',' f })
314
    "TAG,...") "Enable instance exclusion based on given tag prefix",
315
   OptComplString)
316

    
317
oExecJobs :: OptType
318
oExecJobs =
319
  (Option "X" ["exec"]
320
   (NoArg (\ opts -> Ok opts { optExecJobs = True}))
321
   "execute the suggested moves via Luxi (only available when using\
322
   \ it for data gathering)",
323
   OptComplNone)
324

    
325
oForce :: OptType
326
oForce =
327
  (Option "f" ["force"]
328
   (NoArg (\ opts -> Ok opts {optForce = True}))
329
   "force the execution of this program, even if warnings would\
330
   \ otherwise prevent it",
331
   OptComplNone)
332

    
333
oGroup :: OptType
334
oGroup =
335
  (Option "G" ["group"]
336
   (ReqArg (\ f o -> Ok o { optGroup = Just f }) "ID")
337
   "the target node group (name or UUID)",
338
   OptComplOneGroup)
339

    
340
oIAllocSrc :: OptType
341
oIAllocSrc =
342
  (Option "I" ["ialloc-src"]
343
   (ReqArg (\ f opts -> Ok opts { optIAllocSrc = Just f }) "FILE")
344
   "Specify an iallocator spec as the cluster data source",
345
   OptComplFile)
346

    
347
oJobDelay :: OptType
348
oJobDelay =
349
  (Option "" ["job-delay"]
350
   (reqWithConversion (tryRead "job delay")
351
    (\d opts -> Ok opts { optJobDelay = d }) "SECONDS")
352
   "insert this much delay before the execution of repair jobs\
353
   \ to allow the tool to continue processing instances",
354
   OptComplFloat)
355

    
356
genOLuxiSocket :: String -> OptType
357
genOLuxiSocket defSocket =
358
  (Option "L" ["luxi"]
359
   (OptArg ((\ f opts -> Ok opts { optLuxi = Just f }) .
360
            fromMaybe defSocket) "SOCKET")
361
   ("collect data via Luxi, optionally using the given SOCKET path [" ++
362
    defSocket ++ "]"),
363
   OptComplFile)
364

    
365
oLuxiSocket :: IO OptType
366
oLuxiSocket = liftM genOLuxiSocket Path.defaultLuxiSocket
367

    
368
oMachineReadable :: OptType
369
oMachineReadable =
370
  (Option "" ["machine-readable"]
371
   (OptArg (\ f opts -> do
372
              flag <- parseYesNo True f
373
              return $ opts { optMachineReadable = flag }) "CHOICE")
374
   "enable machine readable output (pass either 'yes' or 'no' to\
375
   \ explicitly control the flag, or without an argument defaults to\
376
   \ yes",
377
   optComplYesNo)
378

    
379
oMaxCpu :: OptType
380
oMaxCpu =
381
  (Option "" ["max-cpu"]
382
   (reqWithConversion (tryRead "parsing max-cpu")
383
    (\mcpu opts -> do
384
       when (mcpu <= 0) $
385
            fail "Invalid value of the max-cpu ratio, expected >0"
386
       return $ opts { optMcpu = Just mcpu }) "RATIO")
387
   "maximum virtual-to-physical cpu ratio for nodes (from 0\
388
   \ upwards) [default read from cluster]",
389
   OptComplFloat)
390

    
391
oMaxSolLength :: OptType
392
oMaxSolLength =
393
  (Option "l" ["max-length"]
394
   (reqWithConversion (tryRead "max solution length")
395
    (\i opts -> Ok opts { optMaxLength = i }) "N")
396
   "cap the solution at this many balancing or allocation\
397
   \ rounds (useful for very unbalanced clusters or empty\
398
   \ clusters)",
399
   OptComplInteger)
400

    
401
oMinDisk :: OptType
402
oMinDisk =
403
  (Option "" ["min-disk"]
404
   (reqWithConversion (tryRead "min free disk space")
405
    (\n opts -> Ok opts { optMdsk = n }) "RATIO")
406
   "minimum free disk space for nodes (between 0 and 1) [0]",
407
   OptComplFloat)
408

    
409
oMinGain :: OptType
410
oMinGain =
411
  (Option "g" ["min-gain"]
412
   (reqWithConversion (tryRead "min gain")
413
    (\g opts -> Ok opts { optMinGain = g }) "DELTA")
414
   "minimum gain to aim for in a balancing step before giving up",
415
   OptComplFloat)
416

    
417
oMinGainLim :: OptType
418
oMinGainLim =
419
  (Option "" ["min-gain-limit"]
420
   (reqWithConversion (tryRead "min gain limit")
421
    (\g opts -> Ok opts { optMinGainLim = g }) "SCORE")
422
   "minimum cluster score for which we start checking the min-gain",
423
   OptComplFloat)
424

    
425
oMinScore :: OptType
426
oMinScore =
427
  (Option "e" ["min-score"]
428
   (reqWithConversion (tryRead "min score")
429
    (\e opts -> Ok opts { optMinScore = e }) "EPSILON")
430
   "mininum score to aim for",
431
   OptComplFloat)
432

    
433
oNoHeaders :: OptType
434
oNoHeaders =
435
  (Option "" ["no-headers"]
436
   (NoArg (\ opts -> Ok opts { optNoHeaders = True }))
437
   "do not show a header line",
438
   OptComplNone)
439

    
440
oNoSimulation :: OptType
441
oNoSimulation =
442
  (Option "" ["no-simulation"]
443
   (NoArg (\opts -> Ok opts {optNoSimulation = True}))
444
   "do not perform rebalancing simulation",
445
   OptComplNone)
446

    
447
oNodeSim :: OptType
448
oNodeSim =
449
  (Option "" ["simulate"]
450
   (ReqArg (\ f o -> Ok o { optNodeSim = f:optNodeSim o }) "SPEC")
451
   "simulate an empty cluster, given as\
452
   \ 'alloc_policy,num_nodes,disk,ram,cpu'",
453
   OptComplString)
454

    
455
oOfflineNode :: OptType
456
oOfflineNode =
457
  (Option "O" ["offline"]
458
   (ReqArg (\ n o -> Ok o { optOffline = n:optOffline o }) "NODE")
459
   "set node as offline",
460
   OptComplOneNode)
461

    
462
oOutputDir :: OptType
463
oOutputDir =
464
  (Option "d" ["output-dir"]
465
   (ReqArg (\ d opts -> Ok opts { optOutPath = d }) "PATH")
466
   "directory in which to write output files",
467
   OptComplDir)
468

    
469
oPrintCommands :: OptType
470
oPrintCommands =
471
  (Option "C" ["print-commands"]
472
   (OptArg ((\ f opts -> Ok opts { optShowCmds = Just f }) .
473
            fromMaybe "-")
474
    "FILE")
475
   "print the ganeti command list for reaching the solution,\
476
   \ if an argument is passed then write the commands to a\
477
   \ file named as such",
478
   OptComplNone)
479

    
480
oPrintInsts :: OptType
481
oPrintInsts =
482
  (Option "" ["print-instances"]
483
   (NoArg (\ opts -> Ok opts { optShowInsts = True }))
484
   "print the final instance map",
485
   OptComplNone)
486

    
487
oPrintNodes :: OptType
488
oPrintNodes =
489
  (Option "p" ["print-nodes"]
490
   (OptArg ((\ f opts ->
491
               let (prefix, realf) = case f of
492
                                       '+':rest -> (["+"], rest)
493
                                       _ -> ([], f)
494
                   splitted = prefix ++ sepSplit ',' realf
495
               in Ok opts { optShowNodes = Just splitted }) .
496
            fromMaybe []) "FIELDS")
497
   "print the final node list",
498
   OptComplNone)
499

    
500
oQuiet :: OptType
501
oQuiet =
502
  (Option "q" ["quiet"]
503
   (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts - 1 }))
504
   "decrease the verbosity level",
505
   OptComplNone)
506

    
507
oRapiMaster :: OptType
508
oRapiMaster =
509
  (Option "m" ["master"]
510
   (ReqArg (\ m opts -> Ok opts { optMaster = m }) "ADDRESS")
511
   "collect data via RAPI at the given ADDRESS",
512
   OptComplHost)
513

    
514
oSaveCluster :: OptType
515
oSaveCluster =
516
  (Option "S" ["save"]
517
   (ReqArg (\ f opts -> Ok opts { optSaveCluster = Just f }) "FILE")
518
   "Save cluster state at the end of the processing to FILE",
519
   OptComplNone)
520

    
521
oStdSpec :: OptType
522
oStdSpec =
523
  (Option "" ["standard-alloc"]
524
   (ReqArg (\ inp opts -> do
525
              tspec <- parseISpecString "standard" inp
526
              return $ opts { optStdSpec = Just tspec } )
527
    "STDSPEC")
528
   "enable standard specs allocation, given as 'disk,ram,cpu'",
529
   OptComplString)
530

    
531
oTieredSpec :: OptType
532
oTieredSpec =
533
  (Option "" ["tiered-alloc"]
534
   (ReqArg (\ inp opts -> do
535
              tspec <- parseISpecString "tiered" inp
536
              return $ opts { optTieredSpec = Just tspec } )
537
    "TSPEC")
538
   "enable tiered specs allocation, given as 'disk,ram,cpu'",
539
   OptComplString)
540

    
541
oVerbose :: OptType
542
oVerbose =
543
  (Option "v" ["verbose"]
544
   (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts + 1 }))
545
   "increase the verbosity level",
546
   OptComplNone)
547

    
548
oPriority :: OptType
549
oPriority =
550
  (Option "" ["priority"]
551
   (ReqArg (\ inp opts -> do
552
              prio <- parseSubmitPriority inp
553
              Ok opts { optPriority = Just prio }) "PRIO")
554
   "set the priority of submitted jobs",
555
    OptComplChoices (map fmtSubmitPriority [minBound..maxBound]))
556

    
557
-- | Generic options.
558
genericOpts :: [GenericOptType Options]
559
genericOpts =  [ oShowVer
560
               , oShowHelp
561
               , oShowComp
562
               ]
563

    
564
-- * Functions
565

    
566
-- | Wrapper over 'Common.parseOpts' with our custom options.
567
parseOpts :: [String]               -- ^ The command line arguments
568
          -> String                 -- ^ The program name
569
          -> [OptType]              -- ^ The supported command line options
570
          -> [ArgCompletion]        -- ^ The supported command line arguments
571
          -> IO (Options, [String]) -- ^ The resulting options and leftover
572
                                    -- arguments
573
parseOpts = Common.parseOpts defaultOptions
574

    
575

    
576
-- | A shell script template for autogenerated scripts.
577
shTemplate :: String
578
shTemplate =
579
  printf "#!/bin/sh\n\n\
580
         \# Auto-generated script for executing cluster rebalancing\n\n\
581
         \# To stop, touch the file /tmp/stop-htools\n\n\
582
         \set -e\n\n\
583
         \check() {\n\
584
         \  if [ -f /tmp/stop-htools ]; then\n\
585
         \    echo 'Stop requested, exiting'\n\
586
         \    exit 0\n\
587
         \  fi\n\
588
         \}\n\n"
589

    
590
-- | Optionally print the node list.
591
maybePrintNodes :: Maybe [String]       -- ^ The field list
592
                -> String               -- ^ Informational message
593
                -> ([String] -> String) -- ^ Function to generate the listing
594
                -> IO ()
595
maybePrintNodes Nothing _ _ = return ()
596
maybePrintNodes (Just fields) msg fn = do
597
  hPutStrLn stderr ""
598
  hPutStrLn stderr (msg ++ " status:")
599
  hPutStrLn stderr $ fn fields
600

    
601
-- | Optionally print the instance list.
602
maybePrintInsts :: Bool   -- ^ Whether to print the instance list
603
                -> String -- ^ Type of the instance map (e.g. initial)
604
                -> String -- ^ The instance data
605
                -> IO ()
606
maybePrintInsts do_print msg instdata =
607
  when do_print $ do
608
    hPutStrLn stderr ""
609
    hPutStrLn stderr $ msg ++ " instance map:"
610
    hPutStr stderr instdata
611

    
612
-- | Function to display warning messages from parsing the cluster
613
-- state.
614
maybeShowWarnings :: [String] -- ^ The warning messages
615
                  -> IO ()
616
maybeShowWarnings fix_msgs =
617
  unless (null fix_msgs) $ do
618
    hPutStrLn stderr "Warning: cluster has inconsistent data:"
619
    hPutStrLn stderr . unlines . map (printf "  - %s") $ fix_msgs
620

    
621
-- | Format a list of key, value as a shell fragment.
622
printKeys :: String              -- ^ Prefix to printed variables
623
          -> [(String, String)]  -- ^ List of (key, value) pairs to be printed
624
          -> IO ()
625
printKeys prefix =
626
  mapM_ (\(k, v) ->
627
           printf "%s_%s=%s\n" prefix (map toUpper k) (ensureQuoted v))
628

    
629
-- | Prints the final @OK@ marker in machine readable output.
630
printFinal :: String    -- ^ Prefix to printed variable
631
           -> Bool      -- ^ Whether output should be machine readable;
632
                        -- note: if not, there is nothing to print
633
           -> IO ()
634
printFinal prefix True =
635
  -- this should be the final entry
636
  printKeys prefix [("OK", "1")]
637

    
638
printFinal _ False = return ()
639

    
640
-- | Potentially set the node as offline based on passed offline list.
641
setNodeOffline :: [Ndx] -> Node.Node -> Node.Node
642
setNodeOffline offline_indices n =
643
  if Node.idx n `elem` offline_indices
644
    then Node.setOffline n True
645
    else n
646

    
647
-- | Set node properties based on command line options.
648
setNodeStatus :: Options -> Node.List -> IO Node.List
649
setNodeStatus opts fixed_nl = do
650
  let offline_passed = optOffline opts
651
      all_nodes = Container.elems fixed_nl
652
      offline_lkp = map (lookupName (map Node.name all_nodes)) offline_passed
653
      offline_wrong = filter (not . goodLookupResult) offline_lkp
654
      offline_names = map lrContent offline_lkp
655
      offline_indices = map Node.idx $
656
                        filter (\n -> Node.name n `elem` offline_names)
657
                               all_nodes
658
      m_cpu = optMcpu opts
659
      m_dsk = optMdsk opts
660

    
661
  unless (null offline_wrong) .
662
         exitErr $ printf "wrong node name(s) set as offline: %s\n"
663
                   (commaJoin (map lrContent offline_wrong))
664
  let setMCpuFn = case m_cpu of
665
                    Nothing -> id
666
                    Just new_mcpu -> flip Node.setMcpu new_mcpu
667
  let nm = Container.map (setNodeOffline offline_indices .
668
                          flip Node.setMdsk m_dsk .
669
                          setMCpuFn) fixed_nl
670
  return nm