diff --git a/Ganeti/HTools/Cluster.hs b/Ganeti/HTools/Cluster.hs
index f4cd7661e63d7fdff57282bdc6135daa29f9be56..856667e83c75d6c436ffc54848169c5e5d717424 100644
--- a/Ganeti/HTools/Cluster.hs
+++ b/Ganeti/HTools/Cluster.hs
@@ -770,12 +770,12 @@ printStats nl =
in intercalate ", " formatted
-- | Convert a placement into a list of OpCodes (basically a job).
-iMoveToJob :: String -> Node.List -> Instance.List
+iMoveToJob :: Node.List -> Instance.List
-> Idx -> IMove -> [OpCodes.OpCode]
-iMoveToJob csf nl il idx move =
+iMoveToJob nl il idx move =
let inst = Container.find idx il
- iname = Instance.name inst ++ csf
- lookNode n = Just (Container.nameOf nl n ++ csf)
+ iname = Instance.name inst
+ lookNode = Just . Container.nameOf nl
opF = if Instance.running inst
then OpCodes.OpMigrateInstance iname True False
else OpCodes.OpFailoverInstance iname False
diff --git a/Ganeti/HTools/ExtLoader.hs b/Ganeti/HTools/ExtLoader.hs
index 0d72d6f9095c1a307b9e06a095019423da8c4458..41c84539917486f03d2e9bb4cdff54c7fa419d5a 100644
--- a/Ganeti/HTools/ExtLoader.hs
+++ b/Ganeti/HTools/ExtLoader.hs
@@ -31,6 +31,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
module Ganeti.HTools.ExtLoader
( loadExternalData
+ , Loader.commonSuffix
) where
import Data.Maybe (isJust, fromJust)
@@ -73,7 +74,7 @@ parseUtilisation line =
-- | External tool data loader from a variety of sources.
loadExternalData :: Options
- -> IO (Node.List, Instance.List, [String], String)
+ -> IO (Node.List, Instance.List, [String])
loadExternalData opts = do
let mhost = optMaster opts
lsock = optLuxi opts
@@ -119,7 +120,7 @@ loadExternalData opts = do
| otherwise -> return $ Bad "No backend selected! Exiting."
let ldresult = input_data >>= Loader.mergeData util_data' exTags exInsts
- (loaded_nl, il, tags, csf) <-
+ (loaded_nl, il, tags) <-
(case ldresult of
Ok x -> return x
Bad s -> do
@@ -133,4 +134,4 @@ loadExternalData opts = do
hPutStrLn stderr "Warning: cluster has inconsistent data:"
hPutStrLn stderr . unlines . map (printf " - %s") $ fix_msgs
- return (fixed_nl, il, tags, csf)
+ return (fixed_nl, il, tags)
diff --git a/Ganeti/HTools/IAlloc.hs b/Ganeti/HTools/IAlloc.hs
index 3083578878e8e40bebfa2c2eaeddbbda5ec76bf1..eb2b4fa4776efe6b690e60460ada228514862d82 100644
--- a/Ganeti/HTools/IAlloc.hs
+++ b/Ganeti/HTools/IAlloc.hs
@@ -113,7 +113,7 @@ parseData body = do
let (kti, il) = assignIndices iobj
-- cluster tags
ctags <- fromObj "cluster_tags" obj
- (map_n, map_i, ptags, csf) <- mergeData [] [] [] (nl, il, ctags)
+ (map_n, map_i, ptags) <- mergeData [] [] [] (nl, il, ctags)
optype <- fromObj "type" request
rqtype <-
case optype of
@@ -130,45 +130,41 @@ parseData body = do
ridx <- lookupInstance kti rname
req_nodes <- fromObj "required_nodes" request
ex_nodes <- fromObj "relocate_from" request
- let ex_nodes' = map (stripSuffix $ length csf) ex_nodes
- ex_idex <- mapM (Container.findByName map_n) ex_nodes'
+ ex_idex <- mapM (Container.findByName map_n) ex_nodes
return $ Relocate ridx req_nodes (map Node.idx ex_idex)
"multi-evacuate" ->
do
ex_names <- fromObj "evac_nodes" request
- let ex_names' = map (stripSuffix $ length csf) ex_names
- ex_nodes <- mapM (Container.findByName map_n) ex_names'
+ ex_nodes <- mapM (Container.findByName map_n) ex_names
let ex_ndx = map Node.idx ex_nodes
return $ Evacuate ex_ndx
other -> fail ("Invalid request type '" ++ other ++ "'")
- return $ Request rqtype map_n map_i ptags csf
+ return $ Request rqtype map_n map_i ptags
-- | Format the result
-formatRVal :: String -> RqType -> [Node.AllocElement] -> JSValue
-formatRVal _ _ [] = JSArray []
+formatRVal :: RqType -> [Node.AllocElement] -> JSValue
+formatRVal _ [] = JSArray []
-formatRVal csf (Evacuate _) elems =
- let sols = map (\(_, inst, nl) ->
- let names = Instance.name inst : map Node.name nl
- in map (++ csf) names) elems
+formatRVal (Evacuate _) elems =
+ let sols = map (\(_, inst, nl) -> Instance.name inst : map Node.name nl)
+ elems
jsols = map (JSArray . map (JSString . toJSString)) sols
in JSArray jsols
-formatRVal csf _ elems =
+formatRVal _ elems =
let (_, _, nodes) = head elems
- nodes' = map ((++ csf) . Node.name) nodes
+ nodes' = map Node.name nodes
in JSArray $ map (JSString . toJSString) nodes'
-- | Formats the response into a valid IAllocator response message.
formatResponse :: Bool -- ^ Whether the request was successful
-> String -- ^ Information text
- -> String -- ^ Suffix for nodes and instances
-> RqType -- ^ Request type
-> [Node.AllocElement] -- ^ The resulting allocations
-> String -- ^ The JSON-formatted message
-formatResponse success info csf rq elems =
+formatResponse success info rq elems =
let
e_success = ("success", JSBool success)
e_info = ("info", JSString . toJSString $ info)
- e_nodes = ("nodes", formatRVal csf rq elems)
+ e_nodes = ("nodes", formatRVal rq elems)
in encodeStrict $ makeObj [e_success, e_info, e_nodes]
diff --git a/Ganeti/HTools/Instance.hs b/Ganeti/HTools/Instance.hs
index f6ec30867a0dbc1426d5168913e665a26e051515..76faf368cba805b47aef1f157a8e5c08dba4c064 100644
--- a/Ganeti/HTools/Instance.hs
+++ b/Ganeti/HTools/Instance.hs
@@ -65,10 +65,10 @@ data Instance = Instance { name :: String -- ^ The instance name
} deriving (Show)
instance T.Element Instance where
- nameOf = name
- idxOf = idx
- setName = setName
- setIdx = setIdx
+ nameOf = name
+ idxOf = idx
+ setAlias = setAlias
+ setIdx = setIdx
-- | Running instance states.
runningStates :: [String]
diff --git a/Ganeti/HTools/Loader.hs b/Ganeti/HTools/Loader.hs
index 33e49f01b9358d90c5952b49a1a938f54d17525c..1e65d54ab8db61e2315bb6ef2dcf9ff61e76b4d4 100644
--- a/Ganeti/HTools/Loader.hs
+++ b/Ganeti/HTools/Loader.hs
@@ -32,7 +32,7 @@ module Ganeti.HTools.Loader
, assignIndices
, lookupNode
, lookupInstance
- , stripSuffix
+ , commonSuffix
, RqType(..)
, Request(..)
) where
@@ -70,7 +70,7 @@ data RqType
deriving (Show)
-- | A complete request, as received from Ganeti.
-data Request = Request RqType Node.List Instance.List [String] String
+data Request = Request RqType Node.List Instance.List [String]
deriving (Show)
-- * Functions
@@ -147,16 +147,19 @@ longestDomain (x:xs) =
else accu)
"" $ filter (isPrefixOf ".") (tails x)
--- | Remove tail suffix from a string.
-stripSuffix :: Int -> String -> String
-stripSuffix sflen name = take (length name - sflen) name
-
-- | Extracts the exclusion tags from the cluster configuration
extractExTags :: [String] -> [String]
extractExTags =
map (drop (length exTagsPrefix)) .
filter (isPrefixOf exTagsPrefix)
+-- | Extracts the common suffix from node/instance names
+commonSuffix :: Node.List -> Instance.List -> String
+commonSuffix nl il =
+ let node_names = map Node.name $ Container.elems nl
+ inst_names = map Instance.name $ Container.elems il
+ in longestDomain (node_names ++ inst_names)
+
-- | Initializer function that loads the data from a node and instance
-- list and massages it into the correct format.
mergeData :: [(String, DynUtil)] -- ^ Instance utilisation data
@@ -164,7 +167,7 @@ mergeData :: [(String, DynUtil)] -- ^ Instance utilisation data
-> [String] -- ^ Untouchable instances
-> (Node.AssocList, Instance.AssocList, [String])
-- ^ Data from backends
- -> Result (Node.List, Instance.List, [String], String)
+ -> Result (Node.List, Instance.List, [String])
mergeData um extags exinsts (nl, il, tags) =
let il2 = Container.fromAssocList il
il3 = foldl' (\im (name, n_util) ->
@@ -183,13 +186,12 @@ mergeData um extags exinsts (nl, il, tags) =
node_names = map (Node.name . snd) nl
inst_names = map (Instance.name . snd) il
common_suffix = longestDomain (node_names ++ inst_names)
- csl = length common_suffix
- snl = Container.map (\n -> setName n (stripSuffix csl $ nameOf n)) nl3
- sil = Container.map (\i -> setName i (stripSuffix csl $ nameOf i)) il4
+ snl = Container.map (computeAlias common_suffix) nl3
+ sil = Container.map (computeAlias common_suffix) il4
in if not $ all (`elem` inst_names) exinsts
then Bad $ "Some of the excluded instances are unknown: " ++
show (exinsts \\ inst_names)
- else Ok (snl, sil, tags, common_suffix)
+ else Ok (snl, sil, tags)
-- | Checks the cluster data for consistency.
checkData :: Node.List -> Instance.List
diff --git a/Ganeti/HTools/Node.hs b/Ganeti/HTools/Node.hs
index 1848557f075e41f9edfcb1eec33e258a520e1340..3dd0275ad49a19a4d39eaf5166e61cc0203d857f 100644
--- a/Ganeti/HTools/Node.hs
+++ b/Ganeti/HTools/Node.hs
@@ -33,7 +33,6 @@ module Ganeti.HTools.Node
-- ** Finalization after data loading
, buildPeers
, setIdx
- , setName
, setAlias
, setOffline
, setXmem
@@ -123,7 +122,7 @@ data Node = Node
instance T.Element Node where
nameOf = name
idxOf = idx
- setName = setName
+ setAlias = setAlias
setIdx = setIdx
-- | A simple name for the int, node association list.
@@ -227,12 +226,6 @@ mCpuTohiCpu mval tcpu = floor (mval * tcpu)
setIdx :: Node -> T.Ndx -> Node
setIdx t i = t {idx = i}
--- | Changes the name.
---
--- This is used only during the building of the data structures.
-setName :: Node -> String -> Node
-setName t s = t { name = s, alias = s }
-
-- | Changes the alias.
--
-- This is used only during the building of the data structures.
@@ -435,7 +428,8 @@ availCpu t =
showField :: Node -> String -> String
showField t field =
case field of
- "name" -> name t
+ "name" -> alias t
+ "fqdn" -> name t
"status" -> if offline t then "-"
else if failN1 t then "*" else " "
"tmem" -> printf "%5.0f" $ tMem t
@@ -471,6 +465,7 @@ showHeader :: String -> (String, Bool)
showHeader field =
case field of
"name" -> ("Name", False)
+ "fqdn" -> ("Name", False)
"status" -> ("F", False)
"tmem" -> ("t_mem", True)
"nmem" -> ("n_mem", True)
diff --git a/Ganeti/HTools/Types.hs b/Ganeti/HTools/Types.hs
index 3cc8d53831a1b86244b99b94b48ad90a23709ed0..9fc409c315ba1f4077a7fd2e71f91f12ad5b229e 100644
--- a/Ganeti/HTools/Types.hs
+++ b/Ganeti/HTools/Types.hs
@@ -194,7 +194,13 @@ class Element a where
nameOf :: a -> String
-- | Returns the index of the element
idxOf :: a -> Int
- -- | Updates the name of the element
- setName :: a -> String -> a
+ -- | Updates the alias of the element
+ setAlias :: a -> String -> a
+ -- | Compute the alias by stripping a given suffix (domain) from
+ -- | the name
+ computeAlias :: String -> a -> a
+ computeAlias dom e = setAlias e alias
+ where alias = take (length name - length dom) name
+ name = nameOf e
-- | Updates the index of the element
setIdx :: a -> Int -> a
diff --git a/hail.hs b/hail.hs
index 886b07101451eec3b464294aa113071642a67dc1..d67bd68394d66e749b853fb0a607f53b4631ab95 100644
--- a/hail.hs
+++ b/hail.hs
@@ -72,7 +72,7 @@ processResults _ as@(fstats, successes, sols) =
processRequest :: Request
-> Result Cluster.AllocSolution
processRequest request =
- let Request rqtype nl il _ _ = request
+ let Request rqtype nl il _ = request
in case rqtype of
Allocate xi reqn -> Cluster.tryAlloc nl il xi reqn
Relocate idx reqn exnodes -> Cluster.tryReloc nl il idx reqn exnodes
@@ -98,7 +98,7 @@ main = do
exitWith $ ExitFailure 1
Ok rq -> return rq
- let Request rq nl _ _ csf = request
+ let Request rq nl _ _ = request
when (isJust shownodes) $ do
hPutStrLn stderr "Initial cluster status:"
@@ -110,5 +110,5 @@ main = do
Ok (ginfo, (_, _, sn)) -> (True, "Request successful: " ++ ginfo,
map snd sn)
Bad s -> (False, "Request failed: " ++ s, [])
- resp = formatResponse ok info csf rq rn
+ resp = formatResponse ok info rq rn
putStrLn resp
diff --git a/hbal.hs b/hbal.hs
index d15407afbb5c9269d2dba1cb2e0d09087a6cf4dd..b6113bdca653a5d0c656af6b6e628f3246e5f388 100644
--- a/hbal.hs
+++ b/hbal.hs
@@ -149,13 +149,13 @@ checkJobsStatus :: [JobStatus] -> Bool
checkJobsStatus = all (== JobSuccess)
-- | Execute an entire jobset
-execJobSet :: String -> String -> Node.List
+execJobSet :: String -> Node.List
-> Instance.List -> [JobSet] -> IO ()
-execJobSet _ _ _ _ [] = return ()
-execJobSet master csf nl il (js:jss) = do
+execJobSet _ _ _ [] = return ()
+execJobSet master nl il (js:jss) = do
-- map from jobset (htools list of positions) to [[opcodes]]
let jobs = map (\(_, idx, move, _) ->
- Cluster.iMoveToJob csf nl il idx move) js
+ Cluster.iMoveToJob nl il idx move) js
let descr = map (\(_, idx, _, _) -> Container.nameOf il idx) js
putStrLn $ "Executing jobset for instances " ++ commaJoin descr
jrs <- bracket (L.getClient master) L.closeClient
@@ -172,7 +172,7 @@ execJobSet master csf nl il (js:jss) = do
hPutStrLn stderr $ "Cannot compute job status, aborting: " ++ show x
return ()
Ok x -> if checkJobsStatus x
- then execJobSet master csf nl il jss
+ then execJobSet master nl il jss
else do
hPutStrLn stderr $ "Not all jobs completed successfully: " ++
show x
@@ -192,7 +192,7 @@ main = do
verbose = optVerbose opts
shownodes = optShowNodes opts
- (fixed_nl, il, ctags, csf) <- loadExternalData opts
+ (fixed_nl, il, ctags) <- loadExternalData opts
let offline_names = optOffline opts
all_nodes = Container.elems fixed_nl
@@ -203,6 +203,7 @@ main = do
all_nodes
m_cpu = optMcpu opts
m_dsk = optMdsk opts
+ csf = commonSuffix fixed_nl il
when (length offline_wrong > 0) $ do
hPrintf stderr "Wrong node name(s) set as offline: %s\n"
@@ -311,7 +312,7 @@ main = do
Nothing -> do
hPutStrLn stderr "Execution of commands possible only on LUXI"
exitWith $ ExitFailure 1
- Just master -> execJobSet master csf fin_nl il cmd_jobs)
+ Just master -> execJobSet master fin_nl il cmd_jobs)
when (optShowInsts opts) $ do
putStrLn ""
diff --git a/hscan.hs b/hscan.hs
index 591129d6a2eb5f5ef63e07dd03c46a8c45def36e..4d58ca1d4956a80fe9e3cef3c06dc91bc087c4cd 100644
--- a/hscan.hs
+++ b/hscan.hs
@@ -65,28 +65,27 @@ options =
]
-- | Serialize a single node
-serializeNode :: String -> Node.Node -> String
-serializeNode csf node =
- printf "%s|%.0f|%d|%d|%.0f|%d|%.0f|%c" (Node.name node ++ csf)
+serializeNode :: Node.Node -> String
+serializeNode node =
+ printf "%s|%.0f|%d|%d|%.0f|%d|%.0f|%c" (Node.name node)
(Node.tMem node) (Node.nMem node) (Node.fMem node)
(Node.tDsk node) (Node.fDsk node) (Node.tCpu node)
(if Node.offline node then 'Y' else 'N')
-- | Generate node file data from node objects
-serializeNodes :: String -> Node.List -> String
-serializeNodes csf =
- unlines . map (serializeNode csf) . Container.elems
+serializeNodes :: Node.List -> String
+serializeNodes = unlines . map serializeNode . Container.elems
-- | Serialize a single instance
-serializeInstance :: String -> Node.List -> Instance.Instance -> String
-serializeInstance csf nl inst =
+serializeInstance :: Node.List -> Instance.Instance -> String
+serializeInstance nl inst =
let
- iname = Instance.name inst ++ csf
- pnode = Container.nameOf nl (Instance.pNode inst) ++ csf
+ iname = Instance.name inst
+ pnode = Container.nameOf nl (Instance.pNode inst)
sidx = Instance.sNode inst
snode = (if sidx == Node.noSecondary
then ""
- else Container.nameOf nl sidx ++ csf)
+ else Container.nameOf nl sidx)
in
printf "%s|%d|%d|%d|%s|%s|%s|%s"
iname (Instance.mem inst) (Instance.dsk inst)
@@ -94,9 +93,9 @@ serializeInstance csf nl inst =
pnode snode (intercalate "," (Instance.tags inst))
-- | Generate instance file data from instance objects
-serializeInstances :: String -> Node.List -> Instance.List -> String
-serializeInstances csf nl =
- unlines . map (serializeInstance csf nl) . Container.elems
+serializeInstances :: Node.List -> Instance.List -> String
+serializeInstances nl =
+ unlines . map (serializeInstance nl) . Container.elems
-- | Return a one-line summary of cluster state
printCluster :: Node.List -> Instance.List
@@ -128,10 +127,10 @@ fixSlash = map (\x -> if x == '/' then '_' else x)
processData :: Result (Node.AssocList, Instance.AssocList, [String])
-> Result (Node.List, Instance.List, String)
processData input_data = do
- (nl, il, _, csf) <- input_data >>= Loader.mergeData [] [] []
+ (nl, il, _) <- input_data >>= Loader.mergeData [] [] []
let (_, fix_nl) = Loader.checkData nl il
- let ndata = serializeNodes csf nl
- idata = serializeInstances csf nl il
+ let ndata = serializeNodes nl
+ idata = serializeInstances nl il
adata = ndata ++ ['\n'] ++ idata
return (fix_nl, il, adata)
diff --git a/hspace.hs b/hspace.hs
index b6f5f4f58bdce97abca8514347cc8ca2587334c2..bd3364b6d40ed4a4a5e25cdef1c51c16c3e97c86 100644
--- a/hspace.hs
+++ b/hspace.hs
@@ -242,7 +242,7 @@ main = do
ispec = optISpec opts
shownodes = optShowNodes opts
- (fixed_nl, il, _, csf) <- loadExternalData opts
+ (fixed_nl, il, _) <- loadExternalData opts
printKeys $ map (\(a, fn) -> ("SPEC_" ++ a, fn ispec)) specData
printKeys [ ("SPEC_RQN", printf "%d" (optINodes opts)) ]
@@ -275,6 +275,7 @@ main = do
else n) fixed_nl
nl = Container.map (flip Node.setMdsk m_dsk . flip Node.setMcpu m_cpu)
nm
+ csf = commonSuffix fixed_nl il
when (length csf > 0 && verbose > 1) $
hPrintf stderr "Note: Stripping common suffix of '%s' from names\n" csf