From 17e7af2b139193511bde20b486dbd6f414fe2ab5 Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Wed, 11 Nov 2009 11:01:36 +0100
Subject: [PATCH] Add a tags attribute to instances
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
β¦ and read it in all the loaders. hscan is modified to save it to the
files it generates.
The attribute is not yet used in any place.
---
Ganeti/HTools/IAlloc.hs | 3 ++-
Ganeti/HTools/Instance.hs | 7 +++++--
Ganeti/HTools/Luxi.hs | 8 +++++---
Ganeti/HTools/Rapi.hs | 3 ++-
Ganeti/HTools/Text.hs | 5 +++--
hscan.hs | 4 ++--
hspace.hs | 2 +-
7 files changed, 20 insertions(+), 12 deletions(-)
diff --git a/Ganeti/HTools/IAlloc.hs b/Ganeti/HTools/IAlloc.hs
index ef5d66081..b43939c8e 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 fe64d637c..c3b532432 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 27d23a56c..c2e8bdb53 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 6050f3096..d8595725e 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 69737a8a0..cd82aa812 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 66b6e4fd3..8b23793f1 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 6ede8dec8..3ee89ee13 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
--
GitLab