From f89235f10d793d8be50414b80f22f523afd7ed27 Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Tue, 1 Dec 2009 11:47:15 +0100
Subject: [PATCH] Read cluster tags in the LUXI backend
---
Ganeti/HTools/Luxi.hs | 20 ++++++++++++++++++--
Ganeti/Luxi.hs | 2 ++
2 files changed, 20 insertions(+), 2 deletions(-)
diff --git a/Ganeti/HTools/Luxi.hs b/Ganeti/HTools/Luxi.hs
index f60cce09a..a54740597 100644
--- a/Ganeti/HTools/Luxi.hs
+++ b/Ganeti/HTools/Luxi.hs
@@ -38,7 +38,7 @@ import Ganeti.HTools.Loader
import Ganeti.HTools.Types
import qualified Ganeti.HTools.Node as Node
import qualified Ganeti.HTools.Instance as Instance
-import Ganeti.HTools.Utils (fromJVal, annotateResult)
+import Ganeti.HTools.Utils (fromJVal, annotateResult, tryFromObj, asJSObject)
-- * Utility functions
@@ -75,6 +75,10 @@ queryInstancesMsg =
use_locking = JSBool False
in JSArray [nnames, fields, use_locking]
+-- | The input data for cluster query
+queryClusterInfoMsg :: JSValue
+queryClusterInfoMsg = JSArray []
+
-- | Wraper over callMethod doing node query.
queryNodes :: L.Client -> IO (Result JSValue)
queryNodes = L.callMethod L.QueryNodes queryNodesMsg
@@ -83,6 +87,9 @@ queryNodes = L.callMethod L.QueryNodes queryNodesMsg
queryInstances :: L.Client -> IO (Result JSValue)
queryInstances = L.callMethod L.QueryInstances queryInstancesMsg
+queryClusterInfo :: L.Client -> IO (Result JSValue)
+queryClusterInfo = L.callMethod L.QueryClusterInfo queryClusterInfoMsg
+
-- | Parse a instance list in JSON format.
getInstances :: NameAssoc
-> JSValue
@@ -140,6 +147,13 @@ parseNode (JSArray [ name, mtotal, mnode, mfree, dtotal, dfree
parseNode v = fail ("Invalid node query result: " ++ show v)
+getClusterTags :: JSValue -> Result [String]
+getClusterTags v = do
+ let errmsg = "Parsing cluster info"
+ obj <- annotateResult errmsg $ asJSObject v
+ tags <- tryFromObj errmsg (fromJSObject obj) "tag"
+ return tags
+
-- * Main loader functionality
-- | Builds the cluster data from an URL.
@@ -152,10 +166,12 @@ loadData master =
(\s -> do
nodes <- queryNodes s
instances <- queryInstances s
+ cinfo <- queryClusterInfo s
return $ do -- Result monad
node_data <- nodes >>= getNodes
let (node_names, node_idx) = assignIndices node_data
inst_data <- instances >>= getInstances node_names
let (_, inst_idx) = assignIndices inst_data
- return (node_idx, inst_idx, [])
+ ctags <- cinfo >>= getClusterTags
+ return (node_idx, inst_idx, ctags)
)
diff --git a/Ganeti/Luxi.hs b/Ganeti/Luxi.hs
index 707341281..0468a4df1 100644
--- a/Ganeti/Luxi.hs
+++ b/Ganeti/Luxi.hs
@@ -63,6 +63,7 @@ withTimeout secs descr action = do
data LuxiOp = QueryInstances
| QueryNodes
| QueryJobs
+ | QueryClusterInfo
| SubmitManyJobs
-- | The serialisation of LuxiOps into strings in messages.
@@ -70,6 +71,7 @@ strOfOp :: LuxiOp -> String
strOfOp QueryNodes = "QueryNodes"
strOfOp QueryInstances = "QueryInstances"
strOfOp QueryJobs = "QueryJobs"
+strOfOp QueryClusterInfo = "QueryClusterInfo"
strOfOp SubmitManyJobs = "SubmitManyJobs"
-- | The end-of-message separator.
--
GitLab