Synnefo » snf-ganeti

{-| Implementation of command-line functions.

This module holds the common command-line related functions for the

binaries, separated into this module since "Ganeti.HTools.Utils" is

used in many other places and this is more IO oriented.

-}

{-

Copyright (C) 2009, 2010, 2011 Google Inc.

This program is free software; you can redistribute it and/or modify

it under the terms of the GNU General Public License as published by

the Free Software Foundation; either version 2 of the License, or

(at your option) any later version.

This program is distributed in the hope that it will be useful, but

WITHOUT ANY WARRANTY; without even the implied warranty of

MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU

General Public License for more details.

You should have received a copy of the GNU General Public License

along with this program; if not, write to the Free Software

Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA

02110-1301, USA.

-}

module Ganeti.HTools.CLI

    ( Options(..)

    , OptType

    , parseOpts

    , shTemplate

    , defaultLuxiSocket

    , maybePrintNodes

    , maybePrintInsts

    , maybeShowWarnings

    -- * The options

    , oDataFile

    , oDiskMoves

    , oDiskTemplate

    , oDynuFile

    , oEvacMode

    , oExInst

    , oExTags

    , oExecJobs

    , oGroup

    , oIDisk

    , oIMem

    , oIVcpus

    , oInstMoves

    , oLuxiSocket

    , oMachineReadable

    , oMaxCpu

    , oMaxSolLength

    , oMinDisk

    , oMinGain

    , oMinGainLim

    , oMinScore

    , oNoHeaders

    , oNodeSim

    , oOfflineNode

    , oOutputDir

    , oPrintCommands

    , oPrintInsts

    , oPrintNodes

    , oQuiet

    , oRapiMaster

    , oReplay

    , oSaveCluster

    , oSelInst

    , oShowHelp

    , oShowVer

    , oTieredSpec

    , oVerbose

    ) where

import Control.Monad

import Data.Maybe (fromMaybe)

import qualified Data.Version

import System.Console.GetOpt

import System.IO

import System.Info

import System

import Text.Printf (printf)

import qualified Ganeti.HTools.Version as Version(version)

import qualified Ganeti.Constants as C

import Ganeti.HTools.Types

import Ganeti.HTools.Utils

-- * Constants

-- | The default value for the luxi socket.

--

-- This is re-exported from the "Ganeti.Constants" module.

defaultLuxiSocket :: FilePath

defaultLuxiSocket = C.masterSocket

-- * Data types

-- | Command line options structure.

data Options = Options

    { optDataFile    :: Maybe FilePath -- ^ Path to the cluster data file

    , optDiskMoves   :: Bool           -- ^ Allow disk moves

    , optInstMoves   :: Bool           -- ^ Allow instance moves

    , optDiskTemplate :: DiskTemplate  -- ^ The requested disk template

    , optDynuFile    :: Maybe FilePath -- ^ Optional file with dynamic use data

    , optEvacMode    :: Bool           -- ^ Enable evacuation mode

    , optExInst      :: [String]       -- ^ Instances to be excluded

    , optExTags      :: Maybe [String] -- ^ Tags to use for exclusion

    , optExecJobs    :: Bool           -- ^ Execute the commands via Luxi

    , optGroup       :: Maybe GroupID  -- ^ The UUID of the group to process

    , optSelInst     :: [String]       -- ^ Instances to be excluded

    , optISpec       :: RSpec          -- ^ Requested instance specs

    , optLuxi        :: Maybe FilePath -- ^ Collect data from Luxi

    , optMachineReadable :: Bool       -- ^ Output machine-readable format

    , optMaster      :: String         -- ^ Collect data from RAPI

    , optMaxLength   :: Int            -- ^ Stop after this many steps

    , optMcpu        :: Double         -- ^ Max cpu ratio for nodes

    , optMdsk        :: Double         -- ^ Max disk usage ratio for nodes

    , optMinGain     :: Score          -- ^ Min gain we aim for in a step

    , optMinGainLim  :: Score          -- ^ Limit below which we apply mingain

    , optMinScore    :: Score          -- ^ The minimum score we aim for

    , optNoHeaders   :: Bool           -- ^ Do not show a header line

    , optNodeSim     :: [String]       -- ^ Cluster simulation mode

    , optOffline     :: [String]       -- ^ Names of offline nodes

    , optOutPath     :: FilePath       -- ^ Path to the output directory

    , optSaveCluster :: Maybe FilePath -- ^ Save cluster state to this file

    , optShowCmds    :: Maybe FilePath -- ^ Whether to show the command list

    , optShowHelp    :: Bool           -- ^ Just show the help

    , optShowInsts   :: Bool           -- ^ Whether to show the instance map

    , optShowNodes   :: Maybe [String] -- ^ Whether to show node status

    , optShowVer     :: Bool           -- ^ Just show the program version

    , optTieredSpec  :: Maybe RSpec    -- ^ Requested specs for tiered mode

    , optReplay      :: Maybe String   -- ^ Unittests: RNG state

    , optVerbose     :: Int            -- ^ Verbosity level

    } deriving Show

-- | Default values for the command line options.

defaultOptions :: Options

defaultOptions  = Options

 { optDataFile    = Nothing

 , optDiskMoves   = True

 , optInstMoves   = True

 , optDiskTemplate = DTDrbd8

 , optDynuFile    = Nothing

 , optEvacMode    = False

 , optExInst      = []

 , optExTags      = Nothing

 , optExecJobs    = False

 , optGroup       = Nothing

 , optSelInst     = []

 , optISpec       = RSpec 1 4096 102400

 , optLuxi        = Nothing

 , optMachineReadable = False

 , optMaster      = ""

 , optMaxLength   = -1

 , optMcpu        = defVcpuRatio

 , optMdsk        = defReservedDiskRatio

 , optMinGain     = 1e-2

 , optMinGainLim  = 1e-1

 , optMinScore    = 1e-9

 , optNoHeaders   = False

 , optNodeSim     = []

 , optOffline     = []

 , optOutPath     = "."

 , optSaveCluster = Nothing

 , optShowCmds    = Nothing

 , optShowHelp    = False

 , optShowInsts   = False

 , optShowNodes   = Nothing

 , optShowVer     = False

 , optTieredSpec  = Nothing

 , optReplay      = Nothing

 , optVerbose     = 1

 }

-- | Abrreviation for the option type.

type OptType = OptDescr (Options -> Result Options)

-- * Command line options

oDataFile :: OptType

oDataFile = Option "t" ["text-data"]

            (ReqArg (\ f o -> Ok o { optDataFile = Just f }) "FILE")

            "the cluster data FILE"

oDiskMoves :: OptType

oDiskMoves = Option "" ["no-disk-moves"]

             (NoArg (\ opts -> Ok opts { optDiskMoves = False}))

             "disallow disk moves from the list of allowed instance changes,\

             \ thus allowing only the 'cheap' failover/migrate operations"

oDiskTemplate :: OptType

oDiskTemplate = Option "" ["disk-template"]

                (ReqArg (\ t opts -> do

                           dt <- diskTemplateFromString t

                           return $ opts { optDiskTemplate = dt }) "TEMPLATE")

                "select the desired disk template"

oSelInst :: OptType

oSelInst = Option "" ["select-instances"]

          (ReqArg (\ f opts -> Ok opts { optSelInst = sepSplit ',' f }) "INSTS")

          "only select given instances for any moves"

oInstMoves :: OptType

oInstMoves = Option "" ["no-instance-moves"]

             (NoArg (\ opts -> Ok opts { optInstMoves = False}))

             "disallow instance (primary node) moves from the list of allowed,\

             \ instance changes, thus allowing only slower, but sometimes\

             \ safer, drbd secondary changes"

oDynuFile :: OptType

oDynuFile = Option "U" ["dynu-file"]

            (ReqArg (\ f opts -> Ok opts { optDynuFile = Just f }) "FILE")

            "Import dynamic utilisation data from the given FILE"

oEvacMode :: OptType

oEvacMode = Option "E" ["evac-mode"]

            (NoArg (\opts -> Ok opts { optEvacMode = True }))

            "enable evacuation mode, where the algorithm only moves \

            \ instances away from offline and drained nodes"

oExInst :: OptType

oExInst = Option "" ["exclude-instances"]

          (ReqArg (\ f opts -> Ok opts { optExInst = sepSplit ',' f }) "INSTS")

          "exclude given instances from any moves"

oExTags :: OptType

oExTags = Option "" ["exclusion-tags"]

            (ReqArg (\ f opts -> Ok opts { optExTags = Just $ sepSplit ',' f })

             "TAG,...") "Enable instance exclusion based on given tag prefix"

oExecJobs :: OptType

oExecJobs = Option "X" ["exec"]

             (NoArg (\ opts -> Ok opts { optExecJobs = True}))

             "execute the suggested moves via Luxi (only available when using\

             \ it for data gathering)"

oGroup :: OptType

oGroup = Option "G" ["group"]

            (ReqArg (\ f o -> Ok o { optGroup = Just f }) "ID")

            "the ID of the group to balance"

oIDisk :: OptType

oIDisk = Option "" ["disk"]

         (ReqArg (\ d opts -> do

                    dsk <- annotateResult "--disk option" (parseUnit d)

                    let ospec = optISpec opts

                        nspec = ospec { rspecDsk = dsk }

                    return $ opts { optISpec = nspec }) "DISK")

         "disk size for instances"

oIMem :: OptType

oIMem = Option "" ["memory"]

        (ReqArg (\ m opts -> do

                   mem <- annotateResult "--memory option" (parseUnit m)

                   let ospec = optISpec opts

                       nspec = ospec { rspecMem = mem }

                   return $ opts { optISpec = nspec }) "MEMORY")

        "memory size for instances"

oIVcpus :: OptType

oIVcpus = Option "" ["vcpus"]

          (ReqArg (\ p opts -> do

                     vcpus <- tryRead "--vcpus option" p

                     let ospec = optISpec opts

                         nspec = ospec { rspecCpu = vcpus }

                     return $ opts { optISpec = nspec }) "NUM")

          "number of virtual cpus for instances"

oLuxiSocket :: OptType

oLuxiSocket = Option "L" ["luxi"]

              (OptArg ((\ f opts -> Ok opts { optLuxi = Just f }) .

                       fromMaybe defaultLuxiSocket) "SOCKET")

              "collect data via Luxi, optionally using the given SOCKET path"

oMachineReadable :: OptType

oMachineReadable = Option "" ["machine-readable"]

          (OptArg (\ f opts -> do

                     flag <- parseYesNo True f

                     return $ opts { optMachineReadable = flag }) "CHOICE")

          "enable machine readable output (pass either 'yes' or 'no' to\

          \ explicitely control the flag, or without an argument defaults to\

          \ yes"

oMaxCpu :: OptType

oMaxCpu = Option "" ["max-cpu"]

          (ReqArg (\ n opts -> Ok opts { optMcpu = read n }) "RATIO")

          "maximum virtual-to-physical cpu ratio for nodes (from 1\

          \ upwards) [64]"

oMaxSolLength :: OptType

oMaxSolLength = Option "l" ["max-length"]

                (ReqArg (\ i opts -> Ok opts { optMaxLength = read i }) "N")

                "cap the solution at this many balancing or allocation \

                \ rounds (useful for very unbalanced clusters or empty \

                \ clusters)"

oMinDisk :: OptType

oMinDisk = Option "" ["min-disk"]

           (ReqArg (\ n opts -> Ok opts { optMdsk = read n }) "RATIO")

           "minimum free disk space for nodes (between 0 and 1) [0]"

oMinGain :: OptType

oMinGain = Option "g" ["min-gain"]

            (ReqArg (\ g opts -> Ok opts { optMinGain = read g }) "DELTA")

            "minimum gain to aim for in a balancing step before giving up"

oMinGainLim :: OptType

oMinGainLim = Option "" ["min-gain-limit"]

            (ReqArg (\ g opts -> Ok opts { optMinGainLim = read g }) "SCORE")

            "minimum cluster score for which we start checking the min-gain"

oMinScore :: OptType

oMinScore = Option "e" ["min-score"]

            (ReqArg (\ e opts -> Ok opts { optMinScore = read e }) "EPSILON")

            "mininum score to aim for"

oNoHeaders :: OptType

oNoHeaders = Option "" ["no-headers"]

             (NoArg (\ opts -> Ok opts { optNoHeaders = True }))

             "do not show a header line"

oNodeSim :: OptType

oNodeSim = Option "" ["simulate"]

            (ReqArg (\ f o -> Ok o { optNodeSim = f:optNodeSim o }) "SPEC")

            "simulate an empty cluster, given as 'num_nodes,disk,ram,cpu'"

oOfflineNode :: OptType

oOfflineNode = Option "O" ["offline"]

               (ReqArg (\ n o -> Ok o { optOffline = n:optOffline o }) "NODE")

               "set node as offline"

oOutputDir :: OptType

oOutputDir = Option "d" ["output-dir"]

             (ReqArg (\ d opts -> Ok opts { optOutPath = d }) "PATH")

             "directory in which to write output files"

oPrintCommands :: OptType

oPrintCommands = Option "C" ["print-commands"]

                 (OptArg ((\ f opts -> Ok opts { optShowCmds = Just f }) .

                          fromMaybe "-")

                  "FILE")

                 "print the ganeti command list for reaching the solution,\

                 \ if an argument is passed then write the commands to a\

                 \ file named as such"

oPrintInsts :: OptType

oPrintInsts = Option "" ["print-instances"]

              (NoArg (\ opts -> Ok opts { optShowInsts = True }))

              "print the final instance map"

oPrintNodes :: OptType

oPrintNodes = Option "p" ["print-nodes"]

              (OptArg ((\ f opts ->

                            let (prefix, realf) = case f of

                                  '+':rest -> (["+"], rest)

                                  _ -> ([], f)

                                splitted = prefix ++ sepSplit ',' realf

                            in Ok opts { optShowNodes = Just splitted }) .

                       fromMaybe []) "FIELDS")

              "print the final node list"

oQuiet :: OptType

oQuiet = Option "q" ["quiet"]

         (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts - 1 }))

         "decrease the verbosity level"

oRapiMaster :: OptType

oRapiMaster = Option "m" ["master"]

              (ReqArg (\ m opts -> Ok opts { optMaster = m }) "ADDRESS")

              "collect data via RAPI at the given ADDRESS"

oSaveCluster :: OptType

oSaveCluster = Option "S" ["save"]

            (ReqArg (\ f opts -> Ok opts { optSaveCluster = Just f }) "FILE")

            "Save cluster state at the end of the processing to FILE"

oShowHelp :: OptType

oShowHelp = Option "h" ["help"]

            (NoArg (\ opts -> Ok opts { optShowHelp = True}))

            "show help"

oShowVer :: OptType

oShowVer = Option "V" ["version"]

           (NoArg (\ opts -> Ok opts { optShowVer = True}))

           "show the version of the program"

oTieredSpec :: OptType

oTieredSpec = Option "" ["tiered-alloc"]

             (ReqArg (\ inp opts -> do

                          let sp = sepSplit ',' inp

                          prs <- mapM (\(fn, val) -> fn val) $

                                 zip [ annotateResult "tiered specs memory" .

                                       parseUnit

                                     , annotateResult "tiered specs disk" .

                                       parseUnit

                                     , tryRead "tiered specs cpus"

                                     ] sp

                          tspec <-

                              case prs of

                                [dsk, ram, cpu] -> return $ RSpec cpu ram dsk

                                _ -> Bad $ "Invalid specification: " ++ inp ++

                                     ", expected disk,ram,cpu"

                          return $ opts { optTieredSpec = Just tspec } )

              "TSPEC")

             "enable tiered specs allocation, given as 'disk,ram,cpu'"

oReplay :: OptType

oReplay = Option "" ["replay"]

          (ReqArg (\ stat opts -> Ok opts { optReplay = Just stat } ) "STATE")

          "Pre-seed the random number generator with STATE"

oVerbose :: OptType

oVerbose = Option "v" ["verbose"]

           (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts + 1 }))

           "increase the verbosity level"

-- * Functions

-- | Helper for parsing a yes\/no command line flag.

parseYesNo :: Bool         -- ^ Default whalue (when we get a @Nothing@)

           -> Maybe String -- ^ Parameter value

           -> Result Bool  -- ^ Resulting boolean value

parseYesNo v Nothing      = return v

parseYesNo _ (Just "yes") = return True

parseYesNo _ (Just "no")  = return False

parseYesNo _ (Just s)     = fail $ "Invalid choice '" ++ s ++

                            "', pass one of 'yes' or 'no'"

-- | Usage info.

usageHelp :: String -> [OptType] -> String

usageHelp progname =

    usageInfo (printf "%s %s\nUsage: %s [OPTION...]"

               progname Version.version progname)

-- | Command line parser, using the 'Options' structure.

parseOpts :: [String]               -- ^ The command line arguments

          -> String                 -- ^ The program name

          -> [OptType]              -- ^ The supported command line options

          -> IO (Options, [String]) -- ^ The resulting options and leftover

                                    -- arguments

parseOpts argv progname options =

    case getOpt Permute options argv of

      (o, n, []) ->

          do

            let (pr, args) = (foldM (flip id) defaultOptions o, n)

            po <- (case pr of

                     Bad msg -> do

                       hPutStrLn stderr "Error while parsing command\

                                        \line arguments:"

                       hPutStrLn stderr msg

                       exitWith $ ExitFailure 1

                     Ok val -> return val)

            when (optShowHelp po) $ do

              putStr $ usageHelp progname options

              exitWith ExitSuccess

            when (optShowVer po) $ do

              printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"

                     progname Version.version

                     compilerName (Data.Version.showVersion compilerVersion)

                     os arch :: IO ()

              exitWith ExitSuccess

            return (po, args)

      (_, _, errs) -> do

        hPutStrLn stderr $ "Command line error: "  ++ concat errs

        hPutStrLn stderr $ usageHelp progname options

        exitWith $ ExitFailure 2

-- | A shell script template for autogenerated scripts.

shTemplate :: String

shTemplate =

    printf "#!/bin/sh\n\n\

           \# Auto-generated script for executing cluster rebalancing\n\n\

           \# To stop, touch the file /tmp/stop-htools\n\n\

           \set -e\n\n\

           \check() {\n\

           \  if [ -f /tmp/stop-htools ]; then\n\

           \    echo 'Stop requested, exiting'\n\

           \    exit 0\n\

           \  fi\n\

           \}\n\n"

-- | Optionally print the node list.

maybePrintNodes :: Maybe [String]       -- ^ The field list

                -> String               -- ^ Informational message

                -> ([String] -> String) -- ^ Function to generate the listing

                -> IO ()

maybePrintNodes Nothing _ _ = return ()

maybePrintNodes (Just fields) msg fn = do

  hPutStrLn stderr ""

  hPutStrLn stderr (msg ++ " status:")

  hPutStrLn stderr $ fn fields

-- | Optionally print the instance list.

maybePrintInsts :: Bool   -- ^ Whether to print the instance list

                -> String -- ^ Type of the instance map (e.g. initial)

                -> String -- ^ The instance data

                -> IO ()

maybePrintInsts do_print msg instdata =

  when do_print $ do

    hPutStrLn stderr ""

    hPutStrLn stderr $ msg ++ " instance map:"

    hPutStr stderr instdata

-- | Function to display warning messages from parsing the cluster

-- state.

maybeShowWarnings :: [String] -- ^ The warning messages

                  -> IO ()

maybeShowWarnings fix_msgs =

  unless (null fix_msgs) $ do

    hPutStrLn stderr "Warning: cluster has inconsistent data:"

    hPutStrLn stderr . unlines . map (printf "  - %s") $ fix_msgs