From 3e4480e017150be11215c41ad56abdde2c49d768 Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Thu, 29 Apr 2010 16:07:33 +0200
Subject: [PATCH] Stop modifying names for internal computations
Currently the name used internally is modified and holds the shortened
name of the nodes/instances. This has caused issues before, since we
always have to strip the suffix from input data and reapply it if we
need to send data back to Ganeti.
This patch changes the code such that the names are never modified, only
the alias, and all the internal computations can forget about the common
suffix addition/removal.
---
Ganeti/HTools/Cluster.hs | 8 ++++----
Ganeti/HTools/ExtLoader.hs | 7 ++++---
Ganeti/HTools/IAlloc.hs | 30 +++++++++++++-----------------
Ganeti/HTools/Instance.hs | 8 ++++----
Ganeti/HTools/Loader.hs | 24 +++++++++++++-----------
Ganeti/HTools/Node.hs | 13 ++++---------
Ganeti/HTools/Types.hs | 10 ++++++++--
hail.hs | 6 +++---
hbal.hs | 15 ++++++++-------
hscan.hs | 33 ++++++++++++++++-----------------
hspace.hs | 3 ++-
11 files changed, 79 insertions(+), 78 deletions(-)
diff --git a/Ganeti/HTools/Cluster.hs b/Ganeti/HTools/Cluster.hs
index f4cd7661e..856667e83 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 0d72d6f90..41c845399 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 308357887..eb2b4fa47 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 f6ec30867..76faf368c 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 33e49f01b..1e65d54ab 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 1848557f0..3dd0275ad 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 3cc8d5383..9fc409c31 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 886b07101..d67bd6839 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 d15407afb..b6113bdca 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 591129d6a..4d58ca1d4 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 b6f5f4f58..bd3364b6d 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
--
GitLab