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.HTools.Loader
 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 'num_nodes,disk,ram,cpu'"
 367
 368 oOfflineNode :: OptType
 369 oOfflineNode = Option "O" ["offline"]
 370                (ReqArg (\ n o -> Ok o { optOffline = n:optOffline o }) "NODE")
 371                "set node as offline"
 372
 373 oOutputDir :: OptType
 374 oOutputDir = Option "d" ["output-dir"]
 375              (ReqArg (\ d opts -> Ok opts { optOutPath = d }) "PATH")
 376              "directory in which to write output files"
 377
 378 oPrintCommands :: OptType
 379 oPrintCommands = Option "C" ["print-commands"]
 380                  (OptArg ((\ f opts -> Ok opts { optShowCmds = Just f }) .
 381                           fromMaybe "-")
 382                   "FILE")
 383                  "print the ganeti command list for reaching the solution,\
 384                  \ if an argument is passed then write the commands to a\
 385                  \ file named as such"
 386
 387 oPrintInsts :: OptType
 388 oPrintInsts = Option "" ["print-instances"]
 389               (NoArg (\ opts -> Ok opts { optShowInsts = True }))
 390               "print the final instance map"
 391
 392 oPrintNodes :: OptType
 393 oPrintNodes = Option "p" ["print-nodes"]
 394               (OptArg ((\ f opts ->
 395                           let (prefix, realf) = case f of
 396                                                   '+':rest -> (["+"], rest)
 397                                                   _ -> ([], f)
 398                               splitted = prefix ++ sepSplit ',' realf
 399                           in Ok opts { optShowNodes = Just splitted }) .
 400                        fromMaybe []) "FIELDS")
 401               "print the final node list"
 402
 403 oQuiet :: OptType
 404 oQuiet = Option "q" ["quiet"]
 405          (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts - 1 }))
 406          "decrease the verbosity level"
 407
 408 oRapiMaster :: OptType
 409 oRapiMaster = Option "m" ["master"]
 410               (ReqArg (\ m opts -> Ok opts { optMaster = m }) "ADDRESS")
 411               "collect data via RAPI at the given ADDRESS"
 412
 413 oSaveCluster :: OptType
 414 oSaveCluster = Option "S" ["save"]
 415             (ReqArg (\ f opts -> Ok opts { optSaveCluster = Just f }) "FILE")
 416             "Save cluster state at the end of the processing to FILE"
 417
 418 oShowHelp :: OptType
 419 oShowHelp = Option "h" ["help"]
 420             (NoArg (\ opts -> Ok opts { optShowHelp = True}))
 421             "show help"
 422
 423 oShowVer :: OptType
 424 oShowVer = Option "V" ["version"]
 425            (NoArg (\ opts -> Ok opts { optShowVer = True}))
 426            "show the version of the program"
 427
 428 oStdSpec :: OptType
 429 oStdSpec = Option "" ["standard-alloc"]
 430              (ReqArg (\ inp opts -> do
 431                         tspec <- parseISpecString "standard" inp
 432                         return $ opts { optStdSpec = Just tspec } )
 433               "STDSPEC")
 434              "enable standard specs allocation, given as 'disk,ram,cpu'"
 435
 436 oTestCount :: OptType
 437 oTestCount = Option "" ["test-count"]
 438              (ReqArg (\ inp opts -> do
 439                         tcount <- tryRead "parsing test count" inp
 440                         return $ opts { optTestCount = Just tcount } )
 441               "COUNT")
 442              "override the target test count"
 443
 444 oTieredSpec :: OptType
 445 oTieredSpec = Option "" ["tiered-alloc"]
 446              (ReqArg (\ inp opts -> do
 447                         tspec <- parseISpecString "tiered" inp
 448                         return $ opts { optTieredSpec = Just tspec } )
 449               "TSPEC")
 450              "enable tiered specs allocation, given as 'disk,ram,cpu'"
 451
 452 oReplay :: OptType
 453 oReplay = Option "" ["replay"]
 454           (ReqArg (\ stat opts -> Ok opts { optReplay = Just stat } ) "STATE")
 455           "Pre-seed the random number generator with STATE"
 456
 457 oVerbose :: OptType
 458 oVerbose = Option "v" ["verbose"]
 459            (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts + 1 }))
 460            "increase the verbosity level"
 461
 462 -- * Functions
 463
 464 -- | Helper for parsing a yes\/no command line flag.
 465 parseYesNo :: Bool         -- ^ Default value (when we get a @Nothing@)
 466            -> Maybe String -- ^ Parameter value
 467            -> Result Bool  -- ^ Resulting boolean value
 468 parseYesNo v Nothing      = return v
 469 parseYesNo _ (Just "yes") = return True
 470 parseYesNo _ (Just "no")  = return False
 471 parseYesNo _ (Just s)     = fail ("Invalid choice '" ++ s ++
 472                                   "', pass one of 'yes' or 'no'")
 473
 474 -- | Usage info.
 475 usageHelp :: String -> [OptType] -> String
 476 usageHelp progname =
 477   usageInfo (printf "%s %s\nUsage: %s [OPTION...]"
 478              progname Version.version progname)
 479
 480 -- | Show the program version info.
 481 versionInfo :: String -> String
 482 versionInfo progname =
 483   printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
 484          progname Version.version compilerName
 485          (Data.Version.showVersion compilerVersion)
 486          os arch
 487
 488 -- | Command line parser, using the 'Options' structure.
 489 parseOpts :: [String]               -- ^ The command line arguments
 490           -> String                 -- ^ The program name
 491           -> [OptType]              -- ^ The supported command line options
 492           -> IO (Options, [String]) -- ^ The resulting options and leftover
 493                                     -- arguments
 494 parseOpts argv progname options =
 495   case parseOptsInner argv progname options of
 496     Left (code, msg) -> do
 497       hPutStr (if code == 0 then stdout else stderr) msg
 498       exitWith (if code == 0 then ExitSuccess else ExitFailure code)
 499     Right result ->
 500       return result
 501
 502 -- | Inner parse options. The arguments are similar to 'parseOpts',
 503 -- but it returns either a 'Left' composed of exit code and message,
 504 -- or a 'Right' for the success case.
 505 parseOptsInner :: [String] -> String -> [OptType]
 506                -> Either (Int, String) (Options, [String])
 507 parseOptsInner argv progname options =
 508   case getOpt Permute options argv of
 509     (o, n, []) ->
 510       let (pr, args) = (foldM (flip id) defaultOptions o, n)
 511       in case pr of
 512            Bad msg -> Left (1, "Error while parsing command\
 513                                \line arguments:\n" ++ msg ++ "\n")
 514            Ok po ->
 515              select (Right (po, args))
 516                  [ (optShowHelp po, Left (0, usageHelp progname options))
 517                  , (optShowVer po,  Left (0, versionInfo progname))
 518                  ]
 519     (_, _, errs) ->
 520       Left (2, "Command line error: "  ++ concat errs ++ "\n" ++
 521             usageHelp progname options)
 522
 523 -- | A shell script template for autogenerated scripts.
 524 shTemplate :: String
 525 shTemplate =
 526   printf "#!/bin/sh\n\n\
 527          \# Auto-generated script for executing cluster rebalancing\n\n\
 528          \# To stop, touch the file /tmp/stop-htools\n\n\
 529          \set -e\n\n\
 530          \check() {\n\
 531          \  if [ -f /tmp/stop-htools ]; then\n\
 532          \    echo 'Stop requested, exiting'\n\
 533          \    exit 0\n\
 534          \  fi\n\
 535          \}\n\n"
 536
 537 -- | Optionally print the node list.
 538 maybePrintNodes :: Maybe [String]       -- ^ The field list
 539                 -> String               -- ^ Informational message
 540                 -> ([String] -> String) -- ^ Function to generate the listing
 541                 -> IO ()
 542 maybePrintNodes Nothing _ _ = return ()
 543 maybePrintNodes (Just fields) msg fn = do
 544   hPutStrLn stderr ""
 545   hPutStrLn stderr (msg ++ " status:")
 546   hPutStrLn stderr $ fn fields
 547
 548
 549 -- | Optionally print the instance list.
 550 maybePrintInsts :: Bool   -- ^ Whether to print the instance list
 551                 -> String -- ^ Type of the instance map (e.g. initial)
 552                 -> String -- ^ The instance data
 553                 -> IO ()
 554 maybePrintInsts do_print msg instdata =
 555   when do_print $ do
 556     hPutStrLn stderr ""
 557     hPutStrLn stderr $ msg ++ " instance map:"
 558     hPutStr stderr instdata
 559
 560 -- | Function to display warning messages from parsing the cluster
 561 -- state.
 562 maybeShowWarnings :: [String] -- ^ The warning messages
 563                   -> IO ()
 564 maybeShowWarnings fix_msgs =
 565   unless (null fix_msgs) $ do
 566     hPutStrLn stderr "Warning: cluster has inconsistent data:"
 567     hPutStrLn stderr . unlines . map (printf "  - %s") $ fix_msgs
 568
 569 -- | Format a list of key, value as a shell fragment.
 570 printKeys :: String              -- ^ Prefix to printed variables
 571           -> [(String, String)]  -- ^ List of (key, value) pairs to be printed
 572           -> IO ()
 573 printKeys prefix = mapM_ (\(k, v) ->
 574                        printf "%s_%s=%s\n" prefix (map toUpper k) (ensureQuoted v))
 575
 576 -- | Prints the final @OK@ marker in machine readable output.
 577 printFinal :: String    -- ^ Prefix to printed variable
 578            -> Bool      -- ^ Whether output should be machine readable
 579                         -- Note: if not, there is nothing to print
 580            -> IO ()
 581 printFinal prefix True =
 582   -- this should be the final entry
 583   printKeys prefix [("OK", "1")]
 584
 585 printFinal _ False = return ()
 586
 587 -- | Potentially set the node as offline based on passed offline list.
 588 setNodeOffline :: [Ndx] -> Node.Node -> Node.Node
 589 setNodeOffline offline_indices n =
 590   if Node.idx n `elem` offline_indices
 591     then Node.setOffline n True
 592     else n
 593
 594 -- | Set node properties based on command line options.
 595 setNodeStatus :: Options -> Node.List -> IO Node.List
 596 setNodeStatus opts fixed_nl = do
 597   let offline_passed = optOffline opts
 598       all_nodes = Container.elems fixed_nl
 599       offline_lkp = map (lookupName (map Node.name all_nodes)) offline_passed
 600       offline_wrong = filter (not . goodLookupResult) offline_lkp
 601       offline_names = map lrContent offline_lkp
 602       offline_indices = map Node.idx $
 603                         filter (\n -> Node.name n `elem` offline_names)
 604                                all_nodes
 605       m_cpu = optMcpu opts
 606       m_dsk = optMdsk opts
 607
 608   unless (null offline_wrong) $ do
 609          exitErr $ printf "wrong node name(s) set as offline: %s\n"
 610                    (commaJoin (map lrContent offline_wrong))
 611   let setMCpuFn = case m_cpu of
 612                     Nothing -> id
 613                     Just new_mcpu -> flip Node.setMcpu new_mcpu
 614   let nm = Container.map (setNodeOffline offline_indices .
 615                           flip Node.setMdsk m_dsk .
 616                           setMCpuFn) fixed_nl
 617   return nm