+{-# LANGUAGE CPP #-}
+
{-| External data loader
This module holds the external data loading, and thus is the only one
-depending (via the specialized Text/Rapi/Luxi modules) on the actual
+depending (via the specialized Text\/Rapi\/Luxi modules) on the actual
libraries implementing the low-level protocols.
-}
( loadExternalData
) where
-import Control.Exception
import Data.Maybe (isJust, fromJust)
import Monad
-import System.Posix.Env
import System.IO
import System
import Text.Printf (printf, hPrintf)
import qualified Ganeti.HTools.Luxi as Luxi
+#ifndef NO_CURL
import qualified Ganeti.HTools.Rapi as Rapi
+#endif
import qualified Ganeti.HTools.Simu as Simu
import qualified Ganeti.HTools.Text as Text
import qualified Ganeti.HTools.Loader as Loader
import Ganeti.HTools.Types
import Ganeti.HTools.CLI
-
--- | 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)
+import Ganeti.HTools.Utils (sepSplit, tryRead)
-- | Error beautifier
wrapIO :: IO (Result a) -> IO (Result a)
-wrapIO = handle (return . Bad . show)
+wrapIO = flip catch (return . Bad . show)
+
+parseUtilisation :: String -> Result (String, DynUtil)
+parseUtilisation line =
+ let columns = sepSplit ' ' line
+ in case columns of
+ [name, cpu, mem, dsk, net] -> do
+ rcpu <- tryRead name cpu
+ rmem <- tryRead name mem
+ rdsk <- tryRead name dsk
+ rnet <- tryRead name net
+ let du = DynUtil { cpuWeight = rcpu, memWeight = rmem
+ , dskWeight = rdsk, netWeight = rnet }
+ return (name, du)
+ _ -> Bad $ "Cannot parse line " ++ line
-- | External tool data loader from a variety of sources.
loadExternalData :: Options
- -> IO (Node.List, Instance.List, String)
+ -> IO (Node.List, Instance.List, [String], 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
+ let mhost = optMaster opts
lsock = optLuxi opts
+ tfile = optDataFile opts
simdata = optNodeSim opts
setRapi = mhost /= ""
setLuxi = isJust lsock
setSim = isJust simdata
- setFiles = optNodeSet opts || optInstSet opts
- allSet = filter id [setRapi, setLuxi, setFiles]
+ setFile = isJust tfile
+ allSet = filter id [setRapi, setLuxi, setFile]
+ exTags = case optExTags opts of
+ Nothing -> []
+ Just etl -> map (++ ":") etl
+ exInsts = optExInst opts
+
when (length allSet > 1) $
do
- hPutStrLn stderr "Error: Only one of the rapi, luxi, and data\
- \ files options should be given."
+ hPutStrLn stderr ("Error: Only one of the rapi, luxi, and data" ++
+ " files options should be given.")
exitWith $ ExitFailure 1
+ util_contents <- (case optDynuFile opts of
+ Just path -> readFile path
+ Nothing -> return "")
+ let util_data = mapM parseUtilisation $ lines util_contents
+ util_data' <- (case util_data of
+ Ok x -> return x
+ Bad y -> do
+ hPutStrLn stderr ("Error: can't parse utilisation" ++
+ " data: " ++ show y)
+ exitWith $ ExitFailure 1)
input_data <-
case () of
- _ | setRapi -> wrapIO $ Rapi.loadData mhost
+ _ | setRapi ->
+#ifdef NO_CURL
+ return $ Bad "RAPI/curl backend disabled at compile time"
+#else
+ wrapIO $ Rapi.loadData mhost
+#endif
| setLuxi -> wrapIO $ Luxi.loadData $ fromJust lsock
| setSim -> Simu.loadData $ fromJust simdata
- | otherwise -> wrapIO $ Text.loadData nodef instf
+ | setFile -> wrapIO $ Text.loadData $ fromJust tfile
+ | otherwise -> return $ Bad "No backend selected! Exiting."
- let ldresult = input_data >>= Loader.mergeData
- (loaded_nl, il, csf) <-
+ let ldresult = input_data >>= Loader.mergeData util_data' exTags exInsts
+ (loaded_nl, il, tags, csf) <-
(case ldresult of
Ok x -> return x
Bad s -> do
hPrintf stderr "Error: failed to load data. Details:\n%s\n" s
+ :: IO ()
exitWith $ ExitFailure 1
)
let (fix_msgs, fixed_nl) = Loader.checkData loaded_nl il
hPutStrLn stderr "Warning: cluster has inconsistent data:"
hPutStrLn stderr . unlines . map (printf " - %s") $ fix_msgs
- return (fixed_nl, il, csf)
+ return (fixed_nl, il, tags, csf)