code.grnet.gr Git - ganeti-local/blob - htools/Ganeti/HTools/CLI.hs

   1 {-| Implementation of command-line functions.
   2
   3 This module holds the common command-line related functions for the
   4 binaries, separated into this module since "Ganeti.HTools.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 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   , parseOpts
  34   , parseOptsInner
  35   , parseYesNo
  36   , parseISpecString
  37   , shTemplate
  38   , defaultLuxiSocket
  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   , oGroup
  56   , oIAllocSrc
  57   , oInstMoves
  58   , oLuxiSocket
  59   , oMachineReadable
  60   , oMaxCpu
  61   , oMaxSolLength
  62   , oMinDisk
  63   , oMinGain
  64   , oMinGainLim
  65   , oMinScore
  66   , oNoHeaders
  67   , oNoSimulation
  68   , oNodeSim
  69   , oOfflineNode
  70   , oOutputDir
  71   , oPrintCommands
  72   , oPrintInsts
  73   , oPrintNodes
  74   , oQuiet
  75   , oRapiMaster
  76   , oReplay
  77   , oSaveCluster
  78   , oSelInst
  79   , oShowHelp
  80   , oShowVer
  81   , oStdSpec
  82   , oTestCount
  83   , oTieredSpec
  84   , oVerbose
  85   ) where
  86
  87 import Control.Monad
  88 import Data.Char (toUpper)
  89 import Data.Maybe (fromMaybe)
  90 import qualified Data.Version
  91 import System.Console.GetOpt
  92 import System.IO
  93 import System.Info
  94 import System.Exit
  95 import Text.Printf (printf)
  96
  97 import qualified Ganeti.HTools.Version as Version(version)
  98 import qualified Ganeti.HTools.Container as Container
  99 import qualified Ganeti.HTools.Node as Node
 100 import qualified Ganeti.Constants as C
 101 import Ganeti.HTools.Types
 102 import Ganeti.HTools.Utils
 103 import Ganeti.BasicTypes
 104
 105 -- * Constants
 106
 107 -- | The default value for the luxi socket.
 108 --
 109 -- This is re-exported from the "Ganeti.Constants" module.
 110 defaultLuxiSocket :: FilePath
 111 defaultLuxiSocket = C.masterSocket
 112
 113 -- * Data types
 114
 115 -- | Command line options structure.
 116 data Options = Options
 117   { optDataFile    :: Maybe FilePath -- ^ Path to the cluster data file
 118   , optDiskMoves   :: Bool           -- ^ Allow disk moves
 119   , optInstMoves   :: Bool           -- ^ Allow instance moves
 120   , optDiskTemplate :: Maybe DiskTemplate  -- ^ Override for the disk template
 121   , optSpindleUse  :: Maybe Int      -- ^ Override for the spindle usage
 122   , optDynuFile    :: Maybe FilePath -- ^ Optional file with dynamic use data
 123   , optEvacMode    :: Bool           -- ^ Enable evacuation mode
 124   , optExInst      :: [String]       -- ^ Instances to be excluded
 125   , optExTags      :: Maybe [String] -- ^ Tags to use for exclusion
 126   , optExecJobs    :: Bool           -- ^ Execute the commands via Luxi
 127   , optGroup       :: Maybe GroupID  -- ^ The UUID of the group to process
 128   , optIAllocSrc   :: Maybe FilePath -- ^ The iallocation spec
 129   , optSelInst     :: [String]       -- ^ Instances to be excluded
 130   , optLuxi        :: Maybe FilePath -- ^ Collect data from Luxi
 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   , optOffline     :: [String]       -- ^ Names of offline nodes
 143   , optOutPath     :: FilePath       -- ^ Path to the output directory
 144   , optSaveCluster :: Maybe FilePath -- ^ Save cluster state to this file
 145   , optShowCmds    :: Maybe FilePath -- ^ Whether to show the command list
 146   , optShowHelp    :: Bool           -- ^ Just show the help
 147   , optShowInsts   :: Bool           -- ^ Whether to show the instance map
 148   , optShowNodes   :: Maybe [String] -- ^ Whether to show node status
 149   , optShowVer     :: Bool           -- ^ Just show the program version
 150   , optStdSpec     :: Maybe RSpec    -- ^ Requested standard specs
 151   , optTestCount   :: Maybe Int      -- ^ Optional test count override
 152   , optTieredSpec  :: Maybe RSpec    -- ^ Requested specs for tiered mode
 153   , optReplay      :: Maybe String   -- ^ Unittests: RNG state
 154   , optVerbose     :: Int            -- ^ Verbosity level
 155   } deriving Show
 156
 157 -- | Default values for the command line options.
 158 defaultOptions :: Options
 159 defaultOptions  = Options
 160   { optDataFile    = Nothing
 161   , optDiskMoves   = True
 162   , optInstMoves   = True
 163   , optDiskTemplate = Nothing
 164   , optSpindleUse  = Nothing
 165   , optDynuFile    = Nothing
 166   , optEvacMode    = False
 167   , optExInst      = []
 168   , optExTags      = Nothing
 169   , optExecJobs    = False
 170   , optGroup       = Nothing
 171   , optIAllocSrc   = Nothing
 172   , optSelInst     = []
 173   , optLuxi        = Nothing
 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   , optShowInsts   = False
 191   , optShowNodes   = Nothing
 192   , optShowVer     = False
 193   , optStdSpec     = Nothing
 194   , optTestCount   = Nothing
 195   , optTieredSpec  = Nothing
 196   , optReplay      = Nothing
 197   , optVerbose     = 1
 198   }
 199
 200 -- | Abrreviation for the option type.
 201 type OptType = OptDescr (Options -> Result Options)
 202
 203 -- * Helper functions
 204
 205 parseISpecString :: String -> String -> Result RSpec
 206 parseISpecString descr inp = do
 207   let sp = sepSplit ',' inp
 208       err = Bad ("Invalid " ++ descr ++ " specification: '" ++ inp ++
 209                  "', expected disk,ram,cpu")
 210   when (length sp /= 3) err
 211   prs <- mapM (\(fn, val) -> fn val) $
 212          zip [ annotateResult (descr ++ " specs disk") . parseUnit
 213              , annotateResult (descr ++ " specs memory") . parseUnit
 214              , tryRead (descr ++ " specs cpus")
 215              ] sp
 216   case prs of
 217     [dsk, ram, cpu] -> return $ RSpec cpu ram dsk
 218     _ -> err
 219
 220 -- * Command line options
 221
 222 oDataFile :: OptType
 223 oDataFile = Option "t" ["text-data"]
 224             (ReqArg (\ f o -> Ok o { optDataFile = Just f }) "FILE")
 225             "the cluster data FILE"
 226
 227 oDiskMoves :: OptType
 228 oDiskMoves = Option "" ["no-disk-moves"]
 229              (NoArg (\ opts -> Ok opts { optDiskMoves = False}))
 230              "disallow disk moves from the list of allowed instance changes,\
 231              \ thus allowing only the 'cheap' failover/migrate operations"
 232
 233 oDiskTemplate :: OptType
 234 oDiskTemplate = Option "" ["disk-template"]
 235                 (ReqArg (\ t opts -> do
 236                            dt <- diskTemplateFromRaw t
 237                            return $ opts { optDiskTemplate = Just dt })
 238                  "TEMPLATE") "select the desired disk template"
 239
 240 oSpindleUse :: OptType
 241 oSpindleUse = Option "" ["spindle-use"]
 242               (ReqArg (\ n opts -> do
 243                          su <- tryRead "parsing spindle-use" n
 244                          when (su < 0) $
 245                               fail "Invalid value of the spindle-use\
 246                                    \ (expected >= 0)"
 247                          return $ opts { optSpindleUse = Just su })
 248                "SPINDLES") "select how many virtual spindle instances use\
 249                            \ [default read from cluster]"
 250
 251 oSelInst :: OptType
 252 oSelInst = Option "" ["select-instances"]
 253           (ReqArg (\ f opts -> Ok opts { optSelInst = sepSplit ',' f }) "INSTS")
 254           "only select given instances for any moves"
 255
 256 oInstMoves :: OptType
 257 oInstMoves = Option "" ["no-instance-moves"]
 258              (NoArg (\ opts -> Ok opts { optInstMoves = False}))
 259              "disallow instance (primary node) moves from the list of allowed,\
 260              \ instance changes, thus allowing only slower, but sometimes\
 261              \ safer, drbd secondary changes"
 262
 263 oDynuFile :: OptType
 264 oDynuFile = Option "U" ["dynu-file"]
 265             (ReqArg (\ f opts -> Ok opts { optDynuFile = Just f }) "FILE")
 266             "Import dynamic utilisation data from the given FILE"
 267
 268 oEvacMode :: OptType
 269 oEvacMode = Option "E" ["evac-mode"]
 270             (NoArg (\opts -> Ok opts { optEvacMode = True }))
 271             "enable evacuation mode, where the algorithm only moves \
 272             \ instances away from offline and drained nodes"
 273
 274 oExInst :: OptType
 275 oExInst = Option "" ["exclude-instances"]
 276           (ReqArg (\ f opts -> Ok opts { optExInst = sepSplit ',' f }) "INSTS")
 277           "exclude given instances from any moves"
 278
 279 oExTags :: OptType
 280 oExTags = Option "" ["exclusion-tags"]
 281             (ReqArg (\ f opts -> Ok opts { optExTags = Just $ sepSplit ',' f })
 282              "TAG,...") "Enable instance exclusion based on given tag prefix"
 283
 284 oExecJobs :: OptType
 285 oExecJobs = Option "X" ["exec"]
 286              (NoArg (\ opts -> Ok opts { optExecJobs = True}))
 287              "execute the suggested moves via Luxi (only available when using\
 288              \ it for data gathering)"
 289
 290 oGroup :: OptType
 291 oGroup = Option "G" ["group"]
 292             (ReqArg (\ f o -> Ok o { optGroup = Just f }) "ID")
 293             "the ID of the group to balance"
 294
 295 oIAllocSrc :: OptType
 296 oIAllocSrc = Option "I" ["ialloc-src"]
 297              (ReqArg (\ f opts -> Ok opts { optIAllocSrc = Just f }) "FILE")
 298              "Specify an iallocator spec as the cluster data source"
 299
 300 oLuxiSocket :: OptType
 301 oLuxiSocket = Option "L" ["luxi"]
 302               (OptArg ((\ f opts -> Ok opts { optLuxi = Just f }) .
 303                        fromMaybe defaultLuxiSocket) "SOCKET")
 304               "collect data via Luxi, optionally using the given SOCKET path"
 305
 306 oMachineReadable :: OptType
 307 oMachineReadable = Option "" ["machine-readable"]
 308                    (OptArg (\ f opts -> do
 309                      flag <- parseYesNo True f
 310                      return $ opts { optMachineReadable = flag }) "CHOICE")
 311           "enable machine readable output (pass either 'yes' or 'no' to\
 312           \ explicitely control the flag, or without an argument defaults to\
 313           \ yes"
 314
 315 oMaxCpu :: OptType
 316 oMaxCpu = Option "" ["max-cpu"]
 317           (ReqArg (\ n opts -> do
 318                      mcpu <- tryRead "parsing max-cpu" n
 319                      when (mcpu <= 0) $
 320                           fail "Invalid value of the max-cpu ratio,\
 321                                \ expected >0"
 322                      return $ opts { optMcpu = Just mcpu }) "RATIO")
 323           "maximum virtual-to-physical cpu ratio for nodes (from 0\
 324           \ upwards) [default read from cluster]"
 325
 326 oMaxSolLength :: OptType
 327 oMaxSolLength = Option "l" ["max-length"]
 328                 (ReqArg (\ i opts -> Ok opts { optMaxLength = read i }) "N")
 329                 "cap the solution at this many balancing or allocation \
 330                 \ rounds (useful for very unbalanced clusters or empty \
 331                 \ clusters)"
 332
 333 oMinDisk :: OptType
 334 oMinDisk = Option "" ["min-disk"]
 335            (ReqArg (\ n opts -> Ok opts { optMdsk = read n }) "RATIO")
 336            "minimum free disk space for nodes (between 0 and 1) [0]"
 337
 338 oMinGain :: OptType
 339 oMinGain = Option "g" ["min-gain"]
 340             (ReqArg (\ g opts -> Ok opts { optMinGain = read g }) "DELTA")
 341             "minimum gain to aim for in a balancing step before giving up"
 342
 343 oMinGainLim :: OptType
 344 oMinGainLim = Option "" ["min-gain-limit"]
 345             (ReqArg (\ g opts -> Ok opts { optMinGainLim = read g }) "SCORE")
 346             "minimum cluster score for which we start checking the min-gain"
 347
 348 oMinScore :: OptType
 349 oMinScore = Option "e" ["min-score"]
 350             (ReqArg (\ e opts -> Ok opts { optMinScore = read e }) "EPSILON")
 351             "mininum score to aim for"
 352
 353 oNoHeaders :: OptType
 354 oNoHeaders = Option "" ["no-headers"]
 355              (NoArg (\ opts -> Ok opts { optNoHeaders = True }))
 356              "do not show a header line"
 357
 358 oNoSimulation :: OptType
 359 oNoSimulation = Option "" ["no-simulation"]
 360                 (NoArg (\opts -> Ok opts {optNoSimulation = True}))
 361                 "do not perform rebalancing simulation"
 362
 363 oNodeSim :: OptType
 364 oNodeSim = Option "" ["simulate"]
 365             (ReqArg (\ f o -> Ok o { optNodeSim = f:optNodeSim o }) "SPEC")
 366             "simulate an empty cluster, given as\
 367             \ 'alloc_policy,num_nodes,disk,ram,cpu'"
 368
 369 oOfflineNode :: OptType
 370 oOfflineNode = Option "O" ["offline"]
 371                (ReqArg (\ n o -> Ok o { optOffline = n:optOffline o }) "NODE")
 372                "set node as offline"
 373
 374 oOutputDir :: OptType
 375 oOutputDir = Option "d" ["output-dir"]
 376              (ReqArg (\ d opts -> Ok opts { optOutPath = d }) "PATH")
 377              "directory in which to write output files"
 378
 379 oPrintCommands :: OptType
 380 oPrintCommands = Option "C" ["print-commands"]
 381                  (OptArg ((\ f opts -> Ok opts { optShowCmds = Just f }) .
 382                           fromMaybe "-")
 383                   "FILE")
 384                  "print the ganeti command list for reaching the solution,\
 385                  \ if an argument is passed then write the commands to a\
 386                  \ file named as such"
 387
 388 oPrintInsts :: OptType
 389 oPrintInsts = Option "" ["print-instances"]
 390               (NoArg (\ opts -> Ok opts { optShowInsts = True }))
 391               "print the final instance map"
 392
 393 oPrintNodes :: OptType
 394 oPrintNodes = Option "p" ["print-nodes"]
 395               (OptArg ((\ f opts ->
 396                           let (prefix, realf) = case f of
 397                                                   '+':rest -> (["+"], rest)
 398                                                   _ -> ([], f)
 399                               splitted = prefix ++ sepSplit ',' realf
 400                           in Ok opts { optShowNodes = Just splitted }) .
 401                        fromMaybe []) "FIELDS")
 402               "print the final node list"
 403
 404 oQuiet :: OptType
 405 oQuiet = Option "q" ["quiet"]
 406          (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts - 1 }))
 407          "decrease the verbosity level"
 408
 409 oRapiMaster :: OptType
 410 oRapiMaster = Option "m" ["master"]
 411               (ReqArg (\ m opts -> Ok opts { optMaster = m }) "ADDRESS")
 412               "collect data via RAPI at the given ADDRESS"
 413
 414 oSaveCluster :: OptType
 415 oSaveCluster = Option "S" ["save"]
 416             (ReqArg (\ f opts -> Ok opts { optSaveCluster = Just f }) "FILE")
 417             "Save cluster state at the end of the processing to FILE"
 418
 419 oShowHelp :: OptType
 420 oShowHelp = Option "h" ["help"]
 421             (NoArg (\ opts -> Ok opts { optShowHelp = True}))
 422             "show help"
 423
 424 oShowVer :: OptType
 425 oShowVer = Option "V" ["version"]
 426            (NoArg (\ opts -> Ok opts { optShowVer = True}))
 427            "show the version of the program"
 428
 429 oStdSpec :: OptType
 430 oStdSpec = Option "" ["standard-alloc"]
 431              (ReqArg (\ inp opts -> do
 432                         tspec <- parseISpecString "standard" inp
 433                         return $ opts { optStdSpec = Just tspec } )
 434               "STDSPEC")
 435              "enable standard specs allocation, given as 'disk,ram,cpu'"
 436
 437 oTestCount :: OptType
 438 oTestCount = Option "" ["test-count"]
 439              (ReqArg (\ inp opts -> do
 440                         tcount <- tryRead "parsing test count" inp
 441                         return $ opts { optTestCount = Just tcount } )
 442               "COUNT")
 443              "override the target test count"
 444
 445 oTieredSpec :: OptType
 446 oTieredSpec = Option "" ["tiered-alloc"]
 447              (ReqArg (\ inp opts -> do
 448                         tspec <- parseISpecString "tiered" inp
 449                         return $ opts { optTieredSpec = Just tspec } )
 450               "TSPEC")
 451              "enable tiered specs allocation, given as 'disk,ram,cpu'"
 452
 453 oReplay :: OptType
 454 oReplay = Option "" ["replay"]
 455           (ReqArg (\ stat opts -> Ok opts { optReplay = Just stat } ) "STATE")
 456           "Pre-seed the random number generator with STATE"
 457
 458 oVerbose :: OptType
 459 oVerbose = Option "v" ["verbose"]
 460            (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts + 1 }))
 461            "increase the verbosity level"
 462
 463 -- * Functions
 464
 465 -- | Helper for parsing a yes\/no command line flag.
 466 parseYesNo :: Bool         -- ^ Default value (when we get a @Nothing@)
 467            -> Maybe String -- ^ Parameter value
 468            -> Result Bool  -- ^ Resulting boolean value
 469 parseYesNo v Nothing      = return v
 470 parseYesNo _ (Just "yes") = return True
 471 parseYesNo _ (Just "no")  = return False
 472 parseYesNo _ (Just s)     = fail ("Invalid choice '" ++ s ++
 473                                   "', pass one of 'yes' or 'no'")
 474
 475 -- | Usage info.
 476 usageHelp :: String -> [OptType] -> String
 477 usageHelp progname =
 478   usageInfo (printf "%s %s\nUsage: %s [OPTION...]"
 479              progname Version.version progname)
 480
 481 -- | Show the program version info.
 482 versionInfo :: String -> String
 483 versionInfo progname =
 484   printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
 485          progname Version.version compilerName
 486          (Data.Version.showVersion compilerVersion)
 487          os arch
 488
 489 -- | Command line parser, using the 'Options' structure.
 490 parseOpts :: [String]               -- ^ The command line arguments
 491           -> String                 -- ^ The program name
 492           -> [OptType]              -- ^ The supported command line options
 493           -> IO (Options, [String]) -- ^ The resulting options and leftover
 494                                     -- arguments
 495 parseOpts argv progname options =
 496   case parseOptsInner argv progname options of
 497     Left (code, msg) -> do
 498       hPutStr (if code == 0 then stdout else stderr) msg
 499       exitWith (if code == 0 then ExitSuccess else ExitFailure code)
 500     Right result ->
 501       return result
 502
 503 -- | Inner parse options. The arguments are similar to 'parseOpts',
 504 -- but it returns either a 'Left' composed of exit code and message,
 505 -- or a 'Right' for the success case.
 506 parseOptsInner :: [String] -> String -> [OptType]
 507                -> Either (Int, String) (Options, [String])
 508 parseOptsInner argv progname options =
 509   case getOpt Permute options argv of
 510     (o, n, []) ->
 511       let (pr, args) = (foldM (flip id) defaultOptions o, n)
 512       in case pr of
 513            Bad msg -> Left (1, "Error while parsing command\
 514                                \line arguments:\n" ++ msg ++ "\n")
 515            Ok po ->
 516              select (Right (po, args))
 517                  [ (optShowHelp po, Left (0, usageHelp progname options))
 518                  , (optShowVer po,  Left (0, versionInfo progname))
 519                  ]
 520     (_, _, errs) ->
 521       Left (2, "Command line error: "  ++ concat errs ++ "\n" ++
 522             usageHelp progname options)
 523
 524 -- | A shell script template for autogenerated scripts.
 525 shTemplate :: String
 526 shTemplate =
 527   printf "#!/bin/sh\n\n\
 528          \# Auto-generated script for executing cluster rebalancing\n\n\
 529          \# To stop, touch the file /tmp/stop-htools\n\n\
 530          \set -e\n\n\
 531          \check() {\n\
 532          \  if [ -f /tmp/stop-htools ]; then\n\
 533          \    echo 'Stop requested, exiting'\n\
 534          \    exit 0\n\
 535          \  fi\n\
 536          \}\n\n"
 537
 538 -- | Optionally print the node list.
 539 maybePrintNodes :: Maybe [String]       -- ^ The field list
 540                 -> String               -- ^ Informational message
 541                 -> ([String] -> String) -- ^ Function to generate the listing
 542                 -> IO ()
 543 maybePrintNodes Nothing _ _ = return ()
 544 maybePrintNodes (Just fields) msg fn = do
 545   hPutStrLn stderr ""
 546   hPutStrLn stderr (msg ++ " status:")
 547   hPutStrLn stderr $ fn fields
 548
 549
 550 -- | Optionally print the instance list.
 551 maybePrintInsts :: Bool   -- ^ Whether to print the instance list
 552                 -> String -- ^ Type of the instance map (e.g. initial)
 553                 -> String -- ^ The instance data
 554                 -> IO ()
 555 maybePrintInsts do_print msg instdata =
 556   when do_print $ do
 557     hPutStrLn stderr ""
 558     hPutStrLn stderr $ msg ++ " instance map:"
 559     hPutStr stderr instdata
 560
 561 -- | Function to display warning messages from parsing the cluster
 562 -- state.
 563 maybeShowWarnings :: [String] -- ^ The warning messages
 564                   -> IO ()
 565 maybeShowWarnings fix_msgs =
 566   unless (null fix_msgs) $ do
 567     hPutStrLn stderr "Warning: cluster has inconsistent data:"
 568     hPutStrLn stderr . unlines . map (printf "  - %s") $ fix_msgs
 569
 570 -- | Format a list of key, value as a shell fragment.
 571 printKeys :: String              -- ^ Prefix to printed variables
 572           -> [(String, String)]  -- ^ List of (key, value) pairs to be printed
 573           -> IO ()
 574 printKeys prefix = mapM_ (\(k, v) ->
 575                        printf "%s_%s=%s\n" prefix (map toUpper k) (ensureQuoted v))
 576
 577 -- | Prints the final @OK@ marker in machine readable output.
 578 printFinal :: String    -- ^ Prefix to printed variable
 579            -> Bool      -- ^ Whether output should be machine readable
 580                         -- Note: if not, there is nothing to print
 581            -> IO ()
 582 printFinal prefix True =
 583   -- this should be the final entry
 584   printKeys prefix [("OK", "1")]
 585
 586 printFinal _ False = return ()
 587
 588 -- | Potentially set the node as offline based on passed offline list.
 589 setNodeOffline :: [Ndx] -> Node.Node -> Node.Node
 590 setNodeOffline offline_indices n =
 591   if Node.idx n `elem` offline_indices
 592     then Node.setOffline n True
 593     else n
 594
 595 -- | Set node properties based on command line options.
 596 setNodeStatus :: Options -> Node.List -> IO Node.List
 597 setNodeStatus opts fixed_nl = do
 598   let offline_passed = optOffline opts
 599       all_nodes = Container.elems fixed_nl
 600       offline_lkp = map (lookupName (map Node.name all_nodes)) offline_passed
 601       offline_wrong = filter (not . goodLookupResult) offline_lkp
 602       offline_names = map lrContent offline_lkp
 603       offline_indices = map Node.idx $
 604                         filter (\n -> Node.name n `elem` offline_names)
 605                                all_nodes
 606       m_cpu = optMcpu opts
 607       m_dsk = optMdsk opts
 608
 609   unless (null offline_wrong) $ do
 610          exitErr $ printf "wrong node name(s) set as offline: %s\n"
 611                    (commaJoin (map lrContent offline_wrong))
 612   let setMCpuFn = case m_cpu of
 613                     Nothing -> id
 614                     Just new_mcpu -> flip Node.setMcpu new_mcpu
 615   let nm = Container.map (setNodeOffline offline_indices .
 616                           flip Node.setMdsk m_dsk .
 617                           setMCpuFn) fixed_nl
 618   return nm