( Options(..)
, OptType
, parseOpts
- , parseEnv
, shTemplate
- , loadExternalData
- , defaultLuxiSocket
-- * The options
, oPrintNodes
, oPrintCommands
, oINodes
, oMaxCpu
, oMinDisk
+ , oDiskMoves
, oShowVer
, oShowHelp
) where
-import Control.Exception
-import Data.Maybe (isJust, fromJust, fromMaybe)
+import Data.Maybe (fromMaybe)
import qualified Data.Version
import Monad
import System.Console.GetOpt
-import System.Posix.Env
import System.IO
import System.Info
import System
-import Text.Printf (printf, hPrintf)
+import Text.Printf (printf)
import qualified Ganeti.HTools.Version as Version(version)
-import qualified Ganeti.HTools.Luxi as Luxi
-import qualified Ganeti.HTools.Rapi as Rapi
-import qualified Ganeti.HTools.Simu as Simu
-import qualified Ganeti.HTools.Text as Text
-import qualified Ganeti.HTools.Loader as Loader
-import qualified Ganeti.HTools.Instance as Instance
-import qualified Ganeti.HTools.Node as Node
import qualified Ganeti.HTools.Cluster as Cluster
-import Ganeti.HTools.Types
-
-- | The default value for the luxi socket
defaultLuxiSocket :: FilePath
defaultLuxiSocket = "/var/run/ganeti/socket/ganeti-master"
, optMinScore :: Cluster.Score -- ^ The minimum score we aim for
, optMcpu :: Double -- ^ Max cpu ratio for nodes
, optMdsk :: Double -- ^ Max disk usage ratio for nodes
+ , optDiskMoves :: Bool -- ^ Allow disk moves
, optVerbose :: Int -- ^ Verbosity level
, optShowVer :: Bool -- ^ Just show the program version
, optShowHelp :: Bool -- ^ Just show the help
, optMinScore = 1e-9
, optMcpu = -1
, optMdsk = -1
+ , optDiskMoves = True
, optVerbose = 1
, optShowVer = False
, optShowHelp = False
(ReqArg (\ n opts -> opts { optMdsk = read n }) "RATIO")
"minimum free disk space for nodes (between 0 and 1)"
+oDiskMoves :: OptType
+oDiskMoves = Option "" ["no-disk-moves"]
+ (NoArg (\ opts -> opts { optDiskMoves = False}))
+ "disallow disk moves from the list of allowed instance changes,\
+ \ thus allowing only the 'cheap' failover/migrate operations"
+
oShowVer :: OptType
oShowVer = Option "V" ["version"]
(NoArg (\ opts -> opts { optShowVer = True}))
hPutStrLn stderr $ usageHelp progname options
exitWith $ ExitFailure 2
--- | Parse the environment and return the node\/instance names.
---
--- This also hardcodes here the default node\/instance file names.
-parseEnv :: () -> IO (String, String)
-parseEnv () = do
- a <- getEnvDefault "HTOOLS_NODES" "nodes"
- b <- getEnvDefault "HTOOLS_INSTANCES" "instances"
- return (a, b)
-
-- | A shell script template for autogenerated scripts.
shTemplate :: String
shTemplate =
\ exit 0\n\
\ fi\n\
\}\n\n"
-
--- | Error beautifier
-wrapIO :: IO (Result a) -> IO (Result a)
-wrapIO act =
- handle (\e -> return $ Bad $ show e)
- act
-
--- | External tool data loader from a variety of sources.
-loadExternalData :: Options
- -> IO (Node.List, Instance.List, String)
-loadExternalData opts = do
- (env_node, env_inst) <- parseEnv ()
- let nodef = if optNodeSet opts then optNodeFile opts
- else env_node
- instf = if optInstSet opts then optInstFile opts
- else env_inst
- mhost = optMaster opts
- lsock = optLuxi opts
- simdata = optNodeSim opts
- setRapi = mhost /= ""
- setLuxi = isJust lsock
- setSim = isJust simdata
- setFiles = optNodeSet opts || optInstSet opts
- allSet = filter id [setRapi, setLuxi, setFiles]
- when (length allSet > 1) $
- do
- hPutStrLn stderr "Error: Only one of the rapi, luxi, and data\
- \ files options should be given."
- exitWith $ ExitFailure 1
-
- input_data <-
- case () of
- _ | setRapi -> wrapIO $ Rapi.loadData mhost
- | setLuxi -> wrapIO $ Luxi.loadData $ fromJust lsock
- | setSim -> Simu.loadData $ fromJust simdata
- | otherwise -> wrapIO $ Text.loadData nodef instf
-
- let ldresult = input_data >>= Loader.mergeData
- (loaded_nl, il, csf) <-
- (case ldresult of
- Ok x -> return x
- Bad s -> do
- hPrintf stderr "Error: failed to load data. Details:\n%s\n" s
- exitWith $ ExitFailure 1
- )
- let (fix_msgs, fixed_nl) = Loader.checkData loaded_nl il
-
- unless (null fix_msgs || optVerbose opts == 0) $ do
- hPutStrLn stderr "Warning: cluster has inconsistent data:"
- hPutStrLn stderr . unlines . map (printf " - %s") $ fix_msgs
-
- return (fixed_nl, il, csf)