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