diff --git a/Ganeti/HTools/IAlloc.hs b/Ganeti/HTools/IAlloc.hs
index ef5d6608138ca6b2f059cb375bf387b596ffd053..b43939c8e13291405afb272e405628184ad48cf6 100644
--- a/Ganeti/HTools/IAlloc.hs
+++ b/Ganeti/HTools/IAlloc.hs
@@ -52,8 +52,9 @@ parseBaseInstance n a = do
disk <- fromObj "disk_space_total" a
mem <- fromObj "memory" a
vcpus <- fromObj "vcpus" a
+ tags <- fromObj "tags" a
let running = "running"
- return (n, Instance.create n mem disk vcpus running 0 0)
+ return (n, Instance.create n mem disk vcpus running tags 0 0)
-- | Parses an instance as found in the cluster instance listg.
parseInstance :: NameAssoc -- ^ The node name-to-index association list
diff --git a/Ganeti/HTools/Instance.hs b/Ganeti/HTools/Instance.hs
index fe64d637cac67432c979f907befa3eb0ca3b2fb4..c3b532432e232242394b52ee13e9f1dd775ebf53 100644
--- a/Ganeti/HTools/Instance.hs
+++ b/Ganeti/HTools/Instance.hs
@@ -56,6 +56,7 @@ data Instance = Instance { name :: String -- ^ The instance name
, sNode :: T.Ndx -- ^ Original secondary node
, idx :: T.Idx -- ^ Internal index
, util :: T.DynUtil -- ^ Dynamic resource usage
+ , tags :: [String] -- ^ List of instance tags
} deriving (Show)
instance T.Element Instance where
@@ -86,8 +87,9 @@ type List = Container.Container Instance
--
-- Some parameters are not initialized by function, and must be set
-- later (via 'setIdx' for example).
-create :: String -> Int -> Int -> Int -> String -> T.Ndx -> T.Ndx -> Instance
-create name_init mem_init dsk_init vcpus_init run_init pn sn =
+create :: String -> Int -> Int -> Int -> String
+ -> [String] -> T.Ndx -> T.Ndx -> Instance
+create name_init mem_init dsk_init vcpus_init run_init tags_init pn sn =
Instance { name = name_init
, mem = mem_init
, dsk = dsk_init
@@ -98,6 +100,7 @@ create name_init mem_init dsk_init vcpus_init run_init pn sn =
, sNode = sn
, idx = -1
, util = T.baseUtil
+ , tags = tags_init
}
-- | Changes the index.
diff --git a/Ganeti/HTools/Luxi.hs b/Ganeti/HTools/Luxi.hs
index 27d23a56cc3b57f812643d069b3b65454c9d3cbf..c2e8bdb53f1f02bda56e1427e5da6019c722b4bc 100644
--- a/Ganeti/HTools/Luxi.hs
+++ b/Ganeti/HTools/Luxi.hs
@@ -70,7 +70,7 @@ queryInstancesMsg =
let nnames = JSArray []
fnames = ["name",
"disk_usage", "be/memory", "be/vcpus",
- "status", "pnode", "snodes"]
+ "status", "pnode", "snodes", "tags"]
fields = JSArray $ map (JSString . toJSString) fnames
use_locking = JSBool False
in JSArray [nnames, fields, use_locking]
@@ -94,7 +94,7 @@ parseInstance :: [(String, Ndx)]
-> JSValue
-> Result (String, Instance.Instance)
parseInstance ktn (JSArray [ name, disk, mem, vcpus
- , status, pnode, snodes ]) = do
+ , status, pnode, snodes, tags ]) = do
xname <- annotateResult "Parsing new instance" (fromJVal name)
let convert v = annotateResult ("Instance '" ++ xname ++ "'") (fromJVal v)
xdisk <- convert disk
@@ -105,7 +105,9 @@ parseInstance ktn (JSArray [ name, disk, mem, vcpus
snode <- (if null xsnodes then return Node.noSecondary
else lookupNode ktn xname (fromJSString $ head xsnodes))
xrunning <- convert status
- let inst = Instance.create xname xmem xdisk xvcpus xrunning xpnode snode
+ xtags <- convert tags
+ let inst = Instance.create xname xmem xdisk xvcpus
+ xrunning xtags xpnode snode
return (xname, inst)
parseInstance _ v = fail ("Invalid instance query result: " ++ show v)
diff --git a/Ganeti/HTools/Rapi.hs b/Ganeti/HTools/Rapi.hs
index 6050f30965f4424e92b741cc8063b6b3647dccf9..d8595725e8338a9db2179e88f2bf9e09905893ee 100644
--- a/Ganeti/HTools/Rapi.hs
+++ b/Ganeti/HTools/Rapi.hs
@@ -88,7 +88,8 @@ parseInstance ktn a = do
snode <- (if null snodes then return Node.noSecondary
else readEitherString (head snodes) >>= lookupNode ktn name)
running <- extract "status" a
- let inst = Instance.create name mem disk vcpus running pnode snode
+ tags <- extract "tags" a
+ let inst = Instance.create name mem disk vcpus running tags pnode snode
return (name, inst)
-- | Construct a node from a JSON object.
diff --git a/Ganeti/HTools/Text.hs b/Ganeti/HTools/Text.hs
index 69737a8a0356cf5d59c1c43b6142d2b7bfbcf388..cd82aa8123da5ccca029ff7877aabb985a13b3ab 100644
--- a/Ganeti/HTools/Text.hs
+++ b/Ganeti/HTools/Text.hs
@@ -60,7 +60,7 @@ loadNode s = fail $ "Invalid/incomplete node data: '" ++ show s ++ "'"
-- | Load an instance from a field list.
loadInst :: (Monad m) =>
[(String, Ndx)] -> [String] -> m (String, Instance.Instance)
-loadInst ktn [name, mem, dsk, vcpus, status, pnode, snode] = do
+loadInst ktn [name, mem, dsk, vcpus, status, pnode, snode, tags] = do
pidx <- lookupNode ktn name pnode
sidx <- (if null snode then return Node.noSecondary
else lookupNode ktn name snode)
@@ -69,7 +69,8 @@ loadInst ktn [name, mem, dsk, vcpus, status, pnode, snode] = do
vvcpus <- tryRead name vcpus
when (sidx == pidx) $ fail $ "Instance " ++ name ++
" has same primary and secondary node - " ++ pnode
- let newinst = Instance.create name vmem vdsk vvcpus status pidx sidx
+ let vtags = sepSplit ',' tags
+ newinst = Instance.create name vmem vdsk vvcpus status vtags pidx sidx
return (name, newinst)
loadInst _ s = fail $ "Invalid/incomplete instance data: '" ++ show s ++ "'"
diff --git a/hscan.hs b/hscan.hs
index 66b6e4fd3561a1e855a6b4750ad27a7e7841f321..8b23793f1de773b6f32edf91695ebf019007b715 100644
--- a/hscan.hs
+++ b/hscan.hs
@@ -81,10 +81,10 @@ serializeInstance csf nl inst =
then ""
else Container.nameOf nl sidx ++ csf)
in
- printf "%s|%d|%d|%d|%s|%s|%s"
+ printf "%s|%d|%d|%d|%s|%s|%s|%s"
iname (Instance.mem inst) (Instance.dsk inst)
(Instance.vcpus inst) (Instance.runSt inst)
- pnode snode
+ pnode snode (intercalate "," (Instance.tags inst))
-- | Generate instance file data from instance objects
serializeInstances :: String -> Node.List -> Instance.List -> String
diff --git a/hspace.hs b/hspace.hs
index 6ede8dec8e847cfb2c667c679297b1dc9ca8ba84..3ee89ee13a12d21ca39fdf1dc2425f7499750fd0 100644
--- a/hspace.hs
+++ b/hspace.hs
@@ -277,7 +277,7 @@ main = do
-- utility functions
let iofspec spx = Instance.create "new" (rspecMem spx) (rspecDsk spx)
- (rspecCpu spx) "ADMIN_down" (-1) (-1)
+ (rspecCpu spx) "ADMIN_down" [] (-1) (-1)
exitifbad val = (case val of
Bad s -> do
hPrintf stderr "Failure: %s\n" s