From 10ef6b4ec1c213b95ab197136ecb5a406129bea6 Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Wed, 15 Dec 2010 18:18:47 +0100
Subject: [PATCH] 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: Iustin Pop <iustin@google.com>
Reviewed-by: Balazs Lecz <leczb@google.com>
---
Ganeti/HTools/Cluster.hs | 30 +++++++++++++++---------------
Ganeti/HTools/IAlloc.hs | 15 +++++++++------
Ganeti/HTools/Luxi.hs | 22 +++++++++++-----------
Ganeti/HTools/Node.hs | 9 ++++-----
Ganeti/HTools/QC.hs | 26 ++++++++++++++++++++------
Ganeti/HTools/Rapi.hs | 16 ++++++++--------
Ganeti/HTools/Simu.hs | 2 +-
Ganeti/HTools/Text.hs | 35 +++++++++++++++++------------------
hbal.hs | 29 ++++++++++++++++++++---------
hscan.hs | 2 +-
hspace.hs | 6 +++---
11 files changed, 109 insertions(+), 83 deletions(-)
diff --git a/Ganeti/HTools/Cluster.hs b/Ganeti/HTools/Cluster.hs
index 7d11ddb0a..66d87526b 100644
--- a/Ganeti/HTools/Cluster.hs
+++ b/Ganeti/HTools/Cluster.hs
@@ -625,16 +625,16 @@ tryAlloc _ _ _ reqn = fail $ "Unsupported number of allocation \
"), only two supported"
-- | 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) =
case result of
- Ok solution -> map (printf "Group %s: %s" groupId) (asLog solution)
- Bad message -> [printf "Group %s: error %s" groupId message]
+ Ok solution -> map (printf "Group %d: %s" groupId) (asLog solution)
+ Bad message -> [printf "Group %d: error %s" groupId message]
-- | From a list of possibly bad and possibly empty solutions, filter
-- only the groups with a valid result
-filterMGResults :: [(GroupID, Result AllocSolution)] ->
- [(GroupID, AllocSolution)]
+filterMGResults :: [(Gdx, Result AllocSolution)] ->
+ [(Gdx, AllocSolution)]
filterMGResults =
filter (not . null . asSolutions . snd) .
map (\(y, Ok x) -> (y, x)) .
@@ -651,7 +651,7 @@ tryMGAlloc mgnl mgil inst cnt =
-- TODO: currently we consider all groups preferred
sols = map (\(gid, (nl, il)) ->
(gid, tryAlloc nl il inst cnt)) groups::
- [(GroupID, Result AllocSolution)]
+ [(Gdx, Result AllocSolution)]
all_msgs = concatMap solutionDescription sols
goodSols = filterMGResults sols
extractScore = \(_, _, _, x) -> x
@@ -660,7 +660,7 @@ tryMGAlloc mgnl mgil inst cnt =
in if null sortedSols
then Bad $ intercalate ", " all_msgs
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 }
-- | Try to relocate an instance on the cluster.
@@ -925,19 +925,19 @@ iMoveToJob nl il idx move =
FailoverAndReplace ns -> [ opF, opR ns ]
-- | Computes the group of an instance
-instanceGroup :: Node.List -> Instance.Instance -> Result GroupID
+instanceGroup :: Node.List -> Instance.Instance -> Result Gdx
instanceGroup nl i =
let sidx = Instance.sNode i
pnode = Container.find (Instance.pNode i) nl
snode = if sidx == Node.noSecondary
then pnode
else Container.find sidx nl
- puuid = Node.group pnode
- suuid = Node.group snode
- in if puuid /= suuid
- then fail ("Instance placed accross two node groups, primary " ++ puuid ++
- ", secondary " ++ suuid)
- else return puuid
+ pgroup = Node.group pnode
+ sgroup = Node.group snode
+ in if pgroup /= sgroup
+ then fail ("Instance placed accross two node groups, primary " ++
+ show pgroup ++ ", secondary " ++ show sgroup)
+ else return pgroup
-- | Compute the list of badly allocated instances (split across node
-- groups)
@@ -947,7 +947,7 @@ findSplitInstances nl il =
-- | Splits a cluster into the component node groups
splitCluster :: Node.List -> Instance.List ->
- [(GroupID, (Node.List, Instance.List))]
+ [(Gdx, (Node.List, Instance.List))]
splitCluster nl il =
let ngroups = Node.computeGroups (Container.elems nl)
in map (\(guuid, nodes) ->
diff --git a/Ganeti/HTools/IAlloc.hs b/Ganeti/HTools/IAlloc.hs
index 4117fd478..f015f9d42 100644
--- a/Ganeti/HTools/IAlloc.hs
+++ b/Ganeti/HTools/IAlloc.hs
@@ -75,15 +75,17 @@ parseInstance ktn n a = do
return (n, Instance.setBoth (snd base) pidx sidx)
-- | 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
-> Result (String, Node.Node)
-parseNode n a = do
+parseNode ktg n a = do
offline <- fromObj "offline" a
drained <- fromObj "drained" a
guuid <- fromObj "group" a
+ gidx <- lookupGroup ktg n guuid
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
mtotal <- fromObj "total_memory" a
mnode <- fromObj "reserved_memory" a
@@ -92,7 +94,7 @@ parseNode n a = do
dfree <- fromObj "free_disk" a
ctotal <- fromObj "total_cpus" a
return $ Node.create n mtotal mnode mfree
- dtotal dfree ctotal False guuid)
+ dtotal dfree ctotal False gidx)
return (n, node)
-- | Parses a group as found in the cluster group list.
@@ -114,10 +116,11 @@ parseData body = do
-- existing group parsing
glist <- liftM fromJSObject (fromObj "nodegroups" obj)
gobj <- mapM (\(x, y) -> asJSObject y >>= parseGroup x . fromJSObject) glist
- let (_, gl) = assignIndices gobj
+ let (ktg, gl) = assignIndices gobj
-- existing node parsing
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
-- existing instance parsing
ilist <- fromObj "instances" obj
diff --git a/Ganeti/HTools/Luxi.hs b/Ganeti/HTools/Luxi.hs
index c5b93437c..88c22849d 100644
--- a/Ganeti/HTools/Luxi.hs
+++ b/Ganeti/HTools/Luxi.hs
@@ -120,22 +120,22 @@ parseInstance ktn (JSArray [ name, disk, mem, vcpus
parseInstance _ v = fail ("Invalid instance query result: " ++ show v)
-- | Parse a node list in JSON format.
-getNodes :: JSValue -> Result [(String, Node.Node)]
-getNodes arr = toArray arr >>= mapM parseNode
+getNodes :: NameAssoc -> JSValue -> Result [(String, Node.Node)]
+getNodes ktg arr = toArray arr >>= mapM (parseNode ktg)
-- | Construct a node from a JSON object.
-parseNode :: JSValue -> Result (String, Node.Node)
-parseNode (JSArray [ name, mtotal, mnode, mfree, dtotal, dfree
- , ctotal, offline, drained, vm_capable, g_uuid ])
+parseNode :: NameAssoc -> JSValue -> Result (String, Node.Node)
+parseNode ktg (JSArray [ name, mtotal, mnode, mfree, dtotal, dfree
+ , ctotal, offline, drained, vm_capable, g_uuid ])
= do
xname <- annotateResult "Parsing new node" (fromJVal name)
let convert v = annotateResult ("Node '" ++ xname ++ "'") (fromJVal v)
xoffline <- convert offline
xdrained <- convert drained
xvm_capable <- convert vm_capable
- xguuid <- convert g_uuid
+ xgdx <- convert g_uuid >>= lookupGroup ktg xname
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
xmtotal <- convert mtotal
xmnode <- convert mnode
@@ -144,10 +144,10 @@ parseNode (JSArray [ name, mtotal, mnode, mfree, dtotal, dfree
xdfree <- convert dfree
xctotal <- convert ctotal
return $ Node.create xname xmtotal xmnode xmfree
- xdtotal xdfree xctotal False xguuid)
+ xdtotal xdfree xctotal False xgdx)
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 v = do
@@ -188,8 +188,8 @@ parseData :: (Result JSValue, Result JSValue, Result JSValue, Result JSValue)
-> Result (Group.List, Node.List, Instance.List, [String])
parseData (groups, nodes, instances, cinfo) = do
group_data <- groups >>= getGroups
- let (_, group_idx) = assignIndices group_data
- node_data <- nodes >>= getNodes
+ let (group_names, group_idx) = assignIndices group_data
+ node_data <- nodes >>= getNodes group_names
let (node_names, node_idx) = assignIndices node_data
inst_data <- instances >>= getInstances node_names
let (_, inst_idx) = assignIndices inst_data
diff --git a/Ganeti/HTools/Node.hs b/Ganeti/HTools/Node.hs
index 5fd331d7b..73162e6ea 100644
--- a/Ganeti/HTools/Node.hs
+++ b/Ganeti/HTools/Node.hs
@@ -121,7 +121,7 @@ data Node = Node
, utilPool :: T.DynUtil -- ^ Total utilisation capacity
, utilLoad :: T.DynUtil -- ^ Sum of instance utilisation
, 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)
instance T.Element Node where
@@ -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
-- update later via the 'setIdx' and 'buildPeers' functions.
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
dsk_t_init dsk_f_init cpu_t_init offline_init group_init =
Node { name = name_init
@@ -487,7 +487,6 @@ showField t field =
"ptags" -> intercalate "," . map (\(k, v) -> printf "%s=%d" k v) .
Map.toList $ pTags t
"peermap" -> show $ peers t
- "group.uuid" -> group t
_ -> T.unknownField
where
T.DynUtil { T.cpuWeight = uC, T.memWeight = uM,
@@ -526,7 +525,7 @@ showHeader field =
"nload" -> ("lNet", True)
"ptags" -> ("PrimaryTags", False)
"peermap" -> ("PeerMap", False)
- "group.uuid" -> ("GroupUUID", False)
+ -- TODO: add node fields (group.uuid, group)
_ -> (T.unknownField, False)
-- | String converter for the node list functionality.
@@ -543,7 +542,7 @@ defaultFields =
-- | Split a list of nodes into a list of (node group UUID, list of
-- associated nodes)
-computeGroups :: [Node] -> [(T.GroupID, [Node])]
+computeGroups :: [Node] -> [(T.Gdx, [Node])]
computeGroups nodes =
let nodes' = sortBy (comparing group) nodes
nodes'' = groupBy (\a b -> group a == group b) nodes'
diff --git a/Ganeti/HTools/QC.hs b/Ganeti/HTools/QC.hs
index bf83fcc41..536d1bf2d 100644
--- a/Ganeti/HTools/QC.hs
+++ b/Ganeti/HTools/QC.hs
@@ -56,6 +56,7 @@ import qualified Ganeti.HTools.Instance as Instance
import qualified Ganeti.HTools.Loader as Loader
import qualified Ganeti.HTools.Luxi
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.Rapi
import qualified Ganeti.HTools.Simu
@@ -78,6 +79,17 @@ maxDsk = 1024 * 1024 * 8
maxCpu :: Int
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
-- | Simple checker for whether OpResult is fail or pass
@@ -187,7 +199,7 @@ instance Arbitrary Node.Node where
offl <- arbitrary
let n = Node.create name (fromIntegral mem_t) mem_n mem_f
(fromIntegral dsk_t) dsk_f (fromIntegral cpu_t) offl
- Utils.defaultGroupID
+ 0
n' = Node.buildPeers n Container.empty
return n'
@@ -483,7 +495,9 @@ prop_Text_Load_Node name tm nm fm td fd tc fo =
then "Y"
else "N"
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
Just (name', node) ->
if fo || any_broken
@@ -498,11 +512,11 @@ prop_Text_Load_Node name tm nm fm td fd tc fo =
Node.tCpu node == fromIntegral tc
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 =
- (Text.loadNode .
- Utils.sepSplit '|' . Text.serializeNode) n ==
+ (Text.loadNode defGroupAssoc.
+ Utils.sepSplit '|' . Text.serializeNode defGroupList) n ==
Just (Node.name n, n)
-- override failN1 to what loadNode returns by default
where n = node { Node.failN1 = True, Node.offline = False }
@@ -750,7 +764,7 @@ prop_ClusterAllocBalance node =
prop_ClusterCheckConsistency node inst =
let nl = makeSmallCluster node 3
[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
inst1 = Instance.setBoth inst (Node.idx node1) (Node.idx node2)
inst2 = Instance.setBoth inst (Node.idx node1) Node.noSecondary
diff --git a/Ganeti/HTools/Rapi.hs b/Ganeti/HTools/Rapi.hs
index 5b6b3f295..1d33214b5 100644
--- a/Ganeti/HTools/Rapi.hs
+++ b/Ganeti/HTools/Rapi.hs
@@ -71,9 +71,9 @@ getInstances ktn body =
mapM (parseInstance ktn . fromJSObject)
-- | Parse a node list in JSON format.
-getNodes :: String -> Result [(String, Node.Node)]
-getNodes body = loadJSArray "Parsing node data" body >>=
- mapM (parseNode . fromJSObject)
+getNodes :: NameAssoc -> String -> Result [(String, Node.Node)]
+getNodes ktg body = loadJSArray "Parsing node data" body >>=
+ mapM (parseNode ktg . fromJSObject)
-- | Parse a group list in JSON format.
getGroups :: String -> Result [(String, Group.Group)]
@@ -105,13 +105,13 @@ parseInstance ktn a = do
return (name, inst)
-- | Construct a node from a JSON object.
-parseNode :: [(String, JSValue)] -> Result (String, Node.Node)
-parseNode a = do
+parseNode :: NameAssoc -> [(String, JSValue)] -> Result (String, Node.Node)
+parseNode ktg a = do
name <- tryFromObj "Parsing new node" a "name"
let extract s = tryFromObj ("Node '" ++ name ++ "'") a s
offline <- extract "offline"
drained <- extract "drained"
- guuid <- extract "group.uuid"
+ guuid <- extract "group.uuid" >>= lookupGroup ktg name
node <- (if offline || drained
then return $ Node.create name 0 0 0 0 0 0 True guuid
else do
@@ -149,8 +149,8 @@ parseData :: (Result String, Result String, Result String, Result String)
-> Result (Group.List, Node.List, Instance.List, [String])
parseData (group_body, node_body, inst_body, tags_body) = do
group_data <- group_body >>= getGroups
- let (_, group_idx) = assignIndices group_data
- node_data <- node_body >>= getNodes
+ let (group_names, group_idx) = assignIndices group_data
+ node_data <- node_body >>= getNodes group_names
let (node_names, node_idx) = assignIndices node_data
inst_data <- inst_body >>= getInstances node_names
let (_, inst_idx) = assignIndices inst_data
diff --git a/Ganeti/HTools/Simu.hs b/Ganeti/HTools/Simu.hs
index 503394e22..f2a71d9a3 100644
--- a/Ganeti/HTools/Simu.hs
+++ b/Ganeti/HTools/Simu.hs
@@ -62,7 +62,7 @@ parseData ndata = do
let n = Node.create (printf "node%03d" idx)
(fromIntegral mem) 0 mem
(fromIntegral disk) disk
- (fromIntegral cpu) False defaultGroupID
+ (fromIntegral cpu) False 0
in (idx, Node.setIdx n idx)
) [1..cnt]
return (Container.fromAssocList [(0, Group.setIdx defgroup 0)],
diff --git a/Ganeti/HTools/Text.hs b/Ganeti/HTools/Text.hs
index e49e30a5d..2b2c725ff 100644
--- a/Ganeti/HTools/Text.hs
+++ b/Ganeti/HTools/Text.hs
@@ -52,17 +52,18 @@ import qualified Ganeti.HTools.Node as Node
import qualified Ganeti.HTools.Instance as Instance
-- | Serialize a single node
-serializeNode :: Node.Node -> String
-serializeNode node =
+serializeNode :: Group.List -> Node.Node -> String
+serializeNode gl node =
printf "%s|%.0f|%d|%d|%.0f|%d|%.0f|%c|%s" (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')
- (Node.group node)
+ (Group.uuid grp)
+ where grp = Container.find (Node.group node) gl
-- | Generate node file data from node objects
-serializeNodes :: Node.List -> String
-serializeNodes = unlines . map serializeNode . Container.elems
+serializeNodes :: Group.List -> Node.List -> String
+serializeNodes gl = unlines . map (serializeNode gl) . Container.elems
-- | Serialize a single instance
serializeInstance :: Node.List -> Instance.Instance -> String
@@ -86,9 +87,9 @@ serializeInstances nl =
unlines . map (serializeInstance nl) . Container.elems
-- | Generate complete cluster data from node and instance lists
-serializeCluster :: Node.List -> Instance.List -> String
-serializeCluster nl il =
- let ndata = serializeNodes nl
+serializeCluster :: Group.List -> Node.List -> Instance.List -> String
+serializeCluster gl nl il =
+ let ndata = serializeNodes gl nl
idata = serializeInstances nl il
in ndata ++ ['\n'] ++ idata
@@ -100,14 +101,12 @@ loadGroup [name, gid] =
loadGroup s = fail $ "Invalid/incomplete group data: '" ++ show s ++ "'"
-- | Load a node from a field list.
-loadNode :: (Monad m) => [String] -> m (String, Node.Node)
--- compatibility wrapper for old text files
-loadNode [name, tm, nm, fm, td, fd, tc, fo] =
- loadNode [name, tm, nm, fm, td, fd, tc, fo, defaultGroupID]
-loadNode [name, tm, nm, fm, td, fd, tc, fo, gu] = do
+loadNode :: (Monad m) => NameAssoc -> [String] -> m (String, Node.Node)
+loadNode ktg [name, tm, nm, fm, td, fd, tc, fo, gu] = do
+ gdx <- lookupGroup ktg name gu
new_node <-
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
vtm <- tryRead name tm
vnm <- tryRead name nm
@@ -115,9 +114,9 @@ loadNode [name, tm, nm, fm, td, fd, tc, fo, gu] = do
vtd <- tryRead name td
vfd <- tryRead name fd
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)
-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.
loadInst :: (Monad m) =>
@@ -168,9 +167,9 @@ parseData fdata = do
[] -> Bad "Invalid format of the input file (no instance data)"
_:xs -> Ok xs
{- 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 -}
- (ktn, nl) <- loadTabular nfixed loadNode
+ (ktn, nl) <- loadTabular nfixed (loadNode ktg)
{- instance file: name mem disk status pnode snode -}
(_, il) <- loadTabular ifixed (loadInst ktn)
return (gl, nl, il, [])
diff --git a/hbal.hs b/hbal.hs
index 68a391f4c..47ad6b112 100644
--- a/hbal.hs
+++ b/hbal.hs
@@ -41,6 +41,7 @@ import Text.Printf (printf, hPrintf)
import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Cluster as Cluster
+import qualified Ganeti.HTools.Group as Group
import qualified Ganeti.HTools.Node as Node
import qualified Ganeti.HTools.Instance as Instance
@@ -226,7 +227,7 @@ main = do
verbose = optVerbose opts
shownodes = optShowNodes opts
- (_, fixed_nl, ilf, ctags) <- loadExternalData opts
+ (gl, fixed_nl, ilf, ctags) <- loadExternalData opts
let offline_names = optOffline opts
all_nodes = Container.elems fixed_nl
@@ -270,7 +271,7 @@ main = do
let ngroups = Cluster.splitCluster nlf ilf
when (length ngroups > 1 && isNothing (optGroup opts)) $ do
hPutStrLn stderr "Found multiple node groups:"
- mapM_ (hPutStrLn stderr . (" " ++) . fst ) ngroups
+ mapM_ (hPutStrLn stderr . (" " ++) . show . fst ) ngroups
hPutStrLn stderr "Aborting."
exitWith $ ExitFailure 1
@@ -278,22 +279,32 @@ main = do
(Container.size nlf)
(Container.size ilf)
- (guuid, (nl, il)) <- case optGroup opts of
- Nothing -> return $ head ngroups
- Just g -> case lookup g ngroups of
+ (gname, (nl, il)) <- case optGroup opts of
+ Nothing -> do
+ let (gidx, cdata) = head ngroups
+ grp = Container.find gidx gl
+ return (Group.name grp, cdata)
+ Just g -> case Container.findByName gl g of
Nothing -> do
hPutStrLn stderr $ "Node group " ++ g ++
" not found. Node group list is:"
- mapM_ (hPutStrLn stderr . (" " ++) . fst ) ngroups
+ mapM_ (hPutStrLn stderr . (" " ++) . Group.name ) (Container.elems gl)
hPutStrLn stderr "Aborting."
exitWith $ ExitFailure 1
- Just cdata -> return (g, cdata)
+ Just grp ->
+ case lookup (Group.idx grp) ngroups of
+ Nothing -> do
+ -- TODO: while this is unlikely to happen, log here the
+ -- actual group data to help debugging
+ hPutStrLn stderr $ "Internal failure, missing group idx"
+ exitWith $ ExitFailure 1
+ Just cdata -> return (Group.name grp, cdata)
unless oneline $ printf "Group size %d nodes, %d instances\n"
(Container.size nl)
(Container.size il)
- putStrLn $ "Selected node group: " ++ guuid
+ putStrLn $ "Selected node group: " ++ gname
when (length csf > 0 && not oneline && verbose > 1) $
printf "Note: Stripping common suffix of '%s' from names\n" csf
@@ -379,7 +390,7 @@ main = do
when (isJust $ optSaveCluster opts) $
do
let out_path = fromJust $ optSaveCluster opts
- adata = serializeCluster fin_nl fin_il
+ adata = serializeCluster gl fin_nl fin_il
writeFile out_path adata
printf "The cluster state has been written to file '%s'\n" out_path
diff --git a/hscan.hs b/hscan.hs
index 9e1877760..5c8dbda90 100644
--- a/hscan.hs
+++ b/hscan.hs
@@ -95,7 +95,7 @@ processData :: Result (Group.List, Node.List, Instance.List, [String])
processData input_data = do
(gl, nl, il, _) <- input_data >>= Loader.mergeData [] [] []
let (_, fix_nl) = Loader.checkData nl il
- adata = serializeCluster nl il
+ adata = serializeCluster gl nl il
return (gl, fix_nl, il, adata)
-- | Writes cluster data out
diff --git a/hspace.hs b/hspace.hs
index 189b0ba98..103a63088 100644
--- a/hspace.hs
+++ b/hspace.hs
@@ -207,7 +207,7 @@ main = do
ispec = optISpec opts
shownodes = optShowNodes opts
- (_, fixed_nl, il, _) <- loadExternalData opts
+ (gl, fixed_nl, il, _) <- loadExternalData opts
printKeys $ map (\(a, fn) -> ("SPEC_" ++ a, fn ispec)) specData
printKeys [ ("SPEC_RQN", printf "%d" (optINodes opts)) ]
@@ -312,7 +312,7 @@ main = do
when (isJust $ optSaveCluster opts) $
do
let out_path = (fromJust $ optSaveCluster opts) <.> "tiered"
- adata = serializeCluster trl_nl trl_il
+ adata = serializeCluster gl trl_nl trl_il
writeFile out_path adata
hPrintf stderr "The cluster state after tiered allocation\
\ has been written to file '%s'\n"
@@ -346,7 +346,7 @@ main = do
when (isJust $ optSaveCluster opts) $
do
let out_path = (fromJust $ optSaveCluster opts) <.> "alloc"
- adata = serializeCluster fin_nl fin_il
+ adata = serializeCluster gl fin_nl fin_il
writeFile out_path adata
hPrintf stderr "The cluster state after standard allocation\
\ has been written to file '%s'\n"
--
GitLab