hbal: Implement grouping of moves into jobsets

[ganeti-local] / Ganeti / HTools / CLI.hs

diff --git a/Ganeti/HTools/CLI.hs b/Ganeti/HTools/CLI.hs
index 5bd47ad..e53e080 100644 (file)
--- a/Ganeti/HTools/CLI.hs
+++ b/Ganeti/HTools/CLI.hs
@@ -31,10 +31,7 @@ module Ganeti.HTools.CLI
     ( Options(..)
     , OptType
     , parseOpts
-    , parseEnv
     , shTemplate
-    , loadExternalData
-    , defaultLuxiSocket
     -- * The options
     , oPrintNodes
     , oPrintCommands
@@ -57,33 +54,23 @@ module Ganeti.HTools.CLI
     , 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"
@@ -111,6 +98,7 @@ data Options = Options
     , 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
@@ -140,6 +128,7 @@ defaultOptions  = Options
  , optMinScore  = 1e-9
  , optMcpu      = -1
  , optMdsk      = -1
+ , optDiskMoves = True
  , optVerbose   = 1
  , optShowVer   = False
  , optShowHelp  = False
@@ -259,6 +248,12 @@ oMinDisk = Option "" ["min-disk"]
            (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}))
@@ -301,15 +296,6 @@ parseOpts argv progname options =
         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 =
@@ -323,55 +309,3 @@ 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)