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.

diff --git a/Ganeti/HTools/IAlloc.hs b/Ganeti/HTools/IAlloc.hs
index ef5d660..b43939c 100644 (file)
--- 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 fe64d63..c3b5324 100644 (file)
--- 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 27d23a5..c2e8bdb 100644 (file)
--- 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 6050f30..d859572 100644 (file)
--- 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 69737a8..cd82aa8 100644 (file)
--- 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 66b6e4f..8b23793 100644 (file)
--- 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 6ede8de..3ee89ee 100644 (file)
--- 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