Commit 3e4480e0 authored by Iustin Pop's avatar Iustin Pop
Browse files

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.
parent 8bcdde0c
......@@ -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
......
......@@ -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)
......@@ -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]
......@@ -67,7 +67,7 @@ data Instance = Instance { name :: String -- ^ The instance name
instance T.Element Instance where
nameOf = name
idxOf = idx
setName = setName
setAlias = setAlias
setIdx = setIdx
-- | Running instance states.
......
......@@ -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
......
......@@ -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)
......
......@@ -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
......@@ -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
......@@ -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 ""
......
......@@ -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)
......
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment