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