Commit 10ef6b4e authored by Iustin Pop's avatar Iustin Pop
Browse files

Change the Node.group attribute



Currently, the Node.group attribute is the UUID of the group, as until
recently Ganeti didn't export the node group properties. Since it does
so now, we make the following changes (again apologies for a big
patch):

- we change the group attribute to be an index, similar to the way an
  Instance.pnode and snode attributes point to the parent node(s)
- on load, we read the group.uuid attribute and we use that to lookup
  the actual group index, from previously-loaded groups info
- this means that we now first read groups, then read nodes using the
  group info, and then read instances using the node info

This patch leaves a few functions showing the group index (ugly since
it's htools internal), will be converted later.
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarBalazs Lecz <leczb@google.com>
parent a679e9dc
...@@ -625,16 +625,16 @@ tryAlloc _ _ _ reqn = fail $ "Unsupported number of allocation \ ...@@ -625,16 +625,16 @@ tryAlloc _ _ _ reqn = fail $ "Unsupported number of allocation \
"), only two supported" "), only two supported"
-- | Given a group/result, describe it as a nice (list of) messages -- | Given a group/result, describe it as a nice (list of) messages
solutionDescription :: (GroupID, Result AllocSolution) -> [String] solutionDescription :: (Gdx, Result AllocSolution) -> [String]
solutionDescription (groupId, result) = solutionDescription (groupId, result) =
case result of case result of
Ok solution -> map (printf "Group %s: %s" groupId) (asLog solution) Ok solution -> map (printf "Group %d: %s" groupId) (asLog solution)
Bad message -> [printf "Group %s: error %s" groupId message] Bad message -> [printf "Group %d: error %s" groupId message]
-- | From a list of possibly bad and possibly empty solutions, filter -- | From a list of possibly bad and possibly empty solutions, filter
-- only the groups with a valid result -- only the groups with a valid result
filterMGResults :: [(GroupID, Result AllocSolution)] -> filterMGResults :: [(Gdx, Result AllocSolution)] ->
[(GroupID, AllocSolution)] [(Gdx, AllocSolution)]
filterMGResults = filterMGResults =
filter (not . null . asSolutions . snd) . filter (not . null . asSolutions . snd) .
map (\(y, Ok x) -> (y, x)) . map (\(y, Ok x) -> (y, x)) .
...@@ -651,7 +651,7 @@ tryMGAlloc mgnl mgil inst cnt = ...@@ -651,7 +651,7 @@ tryMGAlloc mgnl mgil inst cnt =
-- TODO: currently we consider all groups preferred -- TODO: currently we consider all groups preferred
sols = map (\(gid, (nl, il)) -> sols = map (\(gid, (nl, il)) ->
(gid, tryAlloc nl il inst cnt)) groups:: (gid, tryAlloc nl il inst cnt)) groups::
[(GroupID, Result AllocSolution)] [(Gdx, Result AllocSolution)]
all_msgs = concatMap solutionDescription sols all_msgs = concatMap solutionDescription sols
goodSols = filterMGResults sols goodSols = filterMGResults sols
extractScore = \(_, _, _, x) -> x extractScore = \(_, _, _, x) -> x
...@@ -660,7 +660,7 @@ tryMGAlloc mgnl mgil inst cnt = ...@@ -660,7 +660,7 @@ tryMGAlloc mgnl mgil inst cnt =
in if null sortedSols in if null sortedSols
then Bad $ intercalate ", " all_msgs then Bad $ intercalate ", " all_msgs
else let (final_group, final_sol) = head sortedSols else let (final_group, final_sol) = head sortedSols
selmsg = "Selected group: " ++ final_group selmsg = "Selected group: " ++ show final_group
in Ok $ final_sol { asLog = selmsg:all_msgs } in Ok $ final_sol { asLog = selmsg:all_msgs }
-- | Try to relocate an instance on the cluster. -- | Try to relocate an instance on the cluster.
...@@ -925,19 +925,19 @@ iMoveToJob nl il idx move = ...@@ -925,19 +925,19 @@ iMoveToJob nl il idx move =
FailoverAndReplace ns -> [ opF, opR ns ] FailoverAndReplace ns -> [ opF, opR ns ]
-- | Computes the group of an instance -- | Computes the group of an instance
instanceGroup :: Node.List -> Instance.Instance -> Result GroupID instanceGroup :: Node.List -> Instance.Instance -> Result Gdx
instanceGroup nl i = instanceGroup nl i =
let sidx = Instance.sNode i let sidx = Instance.sNode i
pnode = Container.find (Instance.pNode i) nl pnode = Container.find (Instance.pNode i) nl
snode = if sidx == Node.noSecondary snode = if sidx == Node.noSecondary
then pnode then pnode
else Container.find sidx nl else Container.find sidx nl
puuid = Node.group pnode pgroup = Node.group pnode
suuid = Node.group snode sgroup = Node.group snode
in if puuid /= suuid in if pgroup /= sgroup
then fail ("Instance placed accross two node groups, primary " ++ puuid ++ then fail ("Instance placed accross two node groups, primary " ++
", secondary " ++ suuid) show pgroup ++ ", secondary " ++ show sgroup)
else return puuid else return pgroup
-- | Compute the list of badly allocated instances (split across node -- | Compute the list of badly allocated instances (split across node
-- groups) -- groups)
...@@ -947,7 +947,7 @@ findSplitInstances nl il = ...@@ -947,7 +947,7 @@ findSplitInstances nl il =
-- | Splits a cluster into the component node groups -- | Splits a cluster into the component node groups
splitCluster :: Node.List -> Instance.List -> splitCluster :: Node.List -> Instance.List ->
[(GroupID, (Node.List, Instance.List))] [(Gdx, (Node.List, Instance.List))]
splitCluster nl il = splitCluster nl il =
let ngroups = Node.computeGroups (Container.elems nl) let ngroups = Node.computeGroups (Container.elems nl)
in map (\(guuid, nodes) -> in map (\(guuid, nodes) ->
......
...@@ -75,15 +75,17 @@ parseInstance ktn n a = do ...@@ -75,15 +75,17 @@ parseInstance ktn n a = do
return (n, Instance.setBoth (snd base) pidx sidx) return (n, Instance.setBoth (snd base) pidx sidx)
-- | Parses a node as found in the cluster node list. -- | Parses a node as found in the cluster node list.
parseNode :: String -- ^ The node's name parseNode :: NameAssoc -- ^ The group association
-> String -- ^ The node's name
-> [(String, JSValue)] -- ^ The JSON object -> [(String, JSValue)] -- ^ The JSON object
-> Result (String, Node.Node) -> Result (String, Node.Node)
parseNode n a = do parseNode ktg n a = do
offline <- fromObj "offline" a offline <- fromObj "offline" a
drained <- fromObj "drained" a drained <- fromObj "drained" a
guuid <- fromObj "group" a guuid <- fromObj "group" a
gidx <- lookupGroup ktg n guuid
node <- (if offline || drained node <- (if offline || drained
then return $ Node.create n 0 0 0 0 0 0 True guuid then return $ Node.create n 0 0 0 0 0 0 True gidx
else do else do
mtotal <- fromObj "total_memory" a mtotal <- fromObj "total_memory" a
mnode <- fromObj "reserved_memory" a mnode <- fromObj "reserved_memory" a
...@@ -92,7 +94,7 @@ parseNode n a = do ...@@ -92,7 +94,7 @@ parseNode n a = do
dfree <- fromObj "free_disk" a dfree <- fromObj "free_disk" a
ctotal <- fromObj "total_cpus" a ctotal <- fromObj "total_cpus" a
return $ Node.create n mtotal mnode mfree return $ Node.create n mtotal mnode mfree
dtotal dfree ctotal False guuid) dtotal dfree ctotal False gidx)
return (n, node) return (n, node)
-- | Parses a group as found in the cluster group list. -- | Parses a group as found in the cluster group list.
...@@ -114,10 +116,11 @@ parseData body = do ...@@ -114,10 +116,11 @@ parseData body = do
-- existing group parsing -- existing group parsing
glist <- liftM fromJSObject (fromObj "nodegroups" obj) glist <- liftM fromJSObject (fromObj "nodegroups" obj)
gobj <- mapM (\(x, y) -> asJSObject y >>= parseGroup x . fromJSObject) glist gobj <- mapM (\(x, y) -> asJSObject y >>= parseGroup x . fromJSObject) glist
let (_, gl) = assignIndices gobj let (ktg, gl) = assignIndices gobj
-- existing node parsing -- existing node parsing
nlist <- liftM fromJSObject (fromObj "nodes" obj) nlist <- liftM fromJSObject (fromObj "nodes" obj)
nobj <- mapM (\(x,y) -> asJSObject y >>= parseNode x . fromJSObject) nlist nobj <- mapM (\(x,y) ->
asJSObject y >>= parseNode ktg x . fromJSObject) nlist
let (ktn, nl) = assignIndices nobj let (ktn, nl) = assignIndices nobj
-- existing instance parsing -- existing instance parsing
ilist <- fromObj "instances" obj ilist <- fromObj "instances" obj
......
...@@ -120,22 +120,22 @@ parseInstance ktn (JSArray [ name, disk, mem, vcpus ...@@ -120,22 +120,22 @@ parseInstance ktn (JSArray [ name, disk, mem, vcpus
parseInstance _ v = fail ("Invalid instance query result: " ++ show v) parseInstance _ v = fail ("Invalid instance query result: " ++ show v)
-- | Parse a node list in JSON format. -- | Parse a node list in JSON format.
getNodes :: JSValue -> Result [(String, Node.Node)] getNodes :: NameAssoc -> JSValue -> Result [(String, Node.Node)]
getNodes arr = toArray arr >>= mapM parseNode getNodes ktg arr = toArray arr >>= mapM (parseNode ktg)
-- | Construct a node from a JSON object. -- | Construct a node from a JSON object.
parseNode :: JSValue -> Result (String, Node.Node) parseNode :: NameAssoc -> JSValue -> Result (String, Node.Node)
parseNode (JSArray [ name, mtotal, mnode, mfree, dtotal, dfree parseNode ktg (JSArray [ name, mtotal, mnode, mfree, dtotal, dfree
, ctotal, offline, drained, vm_capable, g_uuid ]) , ctotal, offline, drained, vm_capable, g_uuid ])
= do = do
xname <- annotateResult "Parsing new node" (fromJVal name) xname <- annotateResult "Parsing new node" (fromJVal name)
let convert v = annotateResult ("Node '" ++ xname ++ "'") (fromJVal v) let convert v = annotateResult ("Node '" ++ xname ++ "'") (fromJVal v)
xoffline <- convert offline xoffline <- convert offline
xdrained <- convert drained xdrained <- convert drained
xvm_capable <- convert vm_capable xvm_capable <- convert vm_capable
xguuid <- convert g_uuid xgdx <- convert g_uuid >>= lookupGroup ktg xname
node <- (if xoffline || xdrained || not xvm_capable node <- (if xoffline || xdrained || not xvm_capable
then return $ Node.create xname 0 0 0 0 0 0 True xguuid then return $ Node.create xname 0 0 0 0 0 0 True xgdx
else do else do
xmtotal <- convert mtotal xmtotal <- convert mtotal
xmnode <- convert mnode xmnode <- convert mnode
...@@ -144,10 +144,10 @@ parseNode (JSArray [ name, mtotal, mnode, mfree, dtotal, dfree ...@@ -144,10 +144,10 @@ parseNode (JSArray [ name, mtotal, mnode, mfree, dtotal, dfree
xdfree <- convert dfree xdfree <- convert dfree
xctotal <- convert ctotal xctotal <- convert ctotal
return $ Node.create xname xmtotal xmnode xmfree return $ Node.create xname xmtotal xmnode xmfree
xdtotal xdfree xctotal False xguuid) xdtotal xdfree xctotal False xgdx)
return (xname, node) return (xname, node)
parseNode v = fail ("Invalid node query result: " ++ show v) parseNode _ v = fail ("Invalid node query result: " ++ show v)
getClusterTags :: JSValue -> Result [String] getClusterTags :: JSValue -> Result [String]
getClusterTags v = do getClusterTags v = do
...@@ -188,8 +188,8 @@ parseData :: (Result JSValue, Result JSValue, Result JSValue, Result JSValue) ...@@ -188,8 +188,8 @@ parseData :: (Result JSValue, Result JSValue, Result JSValue, Result JSValue)
-> Result (Group.List, Node.List, Instance.List, [String]) -> Result (Group.List, Node.List, Instance.List, [String])
parseData (groups, nodes, instances, cinfo) = do parseData (groups, nodes, instances, cinfo) = do
group_data <- groups >>= getGroups group_data <- groups >>= getGroups
let (_, group_idx) = assignIndices group_data let (group_names, group_idx) = assignIndices group_data
node_data <- nodes >>= getNodes node_data <- nodes >>= getNodes group_names
let (node_names, node_idx) = assignIndices node_data let (node_names, node_idx) = assignIndices node_data
inst_data <- instances >>= getInstances node_names inst_data <- instances >>= getInstances node_names
let (_, inst_idx) = assignIndices inst_data let (_, inst_idx) = assignIndices inst_data
......
...@@ -121,7 +121,7 @@ data Node = Node ...@@ -121,7 +121,7 @@ data Node = Node
, utilPool :: T.DynUtil -- ^ Total utilisation capacity , utilPool :: T.DynUtil -- ^ Total utilisation capacity
, utilLoad :: T.DynUtil -- ^ Sum of instance utilisation , utilLoad :: T.DynUtil -- ^ Sum of instance utilisation
, pTags :: TagMap -- ^ Map of primary instance tags and their count , pTags :: TagMap -- ^ Map of primary instance tags and their count
, group :: T.GroupID -- ^ The node's group (as UUID) , group :: T.Gdx -- ^ The node's group (index)
} deriving (Show, Eq) } deriving (Show, Eq)
instance T.Element Node where instance T.Element Node where
...@@ -185,7 +185,7 @@ conflictingPrimaries (Node { pTags = t }) = Foldable.sum t - Map.size t ...@@ -185,7 +185,7 @@ conflictingPrimaries (Node { pTags = t }) = Foldable.sum t - Map.size t
-- The index and the peers maps are empty, and will be need to be -- The index and the peers maps are empty, and will be need to be
-- update later via the 'setIdx' and 'buildPeers' functions. -- update later via the 'setIdx' and 'buildPeers' functions.
create :: String -> Double -> Int -> Int -> Double create :: String -> Double -> Int -> Int -> Double
-> Int -> Double -> Bool -> String -> Node -> Int -> Double -> Bool -> T.Gdx -> Node
create name_init mem_t_init mem_n_init mem_f_init create name_init mem_t_init mem_n_init mem_f_init
dsk_t_init dsk_f_init cpu_t_init offline_init group_init = dsk_t_init dsk_f_init cpu_t_init offline_init group_init =
Node { name = name_init Node { name = name_init
...@@ -487,7 +487,6 @@ showField t field = ...@@ -487,7 +487,6 @@ showField t field =
"ptags" -> intercalate "," . map (\(k, v) -> printf "%s=%d" k v) . "ptags" -> intercalate "," . map (\(k, v) -> printf "%s=%d" k v) .
Map.toList $ pTags t Map.toList $ pTags t
"peermap" -> show $ peers t "peermap" -> show $ peers t
"group.uuid" -> group t
_ -> T.unknownField _ -> T.unknownField
where where
T.DynUtil { T.cpuWeight = uC, T.memWeight = uM, T.DynUtil { T.cpuWeight = uC, T.memWeight = uM,
...@@ -526,7 +525,7 @@ showHeader field = ...@@ -526,7 +525,7 @@ showHeader field =
"nload" -> ("lNet", True) "nload" -> ("lNet", True)
"ptags" -> ("PrimaryTags", False) "ptags" -> ("PrimaryTags", False)
"peermap" -> ("PeerMap", False) "peermap" -> ("PeerMap", False)
"group.uuid" -> ("GroupUUID", False) -- TODO: add node fields (group.uuid, group)
_ -> (T.unknownField, False) _ -> (T.unknownField, False)
-- | String converter for the node list functionality. -- | String converter for the node list functionality.
...@@ -543,7 +542,7 @@ defaultFields = ...@@ -543,7 +542,7 @@ defaultFields =
-- | Split a list of nodes into a list of (node group UUID, list of -- | Split a list of nodes into a list of (node group UUID, list of
-- associated nodes) -- associated nodes)
computeGroups :: [Node] -> [(T.GroupID, [Node])] computeGroups :: [Node] -> [(T.Gdx, [Node])]
computeGroups nodes = computeGroups nodes =
let nodes' = sortBy (comparing group) nodes let nodes' = sortBy (comparing group) nodes
nodes'' = groupBy (\a b -> group a == group b) nodes' nodes'' = groupBy (\a b -> group a == group b) nodes'
......
...@@ -56,6 +56,7 @@ import qualified Ganeti.HTools.Instance as Instance ...@@ -56,6 +56,7 @@ import qualified Ganeti.HTools.Instance as Instance
import qualified Ganeti.HTools.Loader as Loader import qualified Ganeti.HTools.Loader as Loader
import qualified Ganeti.HTools.Luxi import qualified Ganeti.HTools.Luxi
import qualified Ganeti.HTools.Node as Node import qualified Ganeti.HTools.Node as Node
import qualified Ganeti.HTools.Group as Group
import qualified Ganeti.HTools.PeerMap as PeerMap import qualified Ganeti.HTools.PeerMap as PeerMap
import qualified Ganeti.HTools.Rapi import qualified Ganeti.HTools.Rapi
import qualified Ganeti.HTools.Simu import qualified Ganeti.HTools.Simu
...@@ -78,6 +79,17 @@ maxDsk = 1024 * 1024 * 8 ...@@ -78,6 +79,17 @@ maxDsk = 1024 * 1024 * 8
maxCpu :: Int maxCpu :: Int
maxCpu = 1024 maxCpu = 1024
defGroup :: Group.Group
defGroup = flip Group.setIdx 0 $
Group.create "default" Utils.defaultGroupID
Types.AllocPreferred
defGroupList :: Group.List
defGroupList = Container.fromAssocList [(Group.idx defGroup, defGroup)]
defGroupAssoc :: Data.Map.Map String Types.Gdx
defGroupAssoc = Data.Map.singleton (Group.uuid defGroup) (Group.idx defGroup)
-- * Helper functions -- * Helper functions
-- | Simple checker for whether OpResult is fail or pass -- | Simple checker for whether OpResult is fail or pass
...@@ -187,7 +199,7 @@ instance Arbitrary Node.Node where ...@@ -187,7 +199,7 @@ instance Arbitrary Node.Node where
offl <- arbitrary offl <- arbitrary
let n = Node.create name (fromIntegral mem_t) mem_n mem_f let n = Node.create name (fromIntegral mem_t) mem_n mem_f
(fromIntegral dsk_t) dsk_f (fromIntegral cpu_t) offl (fromIntegral dsk_t) dsk_f (fromIntegral cpu_t) offl
Utils.defaultGroupID 0
n' = Node.buildPeers n Container.empty n' = Node.buildPeers n Container.empty
return n' return n'
...@@ -483,7 +495,9 @@ prop_Text_Load_Node name tm nm fm td fd tc fo = ...@@ -483,7 +495,9 @@ prop_Text_Load_Node name tm nm fm td fd tc fo =
then "Y" then "Y"
else "N" else "N"
any_broken = any (< 0) [tm, nm, fm, td, fd, tc] any_broken = any (< 0) [tm, nm, fm, td, fd, tc]
in case Text.loadNode [name, tm_s, nm_s, fm_s, td_s, fd_s, tc_s, fo_s] of gid = Group.uuid defGroup
in case Text.loadNode defGroupAssoc
[name, tm_s, nm_s, fm_s, td_s, fd_s, tc_s, fo_s, gid] of
Nothing -> False Nothing -> False
Just (name', node) -> Just (name', node) ->
if fo || any_broken if fo || any_broken
...@@ -498,11 +512,11 @@ prop_Text_Load_Node name tm nm fm td fd tc fo = ...@@ -498,11 +512,11 @@ prop_Text_Load_Node name tm nm fm td fd tc fo =
Node.tCpu node == fromIntegral tc Node.tCpu node == fromIntegral tc
prop_Text_Load_NodeFail fields = prop_Text_Load_NodeFail fields =
length fields /= 8 ==> isNothing $ Text.loadNode fields length fields /= 8 ==> isNothing $ Text.loadNode Data.Map.empty fields
prop_Text_NodeLSIdempotent node = prop_Text_NodeLSIdempotent node =
(Text.loadNode . (Text.loadNode defGroupAssoc.
Utils.sepSplit '|' . Text.serializeNode) n == Utils.sepSplit '|' . Text.serializeNode defGroupList) n ==
Just (Node.name n, n) Just (Node.name n, n)
-- override failN1 to what loadNode returns by default -- override failN1 to what loadNode returns by default
where n = node { Node.failN1 = True, Node.offline = False } where n = node { Node.failN1 = True, Node.offline = False }
...@@ -750,7 +764,7 @@ prop_ClusterAllocBalance node = ...@@ -750,7 +764,7 @@ prop_ClusterAllocBalance node =
prop_ClusterCheckConsistency node inst = prop_ClusterCheckConsistency node inst =
let nl = makeSmallCluster node 3 let nl = makeSmallCluster node 3
[node1, node2, node3] = Container.elems nl [node1, node2, node3] = Container.elems nl
node3' = node3 { Node.group = "other-uuid" } node3' = node3 { Node.group = 1 }
nl' = Container.add (Node.idx node3') node3' nl nl' = Container.add (Node.idx node3') node3' nl
inst1 = Instance.setBoth inst (Node.idx node1) (Node.idx node2) inst1 = Instance.setBoth inst (Node.idx node1) (Node.idx node2)
inst2 = Instance.setBoth inst (Node.idx node1) Node.noSecondary inst2 = Instance.setBoth inst (Node.idx node1) Node.noSecondary
......
...@@ -71,9 +71,9 @@ getInstances ktn body = ...@@ -71,9 +71,9 @@ getInstances ktn body =
mapM (parseInstance ktn . fromJSObject) mapM (parseInstance ktn . fromJSObject)
-- | Parse a node list in JSON format. -- | Parse a node list in JSON format.
getNodes :: String -> Result [(String, Node.Node)] getNodes :: NameAssoc -> String -> Result [(String, Node.Node)]
getNodes body = loadJSArray "Parsing node data" body >>= getNodes ktg body = loadJSArray "Parsing node data" body >>=
mapM (parseNode . fromJSObject) mapM (parseNode ktg . fromJSObject)
-- | Parse a group list in JSON format. -- | Parse a group list in JSON format.
getGroups :: String -> Result [(String, Group.Group)] getGroups :: String -> Result [(String, Group.Group)]
...@@ -105,13 +105,13 @@ parseInstance ktn a = do ...@@ -105,13 +105,13 @@ parseInstance ktn a = do
return (name, inst) return (name, inst)
-- | Construct a node from a JSON object. -- | Construct a node from a JSON object.
parseNode :: [(String, JSValue)] -> Result (String, Node.Node) parseNode :: NameAssoc -> [(String, JSValue)] -> Result (String, Node.Node)
parseNode a = do parseNode ktg a = do
name <- tryFromObj "Parsing new node" a "name" name <- tryFromObj "Parsing new node" a "name"
let extract s = tryFromObj ("Node '" ++ name ++ "'") a s let extract s = tryFromObj ("Node '" ++ name ++ "'") a s
offline <- extract "offline" offline <- extract "offline"
drained <- extract "drained" drained <- extract "drained"
guuid <- extract "group.uuid" guuid <- extract "group.uuid" >>= lookupGroup ktg name
node <- (if offline || drained node <- (if offline || drained
then return $ Node.create name 0 0 0 0 0 0 True guuid then return $ Node.create name 0 0 0 0 0 0 True guuid
else do else do
...@@ -149,8 +149,8 @@ parseData :: (Result String, Result String, Result String, Result String) ...@@ -149,8 +149,8 @@ parseData :: (Result String, Result String, Result String, Result String)
-> Result (Group.List, Node.List, Instance.List, [String]) -> Result (Group.List, Node.List, Instance.List, [String])
parseData (group_body, node_body, inst_body, tags_body) = do parseData (group_body, node_body, inst_body, tags_body) = do
group_data <- group_body >>= getGroups group_data <- group_body >>= getGroups
let (_, group_idx) = assignIndices group_data let (group_names, group_idx) = assignIndices group_data
node_data <- node_body >>= getNodes node_data <- node_body >>= getNodes group_names
let (node_names, node_idx) = assignIndices node_data let (node_names, node_idx) = assignIndices node_data
inst_data <- inst_body >>= getInstances node_names inst_data <- inst_body >>= getInstances node_names
let (_, inst_idx) = assignIndices inst_data let (_, inst_idx) = assignIndices inst_data
......
...@@ -62,7 +62,7 @@ parseData ndata = do ...@@ -62,7 +62,7 @@ parseData ndata = do
let n = Node.create (printf "node%03d" idx) let n = Node.create (printf "node%03d" idx)
(fromIntegral mem) 0 mem (fromIntegral mem) 0 mem
(fromIntegral disk) disk (fromIntegral disk) disk
(fromIntegral cpu) False defaultGroupID (fromIntegral cpu) False 0
in (idx, Node.setIdx n idx) in (idx, Node.setIdx n idx)
) [1..cnt] ) [1..cnt]
return (Container.fromAssocList [(0, Group.setIdx defgroup 0)], return (Container.fromAssocList [(0, Group.setIdx defgroup 0)],
......
...@@ -52,17 +52,18 @@ import qualified Ganeti.HTools.Node as Node ...@@ -52,17 +52,18 @@ import qualified Ganeti.HTools.Node as Node
import qualified Ganeti.HTools.Instance as Instance import qualified Ganeti.HTools.Instance as Instance
-- | Serialize a single node -- | Serialize a single node
serializeNode :: Node.Node -> String serializeNode :: Group.List -> Node.Node -> String
serializeNode node = serializeNode gl node =
printf "%s|%.0f|%d|%d|%.0f|%d|%.0f|%c|%s" (Node.name node) printf "%s|%.0f|%d|%d|%.0f|%d|%.0f|%c|%s" (Node.name node)
(Node.tMem node) (Node.nMem node) (Node.fMem node) (Node.tMem node) (Node.nMem node) (Node.fMem node)
(Node.tDsk node) (Node.fDsk node) (Node.tCpu node) (Node.tDsk node) (Node.fDsk node) (Node.tCpu node)
(if Node.offline node then 'Y' else 'N') (if Node.offline node then 'Y' else 'N')
(Node.group node) (Group.uuid grp)
where grp = Container.find (Node.group node) gl
-- | Generate node file data from node objects -- | Generate node file data from node objects
serializeNodes :: Node.List -> String serializeNodes :: Group.List -> Node.List -> String
serializeNodes = unlines . map serializeNode . Container.elems serializeNodes gl = unlines . map (serializeNode gl) . Container.elems
-- | Serialize a single instance -- | Serialize a single instance
serializeInstance :: Node.List -> Instance.Instance -> String serializeInstance :: Node.List -> Instance.Instance -> String
...@@ -86,9 +87,9 @@ serializeInstances nl = ...@@ -86,9 +87,9 @@ serializeInstances nl =
unlines . map (serializeInstance nl) . Container.elems unlines . map (serializeInstance nl) . Container.elems
-- | Generate complete cluster data from node and instance lists -- | Generate complete cluster data from node and instance lists
serializeCluster :: Node.List -> Instance.List -> String serializeCluster :: Group.List -> Node.List -> Instance.List -> String
serializeCluster nl il = serializeCluster gl nl il =
let ndata = serializeNodes nl let ndata = serializeNodes gl nl
idata = serializeInstances nl il idata = serializeInstances nl il
in ndata ++ ['\n'] ++ idata in ndata ++ ['\n'] ++ idata
...@@ -100,14 +101,12 @@ loadGroup [name, gid] = ...@@ -100,14 +101,12 @@ loadGroup [name, gid] =
loadGroup s = fail $ "Invalid/incomplete group data: '" ++ show s ++ "'" loadGroup s = fail $ "Invalid/incomplete group data: '" ++ show s ++ "'"
-- | Load a node from a field list. -- | Load a node from a field list.
loadNode :: (Monad m) => [String] -> m (String, Node.Node) loadNode :: (Monad m) => NameAssoc -> [String] -> m (String, Node.Node)
-- compatibility wrapper for old text files loadNode ktg [name, tm, nm, fm, td, fd, tc, fo, gu] = do
loadNode [name, tm, nm, fm, td, fd, tc, fo] = gdx <- lookupGroup ktg name gu
loadNode [name, tm, nm, fm, td, fd, tc, fo, defaultGroupID]
loadNode [name, tm, nm, fm, td, fd, tc, fo, gu] = do
new_node <- new_node <-
if any (== "?") [tm,nm,fm,td,fd,tc] || fo == "Y" then if any (== "?") [tm,nm,fm,td,fd,tc] || fo == "Y" then
return $ Node.create name 0 0 0 0 0 0 True gu return $ Node.create name 0 0 0 0 0 0 True gdx
else do else do
vtm <- tryRead name tm vtm <- tryRead name tm
vnm <- tryRead name nm vnm <- tryRead name nm
...@@ -115,9 +114,9 @@ loadNode [name, tm, nm, fm, td, fd, tc, fo, gu] = do ...@@ -115,9 +114,9 @@ loadNode [name, tm, nm, fm, td, fd, tc, fo, gu] = do
vtd <- tryRead name td vtd <- tryRead name td
vfd <- tryRead name fd vfd <- tryRead name fd
vtc <- tryRead name tc vtc <- tryRead name tc
return $ Node.create name vtm vnm vfm vtd vfd vtc False gu return $ Node.create name vtm vnm vfm vtd vfd vtc False gdx
return (name, new_node) return (name, new_node)
loadNode s = fail $ "Invalid/incomplete node data: '" ++ show s ++ "'" loadNode _ s = fail $ "Invalid/incomplete node data: '" ++ show s ++ "'"
-- | Load an instance from a field list. -- | Load an instance from a field list.
loadInst :: (Monad m) => loadInst :: (Monad m) =>
...@@ -168,9 +167,9 @@ parseData fdata = do ...@@ -168,9 +167,9 @@ parseData fdata = do
[] -> Bad "Invalid format of the input file (no instance data)" [] -> Bad "Invalid format of the input file (no instance data)"
_:xs -> Ok xs _:xs -> Ok xs
{- group file: name uuid -} {- group file: name uuid -}
(_, gl) <- loadTabular glines loadGroup (ktg, gl) <- loadTabular glines loadGroup
{- node file: name t_mem n_mem f_mem t_disk f_disk -} {- node file: name t_mem n_mem f_mem t_disk f_disk -}
(ktn, nl) <- loadTabular nfixed loadNode (ktn, nl) <- loadTabular nfixed (loadNode ktg)
{- instance file: name mem disk status pnode snode -} {- instance file: name mem disk status pnode snode -}
(_, il) <- loadTabular ifixed (loadInst ktn) (_, il) <- loadTabular ifixed (loadInst ktn)
return (gl, nl, il, []) return (gl, nl, il, [])
......