This patch completes the support for setting/getting the exclusive_storage
in the configuration. The flag has still no effects.
INCOMPLETE, WORK IN PROGESS: If the value is absent in a node group, the
query fails instead of reading the cluster value.
Signed-off-by: Bernardo Dal Seno <bdals...@google.com>
---
htest/Test/Ganeti/Objects.hs | 1 +
htest/Test/Ganeti/TestHTools.hs | 2 +-
htools/Ganeti/HTools/Backend/IAlloc.hs | 3 ++-
htools/Ganeti/HTools/Backend/Luxi.hs | 7 ++++---
htools/Ganeti/HTools/Backend/Rapi.hs | 3 ++-
htools/Ganeti/HTools/Backend/Simu.hs | 2 +-
htools/Ganeti/HTools/Backend/Text.hs | 14 +++++++++++---
htools/Ganeti/HTools/Group.hs | 9 ++++++---
htools/Ganeti/Objects.hs | 1 +
htools/Ganeti/Query/Group.hs | 3 +++
10 files changed, 32 insertions(+), 13 deletions(-)
diff --git a/htest/Test/Ganeti/Objects.hs b/htest/Test/Ganeti/Objects.hs
index 66b7042..002f618 100644
--- a/htest/Test/Ganeti/Objects.hs
+++ b/htest/Test/Ganeti/Objects.hs
@@ -121,6 +121,7 @@ $(genArbitrary ''PartialIPolicy)
instance Arbitrary NodeGroup where
arbitrary = NodeGroup <$> genFQDN <*> pure [] <*> arbitrary <*> arbitrary
<*> arbitrary <*> pure (GenericContainer Map.empty)
+ <*> arbitrary
-- ts
<*> arbitrary <*> arbitrary
-- uuid
diff --git a/htest/Test/Ganeti/TestHTools.hs b/htest/Test/Ganeti/TestHTools.hs
index 44b53c8..b383227 100644
--- a/htest/Test/Ganeti/TestHTools.hs
+++ b/htest/Test/Ganeti/TestHTools.hs
@@ -74,7 +74,7 @@ nullIPolicy = Types.IPolicy
defGroup :: Group.Group
defGroup = flip Group.setIdx 0 $
Group.create "default" Types.defaultGroupID Types.AllocPreferred
- nullIPolicy []
+ nullIPolicy [] False
defGroupList :: Group.List
defGroupList = Container.fromList [(Group.idx defGroup, defGroup)]
diff --git a/htools/Ganeti/HTools/Backend/IAlloc.hs
b/htools/Ganeti/HTools/Backend/IAlloc.hs
index fe0746f..687ac66 100644
--- a/htools/Ganeti/HTools/Backend/IAlloc.hs
+++ b/htools/Ganeti/HTools/Backend/IAlloc.hs
@@ -131,7 +131,8 @@ parseGroup u a = do
apol <- extract "alloc_policy"
ipol <- extract "ipolicy"
tags <- extract "tags"
- return (u, Group.create name u apol ipol tags)
+ estor <- fromObjWithDefault a "exclusive_storage" False
+ return (u, Group.create name u apol ipol tags estor)
-- | Top-level parser.
--
diff --git a/htools/Ganeti/HTools/Backend/Luxi.hs
b/htools/Ganeti/HTools/Backend/Luxi.hs
index b317808..5578feb 100644
--- a/htools/Ganeti/HTools/Backend/Luxi.hs
+++ b/htools/Ganeti/HTools/Backend/Luxi.hs
@@ -123,7 +123,7 @@ queryClusterInfoMsg = L.QueryClusterInfo
queryGroupsMsg :: L.LuxiOp
queryGroupsMsg =
L.Query (Qlang.ItemTypeOpCode Qlang.QRGroup)
- ["uuid", "name", "alloc_policy", "ipolicy", "tags"]
+ ["uuid", "name", "alloc_policy", "ipolicy", "tags", "exclusive_storage"]
Qlang.EmptyFilter
-- | Wraper over 'callMethod' doing node query.
@@ -226,14 +226,15 @@ getGroups jsv = extractArray jsv >>= mapM parseGroup
-- | Parses a given group information.
parseGroup :: [(JSValue, JSValue)] -> Result (String, Group.Group)
-parseGroup [uuid, name, apol, ipol, tags] = do
+parseGroup [uuid, name, apol, ipol, tags, estor] = do
xname <- annotateResult "Parsing new group" (fromJValWithStatus name)
let convert a = genericConvert "Group" xname a
xuuid <- convert "uuid" uuid
xapol <- convert "alloc_policy" apol
xipol <- convert "ipolicy" ipol
xtags <- convert "tags" tags
- return (xuuid, Group.create xname xuuid xapol xipol xtags)
+ xestor <- convert "exclusive_storage" estor
+ return (xuuid, Group.create xname xuuid xapol xipol xtags xestor)
parseGroup v = fail ("Invalid group query result: " ++ show v)
diff --git a/htools/Ganeti/HTools/Backend/Rapi.hs
b/htools/Ganeti/HTools/Backend/Rapi.hs
index 005cfdb..23a7ac2 100644
--- a/htools/Ganeti/HTools/Backend/Rapi.hs
+++ b/htools/Ganeti/HTools/Backend/Rapi.hs
@@ -186,7 +186,8 @@ parseGroup a = do
apol <- extract "alloc_policy"
ipol <- extract "ipolicy"
tags <- extract "tags"
- return (uuid, Group.create name uuid apol ipol tags)
+ esto <- fromObjWithDefault a "exclusive_storage" False
+ return (uuid, Group.create name uuid apol ipol tags esto)
-- | Parse cluster data from the info resource.
parseCluster :: JSObject JSValue -> Result ([String], IPolicy)
diff --git a/htools/Ganeti/HTools/Backend/Simu.hs
b/htools/Ganeti/HTools/Backend/Simu.hs
index fe779df..3ff436b 100644
--- a/htools/Ganeti/HTools/Backend/Simu.hs
+++ b/htools/Ganeti/HTools/Backend/Simu.hs
@@ -84,7 +84,7 @@ createGroup grpIndex spec = do
(fromIntegral cpu) False spindles grpIndex
) [1..ncount]
grp = Group.create (printf "group-%02d" grpIndex)
- (printf "fake-uuid-%02d" grpIndex) apol defIPolicy []
+ (printf "fake-uuid-%02d" grpIndex) apol defIPolicy [] False
return (Group.setIdx grp grpIndex, nodes)
-- | Builds the cluster data from node\/instance files.
diff --git a/htools/Ganeti/HTools/Backend/Text.hs
b/htools/Ganeti/HTools/Backend/Text.hs
index cb3719c..23afbed 100644
--- a/htools/Ganeti/HTools/Backend/Text.hs
+++ b/htools/Ganeti/HTools/Backend/Text.hs
@@ -67,9 +67,10 @@ commaSplit = sepSplit ','
-- | Serialize a single group.
serializeGroup :: Group.Group -> String
serializeGroup grp =
- printf "%s|%s|%s|%s" (Group.name grp) (Group.uuid grp)
+ printf "%s|%s|%s|%s|%c" (Group.name grp) (Group.uuid grp)
(allocPolicyToRaw (Group.allocPolicy grp))
(intercalate "," (Group.allTags grp))
+ (if Group.exclusiveStorage grp then 'Y' else 'N')
-- | Generate group file data from a group list.
serializeGroups :: Group.List -> String
@@ -169,10 +170,17 @@ serializeCluster (ClusterData gl nl il ctags cpol) =
loadGroup :: (Monad m) => [String]
-> m (String, Group.Group) -- ^ The result, a tuple of group
-- UUID and group object
-loadGroup [name, gid, apol, tags] = do
+loadGroup [name, gid, apol, tags, estor] = do
xapol <- allocPolicyFromRaw apol
let xtags = commaSplit tags
- return (gid, Group.create name gid xapol defIPolicy xtags)
+ xestor <- case estor of
+ "Y" -> return True
+ "N" -> return False
+ _ -> fail $ "Invalid exclusive_storage value '" ++ estor ++
+ "' for group " ++ name
+ return (gid, Group.create name gid xapol defIPolicy xtags xestor)
+
+loadGroup [n, g, a, t] = loadGroup [n, g, a, t, "N"]
loadGroup s = fail $ "Invalid/incomplete group data: '" ++ show s ++ "'"
diff --git a/htools/Ganeti/HTools/Group.hs b/htools/Ganeti/HTools/Group.hs
index acef35f..00f574d 100644
--- a/htools/Ganeti/HTools/Group.hs
+++ b/htools/Ganeti/HTools/Group.hs
@@ -41,12 +41,13 @@ import qualified Ganeti.HTools.Types as T
-- | The node group type.
data Group = Group
- { name :: String -- ^ The node name
+ { name :: String -- ^ The group name
, uuid :: T.GroupID -- ^ The UUID of the group
, idx :: T.Gdx -- ^ Internal index for book-keeping
, allocPolicy :: T.AllocPolicy -- ^ The allocation policy for this group
, iPolicy :: T.IPolicy -- ^ The instance policy for this group
, allTags :: [String] -- ^ The tags for this group
+ , exclusiveStorage :: Bool -- ^ Exclusive storage attribute
} deriving (Show, Eq)
-- Note: we use the name as the alias, and the UUID as the official
@@ -67,13 +68,15 @@ type List = Container.Container Group
-- * Initialization functions
-- | Create a new group.
-create :: String -> T.GroupID -> T.AllocPolicy -> T.IPolicy -> [String] ->
Group
-create name_init id_init apol_init ipol_init tags_init =
+create :: String -> T.GroupID -> T.AllocPolicy -> T.IPolicy -> [String] -> Bool
+ -> Group
+create name_init id_init apol_init ipol_init tags_init excl_stor_init =
Group { name = name_init
, uuid = id_init
, allocPolicy = apol_init
, iPolicy = ipol_init
, allTags = tags_init
+ , exclusiveStorage = excl_stor_init
, idx = -1
}
diff --git a/htools/Ganeti/Objects.hs b/htools/Ganeti/Objects.hs
index 32299d8..7c4e0e7 100644
--- a/htools/Ganeti/Objects.hs
+++ b/htools/Ganeti/Objects.hs
@@ -470,6 +470,7 @@ $(buildObject "NodeGroup" "group" $
, simpleField "alloc_policy" [t| AllocPolicy |]
, simpleField "ipolicy" [t| PartialIPolicy |]
, simpleField "diskparams" [t| DiskParams |]
+ , defaultField [| False |] $ simpleField "exclusive_storage" [t| Bool |]
]
++ timeStampFields
++ uuidFields
diff --git a/htools/Ganeti/Query/Group.hs b/htools/Ganeti/Query/Group.hs
index acf9083..fb9c715 100644
--- a/htools/Ganeti/Query/Group.hs
+++ b/htools/Ganeti/Query/Group.hs
@@ -76,6 +76,9 @@ groupFields =
"List of primary instances",
FieldConfig (\cfg -> rsNormal . map instName . fst .
getGroupInstances cfg . groupName))
+ , (FieldDefinition "exclusive_storage" "ExclusiveStorage" QFTBool
+ "Exclusive storage",
+ FieldSimple (rsNormal . groupExclusiveStorage))
] ++
map buildNdParamField allNDParamFields ++
timeStampFields ++
--
1.7.7.3
