Commit 17e7af2b authored by Iustin Pop's avatar Iustin Pop
Browse files

Add a tags attribute to instances

… 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.
parent 27671a61
......@@ -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
......
......@@ -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.
......
......@@ -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)
......
......@@ -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.
......
......@@ -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 ++ "'"
......
......@@ -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
......
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment