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 cli-related functions for the binaries,
   4 separated into this module since Utils.hs is used in many other places
   5 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     -- * The options
  39     , oDataFile
  40     , oDiskMoves
  41     , oDynuFile
  42     , oEvacMode
  43     , oExInst
  44     , oExTags
  45     , oExecJobs
  46     , oGroup
  47     , oIDisk
  48     , oIMem
  49     , oINodes
  50     , oIVcpus
  51     , oLuxiSocket
  52     , oMaxCpu
  53     , oMaxSolLength
  54     , oMinDisk
  55     , oMinGain
  56     , oMinGainLim
  57     , oMinScore
  58     , oNoHeaders
  59     , oNodeSim
  60     , oOfflineNode
  61     , oOneline
  62     , oOutputDir
  63     , oPrintCommands
  64     , oPrintInsts
  65     , oPrintNodes
  66     , oQuiet
  67     , oRapiMaster
  68     , oSaveCluster
  69     , oShowHelp
  70     , oShowVer
  71     , oTieredSpec
  72     , oVerbose
  73     ) where
  74
  75 import Data.Maybe (fromMaybe)
  76 import qualified Data.Version
  77 import Monad
  78 import System.Console.GetOpt
  79 import System.IO
  80 import System.Info
  81 import System
  82 import Text.Printf (printf)
  83
  84 import qualified Ganeti.HTools.Version as Version(version)
  85 import qualified Ganeti.Constants as C
  86 import Ganeti.HTools.Types
  87 import Ganeti.HTools.Utils
  88
  89 -- | The default value for the luxi socket
  90 defaultLuxiSocket :: FilePath
  91 defaultLuxiSocket = C.masterSocket
  92
  93 -- | Command line options structure.
  94 data Options = Options
  95     { optDataFile    :: Maybe FilePath -- ^ Path to the cluster data file
  96     , optDiskMoves   :: Bool           -- ^ Allow disk moves
  97     , optDynuFile    :: Maybe FilePath -- ^ Optional file with dynamic use data
  98     , optEvacMode    :: Bool           -- ^ Enable evacuation mode
  99     , optExInst      :: [String]       -- ^ Instances to be excluded
 100     , optExTags      :: Maybe [String] -- ^ Tags to use for exclusion
 101     , optExecJobs    :: Bool           -- ^ Execute the commands via Luxi
 102     , optGroup       :: Maybe GroupID  -- ^ The UUID of the group to process
 103     , optINodes      :: Int            -- ^ Nodes required for an instance
 104     , optISpec       :: RSpec          -- ^ Requested instance specs
 105     , optLuxi        :: Maybe FilePath -- ^ Collect data from Luxi
 106     , optMaster      :: String         -- ^ Collect data from RAPI
 107     , optMaxLength   :: Int            -- ^ Stop after this many steps
 108     , optMcpu        :: Double         -- ^ Max cpu ratio for nodes
 109     , optMdsk        :: Double         -- ^ Max disk usage ratio for nodes
 110     , optMinGain     :: Score          -- ^ Min gain we aim for in a step
 111     , optMinGainLim  :: Score          -- ^ Limit below which we apply mingain
 112     , optMinScore    :: Score          -- ^ The minimum score we aim for
 113     , optNoHeaders   :: Bool           -- ^ Do not show a header line
 114     , optNodeSim     :: [String]       -- ^ Cluster simulation mode
 115     , optOffline     :: [String]       -- ^ Names of offline nodes
 116     , optOneline     :: Bool           -- ^ Switch output to a single line
 117     , optOutPath     :: FilePath       -- ^ Path to the output directory
 118     , optSaveCluster :: Maybe FilePath -- ^ Save cluster state to this file
 119     , optShowCmds    :: Maybe FilePath -- ^ Whether to show the command list
 120     , optShowHelp    :: Bool           -- ^ Just show the help
 121     , optShowInsts   :: Bool           -- ^ Whether to show the instance map
 122     , optShowNodes   :: Maybe [String] -- ^ Whether to show node status
 123     , optShowVer     :: Bool           -- ^ Just show the program version
 124     , optTieredSpec  :: Maybe RSpec    -- ^ Requested specs for tiered mode
 125     , optVerbose     :: Int            -- ^ Verbosity level
 126     } deriving Show
 127
 128 -- | Default values for the command line options.
 129 defaultOptions :: Options
 130 defaultOptions  = Options
 131  { optDataFile    = Nothing
 132  , optDiskMoves   = True
 133  , optDynuFile    = Nothing
 134  , optEvacMode    = False
 135  , optExInst      = []
 136  , optExTags      = Nothing
 137  , optExecJobs    = False
 138  , optGroup       = Nothing
 139  , optINodes      = 2
 140  , optISpec       = RSpec 1 4096 102400
 141  , optLuxi        = Nothing
 142  , optMaster      = ""
 143  , optMaxLength   = -1
 144  , optMcpu        = defVcpuRatio
 145  , optMdsk        = defReservedDiskRatio
 146  , optMinGain     = 1e-2
 147  , optMinGainLim  = 1e-1
 148  , optMinScore    = 1e-9
 149  , optNoHeaders   = False
 150  , optNodeSim     = []
 151  , optOffline     = []
 152  , optOneline     = False
 153  , optOutPath     = "."
 154  , optSaveCluster = Nothing
 155  , optShowCmds    = Nothing
 156  , optShowHelp    = False
 157  , optShowInsts   = False
 158  , optShowNodes   = Nothing
 159  , optShowVer     = False
 160  , optTieredSpec  = Nothing
 161  , optVerbose     = 1
 162  }
 163
 164 -- | Abrreviation for the option type
 165 type OptType = OptDescr (Options -> Result Options)
 166
 167 oDataFile :: OptType
 168 oDataFile = Option "t" ["text-data"]
 169             (ReqArg (\ f o -> Ok o { optDataFile = Just f }) "FILE")
 170             "the cluster data FILE"
 171
 172 oDiskMoves :: OptType
 173 oDiskMoves = Option "" ["no-disk-moves"]
 174              (NoArg (\ opts -> Ok opts { optDiskMoves = False}))
 175              "disallow disk moves from the list of allowed instance changes,\
 176              \ thus allowing only the 'cheap' failover/migrate operations"
 177
 178 oDynuFile :: OptType
 179 oDynuFile = Option "U" ["dynu-file"]
 180             (ReqArg (\ f opts -> Ok opts { optDynuFile = Just f }) "FILE")
 181             "Import dynamic utilisation data from the given FILE"
 182
 183 oEvacMode :: OptType
 184 oEvacMode = Option "E" ["evac-mode"]
 185             (NoArg (\opts -> Ok opts { optEvacMode = True }))
 186             "enable evacuation mode, where the algorithm only moves \
 187             \ instances away from offline and drained nodes"
 188
 189 oExInst :: OptType
 190 oExInst = Option "" ["exclude-instances"]
 191           (ReqArg (\ f opts -> Ok opts { optExInst = sepSplit ',' f }) "INSTS")
 192           "exclude given instances  from any moves"
 193
 194 oExTags :: OptType
 195 oExTags = Option "" ["exclusion-tags"]
 196             (ReqArg (\ f opts -> Ok opts { optExTags = Just $ sepSplit ',' f })
 197              "TAG,...") "Enable instance exclusion based on given tag prefix"
 198
 199 oExecJobs :: OptType
 200 oExecJobs = Option "X" ["exec"]
 201              (NoArg (\ opts -> Ok opts { optExecJobs = True}))
 202              "execute the suggested moves via Luxi (only available when using\
 203              \ it for data gathering)"
 204
 205 oGroup :: OptType
 206 oGroup = Option "G" ["group"]
 207             (ReqArg (\ f o -> Ok o { optGroup = Just f }) "ID")
 208             "the ID of the group to balance"
 209
 210 oIDisk :: OptType
 211 oIDisk = Option "" ["disk"]
 212          (ReqArg (\ d opts ->
 213                      let ospec = optISpec opts
 214                          nspec = ospec { rspecDsk = read d }
 215                      in Ok opts { optISpec = nspec }) "DISK")
 216          "disk size for instances"
 217
 218 oIMem :: OptType
 219 oIMem = Option "" ["memory"]
 220         (ReqArg (\ m opts ->
 221                      let ospec = optISpec opts
 222                          nspec = ospec { rspecMem = read m }
 223                      in Ok opts { optISpec = nspec }) "MEMORY")
 224         "memory size for instances"
 225
 226 oINodes :: OptType
 227 oINodes = Option "" ["req-nodes"]
 228           (ReqArg (\ n opts -> Ok opts { optINodes = read n }) "NODES")
 229           "number of nodes for the new instances (1=plain, 2=mirrored)"
 230
 231 oIVcpus :: OptType
 232 oIVcpus = Option "" ["vcpus"]
 233           (ReqArg (\ p opts ->
 234                        let ospec = optISpec opts
 235                            nspec = ospec { rspecCpu = read p }
 236                        in Ok opts { optISpec = nspec }) "NUM")
 237           "number of virtual cpus for instances"
 238
 239 oLuxiSocket :: OptType
 240 oLuxiSocket = Option "L" ["luxi"]
 241               (OptArg ((\ f opts -> Ok opts { optLuxi = Just f }) .
 242                        fromMaybe defaultLuxiSocket) "SOCKET")
 243               "collect data via Luxi, optionally using the given SOCKET path"
 244
 245 oMaxCpu :: OptType
 246 oMaxCpu = Option "" ["max-cpu"]
 247           (ReqArg (\ n opts -> Ok opts { optMcpu = read n }) "RATIO")
 248           "maximum virtual-to-physical cpu ratio for nodes (from 1\
 249           \ upwards) [64]"
 250
 251 oMaxSolLength :: OptType
 252 oMaxSolLength = Option "l" ["max-length"]
 253                 (ReqArg (\ i opts -> Ok opts { optMaxLength = read i }) "N")
 254                 "cap the solution at this many moves (useful for very\
 255                 \ unbalanced clusters)"
 256
 257 oMinDisk :: OptType
 258 oMinDisk = Option "" ["min-disk"]
 259            (ReqArg (\ n opts -> Ok opts { optMdsk = read n }) "RATIO")
 260            "minimum free disk space for nodes (between 0 and 1) [0]"
 261
 262 oMinGain :: OptType
 263 oMinGain = Option "g" ["min-gain"]
 264             (ReqArg (\ g opts -> Ok opts { optMinGain = read g }) "DELTA")
 265             "minimum gain to aim for in a balancing step before giving up"
 266
 267 oMinGainLim :: OptType
 268 oMinGainLim = Option "" ["min-gain-limit"]
 269             (ReqArg (\ g opts -> Ok opts { optMinGainLim = read g }) "SCORE")
 270             "minimum cluster score for which we start checking the min-gain"
 271
 272 oMinScore :: OptType
 273 oMinScore = Option "e" ["min-score"]
 274             (ReqArg (\ e opts -> Ok opts { optMinScore = read e }) "EPSILON")
 275             "mininum score to aim for"
 276
 277 oNoHeaders :: OptType
 278 oNoHeaders = Option "" ["no-headers"]
 279              (NoArg (\ opts -> Ok opts { optNoHeaders = True }))
 280              "do not show a header line"
 281
 282 oNodeSim :: OptType
 283 oNodeSim = Option "" ["simulate"]
 284             (ReqArg (\ f o -> Ok o { optNodeSim = f:optNodeSim o }) "SPEC")
 285             "simulate an empty cluster, given as 'num_nodes,disk,ram,cpu'"
 286
 287 oOfflineNode :: OptType
 288 oOfflineNode = Option "O" ["offline"]
 289                (ReqArg (\ n o -> Ok o { optOffline = n:optOffline o }) "NODE")
 290                "set node as offline"
 291
 292 oOneline :: OptType
 293 oOneline = Option "o" ["oneline"]
 294            (NoArg (\ opts -> Ok opts { optOneline = True }))
 295            "print the ganeti command list for reaching the solution"
 296
 297 oOutputDir :: OptType
 298 oOutputDir = Option "d" ["output-dir"]
 299              (ReqArg (\ d opts -> Ok opts { optOutPath = d }) "PATH")
 300              "directory in which to write output files"
 301
 302 oPrintCommands :: OptType
 303 oPrintCommands = Option "C" ["print-commands"]
 304                  (OptArg ((\ f opts -> Ok opts { optShowCmds = Just f }) .
 305                           fromMaybe "-")
 306                   "FILE")
 307                  "print the ganeti command list for reaching the solution,\
 308                  \ if an argument is passed then write the commands to a\
 309                  \ file named as such"
 310
 311 oPrintInsts :: OptType
 312 oPrintInsts = Option "" ["print-instances"]
 313               (NoArg (\ opts -> Ok opts { optShowInsts = True }))
 314               "print the final instance map"
 315
 316 oPrintNodes :: OptType
 317 oPrintNodes = Option "p" ["print-nodes"]
 318               (OptArg ((\ f opts ->
 319                             let (prefix, realf) = case f of
 320                                   '+':rest -> (["+"], rest)
 321                                   _ -> ([], f)
 322                                 splitted = prefix ++ sepSplit ',' realf
 323                             in Ok opts { optShowNodes = Just splitted }) .
 324                        fromMaybe []) "FIELDS")
 325               "print the final node list"
 326
 327 oQuiet :: OptType
 328 oQuiet = Option "q" ["quiet"]
 329          (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts - 1 }))
 330          "decrease the verbosity level"
 331
 332 oRapiMaster :: OptType
 333 oRapiMaster = Option "m" ["master"]
 334               (ReqArg (\ m opts -> Ok opts { optMaster = m }) "ADDRESS")
 335               "collect data via RAPI at the given ADDRESS"
 336
 337 oSaveCluster :: OptType
 338 oSaveCluster = Option "S" ["save"]
 339             (ReqArg (\ f opts -> Ok opts { optSaveCluster = Just f }) "FILE")
 340             "Save cluster state at the end of the processing to FILE"
 341
 342 oShowHelp :: OptType
 343 oShowHelp = Option "h" ["help"]
 344             (NoArg (\ opts -> Ok opts { optShowHelp = True}))
 345             "show help"
 346
 347 oShowVer :: OptType
 348 oShowVer = Option "V" ["version"]
 349            (NoArg (\ opts -> Ok opts { optShowVer = True}))
 350            "show the version of the program"
 351
 352 oTieredSpec :: OptType
 353 oTieredSpec = Option "" ["tiered-alloc"]
 354              (ReqArg (\ inp opts -> do
 355                           let sp = sepSplit ',' inp
 356                           prs <- mapM (tryRead "tiered specs") sp
 357                           tspec <-
 358                               case prs of
 359                                 [dsk, ram, cpu] -> return $ RSpec cpu ram dsk
 360                                 _ -> Bad $ "Invalid specification: " ++ inp ++
 361                                      ", expected disk,ram,cpu"
 362                           return $ opts { optTieredSpec = Just tspec } )
 363               "TSPEC")
 364              "enable tiered specs allocation, given as 'disk,ram,cpu'"
 365
 366 oVerbose :: OptType
 367 oVerbose = Option "v" ["verbose"]
 368            (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts + 1 }))
 369            "increase the verbosity level"
 370
 371 -- | Usage info
 372 usageHelp :: String -> [OptType] -> String
 373 usageHelp progname =
 374     usageInfo (printf "%s %s\nUsage: %s [OPTION...]"
 375                progname Version.version progname)
 376
 377 -- | Command line parser, using the 'options' structure.
 378 parseOpts :: [String]               -- ^ The command line arguments
 379           -> String                 -- ^ The program name
 380           -> [OptType]              -- ^ The supported command line options
 381           -> IO (Options, [String]) -- ^ The resulting options and leftover
 382                                     -- arguments
 383 parseOpts argv progname options =
 384     case getOpt Permute options argv of
 385       (o, n, []) ->
 386           do
 387             let (pr, args) = (foldM (flip id) defaultOptions o, n)
 388             po <- (case pr of
 389                      Bad msg -> do
 390                        hPutStrLn stderr "Error while parsing command\
 391                                         \line arguments:"
 392                        hPutStrLn stderr msg
 393                        exitWith $ ExitFailure 1
 394                      Ok val -> return val)
 395             when (optShowHelp po) $ do
 396               putStr $ usageHelp progname options
 397               exitWith ExitSuccess
 398             when (optShowVer po) $ do
 399               printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
 400                      progname Version.version
 401                      compilerName (Data.Version.showVersion compilerVersion)
 402                      os arch :: IO ()
 403               exitWith ExitSuccess
 404             return (po, args)
 405       (_, _, errs) -> do
 406         hPutStrLn stderr $ "Command line error: "  ++ concat errs
 407         hPutStrLn stderr $ usageHelp progname options
 408         exitWith $ ExitFailure 2
 409
 410 -- | A shell script template for autogenerated scripts.
 411 shTemplate :: String
 412 shTemplate =
 413     printf "#!/bin/sh\n\n\
 414            \# Auto-generated script for executing cluster rebalancing\n\n\
 415            \# To stop, touch the file /tmp/stop-htools\n\n\
 416            \set -e\n\n\
 417            \check() {\n\
 418            \  if [ -f /tmp/stop-htools ]; then\n\
 419            \    echo 'Stop requested, exiting'\n\
 420            \    exit 0\n\
 421            \  fi\n\
 422            \}\n\n"
 423
 424 -- | Optionally print the node list.
 425 maybePrintNodes :: Maybe [String]       -- ^ The field list
 426                 -> String               -- ^ Informational message
 427                 -> ([String] -> String) -- ^ Function to generate the listing
 428                 -> IO ()
 429 maybePrintNodes Nothing _ _ = return ()
 430 maybePrintNodes (Just fields) msg fn = do
 431   hPutStrLn stderr ""
 432   hPutStrLn stderr (msg ++ " status:")
 433   hPutStrLn stderr $ fn fields
 434
 435
 436 -- | Optionally print the instance list.
 437 maybePrintInsts :: Bool   -- ^ Whether to print the instance list
 438                 -> String -- ^ Type of the instance map (e.g. initial)
 439                 -> String -- ^ The instance data
 440                 -> IO ()
 441 maybePrintInsts do_print msg instdata =
 442   when do_print $ do
 443     hPutStrLn stderr ""
 444     hPutStrLn stderr $ msg ++ " instance map:"
 445     hPutStr stderr instdata