From 716c6be57f60c6a3e7416e257010cf970b6d7a40 Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Thu, 16 Dec 2010 13:03:36 +0100
Subject: [PATCH] Text.hs: serialize cluster tags when writing data
This is the complement to the reading part. Now the live-test works
correctly against clusters with configured exclusion tags.
Signed-off-by: Iustin Pop <iustin@google.com>
Reviewed-by: Balazs Lecz <leczb@google.com>
---
Ganeti/HTools/Text.hs | 8 +++++---
hbal.hs | 2 +-
hscan.hs | 4 ++--
hspace.hs | 6 +++---
4 files changed, 11 insertions(+), 9 deletions(-)
diff --git a/Ganeti/HTools/Text.hs b/Ganeti/HTools/Text.hs
index 9875d7550..cf990609b 100644
--- a/Ganeti/HTools/Text.hs
+++ b/Ganeti/HTools/Text.hs
@@ -96,12 +96,14 @@ serializeInstances nl =
unlines . map (serializeInstance nl) . Container.elems
-- | Generate complete cluster data from node and instance lists
-serializeCluster :: Group.List -> Node.List -> Instance.List -> String
-serializeCluster gl nl il =
+serializeCluster :: Group.List -> Node.List -> Instance.List -> [String]
+ -> String
+serializeCluster gl nl il ctags =
let gdata = serializeGroups gl
ndata = serializeNodes gl nl
idata = serializeInstances nl il
- in gdata ++ ['\n'] ++ ndata ++ ['\n'] ++ idata
+ -- note: not using 'unlines' as that adds too many newlines
+ in intercalate "\n" [gdata, ndata, idata, unlines ctags]
-- | Load a group from a field list.
loadGroup :: (Monad m) => [String] -> m (String, Group.Group)
diff --git a/hbal.hs b/hbal.hs
index 408cdb8f9..a83b7fc36 100644
--- a/hbal.hs
+++ b/hbal.hs
@@ -391,7 +391,7 @@ main = do
when (isJust $ optSaveCluster opts) $
do
let out_path = fromJust $ optSaveCluster opts
- adata = serializeCluster gl fin_nl fin_il
+ adata = serializeCluster gl fin_nl fin_il ctags
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 5c8dbda90..e99efebfd 100644
--- a/hscan.hs
+++ b/hscan.hs
@@ -93,9 +93,9 @@ fixSlash = map (\x -> if x == '/' then '_' else x)
processData :: Result (Group.List, Node.List, Instance.List, [String])
-> Result (Group.List, Node.List, Instance.List, String)
processData input_data = do
- (gl, nl, il, _) <- input_data >>= Loader.mergeData [] [] []
+ (gl, nl, il, ctags) <- input_data >>= Loader.mergeData [] [] []
let (_, fix_nl) = Loader.checkData nl il
- adata = serializeCluster gl nl il
+ adata = serializeCluster gl nl il ctags
return (gl, fix_nl, il, adata)
-- | Writes cluster data out
diff --git a/hspace.hs b/hspace.hs
index 103a63088..8410f4658 100644
--- a/hspace.hs
+++ b/hspace.hs
@@ -207,7 +207,7 @@ main = do
ispec = optISpec opts
shownodes = optShowNodes opts
- (gl, fixed_nl, il, _) <- loadExternalData opts
+ (gl, fixed_nl, il, ctags) <- 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 gl trl_nl trl_il
+ adata = serializeCluster gl trl_nl trl_il ctags
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 gl fin_nl fin_il
+ adata = serializeCluster gl fin_nl fin_il ctags
writeFile out_path adata
hPrintf stderr "The cluster state after standard allocation\
\ has been written to file '%s'\n"
--
GitLab