Split out Objects.hs from QC.hs
[ganeti-local] / htools / Ganeti / HTools / Text.hs
index ab3d078..d0f5e24 100644 (file)
@@ -7,7 +7,7 @@ files, as produced by @gnt-node@ and @gnt-instance@ @list@ command.
 
 {-
 
-Copyright (C) 2009, 2010, 2011 Google Inc.
+Copyright (C) 2009, 2010, 2011, 2012 Google Inc.
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -31,9 +31,14 @@ module Ganeti.HTools.Text
   , parseData
   , loadInst
   , loadNode
+  , loadISpec
+  , loadIPolicy
   , serializeInstances
   , serializeNode
   , serializeNodes
+  , serializeGroup
+  , serializeISpec
+  , serializeIPolicy
   , serializeCluster
   ) where
 
@@ -50,6 +55,12 @@ import qualified Ganeti.HTools.Group as Group
 import qualified Ganeti.HTools.Node as Node
 import qualified Ganeti.HTools.Instance as Instance
 
+-- * Helper functions
+
+-- | Simple wrapper over sepSplit
+commaSplit :: String -> [String]
+commaSplit = sepSplit ','
+
 -- * Serialisation functions
 
 -- | Serialize a single group.
@@ -67,11 +78,12 @@ serializeNode :: Group.List -- ^ The list of groups (needed for group uuid)
               -> Node.Node  -- ^ The node to be serialised
               -> String
 serializeNode gl node =
-  printf "%s|%.0f|%d|%d|%.0f|%d|%.0f|%c|%s" (Node.name node)
+  printf "%s|%.0f|%d|%d|%.0f|%d|%.0f|%c|%s|%d" (Node.name node)
            (Node.tMem node) (Node.nMem node) (Node.fMem node)
            (Node.tDsk node) (Node.fDsk node) (Node.tCpu node)
            (if Node.offline node then 'Y' else 'N')
            (Group.uuid grp)
+           (Node.spindleCount node)
     where grp = Container.find (Node.group node) gl
 
 -- | Generate node file data from node objects.
@@ -90,26 +102,64 @@ serializeInstance nl inst =
       snode = (if sidx == Node.noSecondary
                  then ""
                  else Container.nameOf nl sidx)
-  in printf "%s|%d|%d|%d|%s|%s|%s|%s|%s|%s"
+  in printf "%s|%d|%d|%d|%s|%s|%s|%s|%s|%s|%d"
        iname (Instance.mem inst) (Instance.dsk inst)
        (Instance.vcpus inst) (instanceStatusToRaw (Instance.runSt inst))
        (if Instance.autoBalance inst then "Y" else "N")
        pnode snode (diskTemplateToRaw (Instance.diskTemplate inst))
-       (intercalate "," (Instance.tags inst))
+       (intercalate "," (Instance.tags inst)) (Instance.spindleUse inst)
 
 -- | Generate instance file data from instance objects.
 serializeInstances :: Node.List -> Instance.List -> String
 serializeInstances nl =
   unlines . map (serializeInstance nl) . Container.elems
 
+-- | Generate a spec data from a given ISpec object.
+serializeISpec :: ISpec -> String
+serializeISpec ispec =
+  -- this needs to be kept in sync with the object definition
+  let ISpec mem_s cpu_c disk_s disk_c nic_c su = ispec
+      strings = [show mem_s, show cpu_c, show disk_s, show disk_c, show nic_c,
+                 show su]
+  in intercalate "," strings
+
+-- | Generate disk template data.
+serializeDiskTemplates :: [DiskTemplate] -> String
+serializeDiskTemplates = intercalate "," . map diskTemplateToRaw
+
+-- | Generate policy data from a given policy object.
+serializeIPolicy :: String -> IPolicy -> String
+serializeIPolicy owner ipol =
+  let IPolicy stdspec minspec maxspec dts vcpu_ratio spindle_ratio = ipol
+      strings = [ owner
+                , serializeISpec stdspec
+                , serializeISpec minspec
+                , serializeISpec maxspec
+                , serializeDiskTemplates dts
+                , show vcpu_ratio
+                , show spindle_ratio
+                ]
+  in intercalate "|" strings
+
+-- | Generates the entire ipolicy section from the cluster and group
+-- objects.
+serializeAllIPolicies :: IPolicy -> Group.List -> String
+serializeAllIPolicies cpol gl =
+  let groups = Container.elems gl
+      allpolicies = [("", cpol)] ++
+                    map (\g -> (Group.name g, Group.iPolicy g)) groups
+      strings = map (uncurry serializeIPolicy) allpolicies
+  in unlines strings
+
 -- | Generate complete cluster data from node and instance lists.
 serializeCluster :: ClusterData -> String
-serializeCluster (ClusterData gl nl il ctags) =
+serializeCluster (ClusterData gl nl il ctags cpol) =
   let gdata = serializeGroups gl
       ndata = serializeNodes gl nl
       idata = serializeInstances nl il
+      pdata = serializeAllIPolicies cpol gl
   -- note: not using 'unlines' as that adds too many newlines
-  in intercalate "\n" [gdata, ndata, idata, unlines ctags]
+  in intercalate "\n" [gdata, ndata, idata, unlines ctags, pdata]
 
 -- * Parsing functions
 
@@ -119,7 +169,7 @@ loadGroup :: (Monad m) => [String]
                                      -- UUID and group object
 loadGroup [name, gid, apol] = do
   xapol <- allocPolicyFromRaw apol
-  return (gid, Group.create name gid xapol)
+  return (gid, Group.create name gid xapol defIPolicy)
 
 loadGroup s = fail $ "Invalid/incomplete group data: '" ++ show s ++ "'"
 
@@ -129,11 +179,11 @@ loadNode :: (Monad m) =>
          -> [String]              -- ^ Input data as a list of fields
          -> m (String, Node.Node) -- ^ The result, a tuple o node name
                                   -- and node object
-loadNode ktg [name, tm, nm, fm, td, fd, tc, fo, gu] = do
+loadNode ktg [name, tm, nm, fm, td, fd, tc, fo, gu, spindles] = do
   gdx <- lookupGroup ktg name gu
   new_node <-
-      if any (== "?") [tm,nm,fm,td,fd,tc] || fo == "Y" then
-          return $ Node.create name 0 0 0 0 0 0 True gdx
+      if "?" `elem` [tm,nm,fm,td,fd,tc] || fo == "Y" then
+          return $ Node.create name 0 0 0 0 0 0 True 0 gdx
       else do
         vtm <- tryRead name tm
         vnm <- tryRead name nm
@@ -141,8 +191,13 @@ loadNode ktg [name, tm, nm, fm, td, fd, tc, fo, gu] = do
         vtd <- tryRead name td
         vfd <- tryRead name fd
         vtc <- tryRead name tc
-        return $ Node.create name vtm vnm vfm vtd vfd vtc False gdx
+        vspindles <- tryRead name spindles
+        return $ Node.create name vtm vnm vfm vtd vfd vtc False vspindles gdx
   return (name, new_node)
+
+loadNode ktg [name, tm, nm, fm, td, fd, tc, fo, gu] =
+  loadNode ktg [name, tm, nm, fm, td, fd, tc, fo, gu, "1"]
+
 loadNode _ s = fail $ "Invalid/incomplete node data: '" ++ show s ++ "'"
 
 -- | Load an instance from a field list.
@@ -152,7 +207,7 @@ loadInst :: NameAssoc -- ^ Association list with the current nodes
                                                -- instance name and
                                                -- the instance object
 loadInst ktn [ name, mem, dsk, vcpus, status, auto_bal, pnode, snode
-             , dt, tags ] = do
+             , dt, tags, su ] = do
   pidx <- lookupNode ktn name pnode
   sidx <- if null snode
             then return Node.noSecondary
@@ -168,14 +223,63 @@ loadInst ktn [ name, mem, dsk, vcpus, status, auto_bal, pnode, snode
                          "' for instance " ++ name
   disk_template <- annotateResult ("Instance " ++ name)
                    (diskTemplateFromRaw dt)
-  when (sidx == pidx) $ fail $ "Instance " ++ name ++
+  spindle_use <- tryRead name su
+  when (sidx == pidx) . fail $ "Instance " ++ name ++
            " has same primary and secondary node - " ++ pnode
-  let vtags = sepSplit ',' tags
+  let vtags = commaSplit tags
       newinst = Instance.create name vmem vdsk vvcpus vstatus vtags
-                auto_balance pidx sidx disk_template
+                auto_balance pidx sidx disk_template spindle_use
   return (name, newinst)
+
+loadInst ktn [ name, mem, dsk, vcpus, status, auto_bal, pnode, snode
+             , dt, tags ] = loadInst ktn [ name, mem, dsk, vcpus, status,
+                                           auto_bal, pnode, snode, dt, tags,
+                                           "1" ]
 loadInst _ s = fail $ "Invalid/incomplete instance data: '" ++ show s ++ "'"
 
+-- | Loads a spec from a field list.
+loadISpec :: String -> [String] -> Result ISpec
+loadISpec owner [mem_s, cpu_c, dsk_s, dsk_c, nic_c, su] = do
+  xmem_s <- tryRead (owner ++ "/memsize") mem_s
+  xcpu_c <- tryRead (owner ++ "/cpucount") cpu_c
+  xdsk_s <- tryRead (owner ++ "/disksize") dsk_s
+  xdsk_c <- tryRead (owner ++ "/diskcount") dsk_c
+  xnic_c <- tryRead (owner ++ "/niccount") nic_c
+  xsu    <- tryRead (owner ++ "/spindleuse") su
+  return $ ISpec xmem_s xcpu_c xdsk_s xdsk_c xnic_c xsu
+loadISpec owner s = fail $ "Invalid ispec data for " ++ owner ++ ": " ++ show s
+
+-- | Loads an ipolicy from a field list.
+loadIPolicy :: [String] -> Result (String, IPolicy)
+loadIPolicy [owner, stdspec, minspec, maxspec, dtemplates,
+             vcpu_ratio, spindle_ratio] = do
+  xstdspec <- loadISpec (owner ++ "/stdspec") (commaSplit stdspec)
+  xminspec <- loadISpec (owner ++ "/minspec") (commaSplit minspec)
+  xmaxspec <- loadISpec (owner ++ "/maxspec") (commaSplit maxspec)
+  xdts <- mapM diskTemplateFromRaw $ commaSplit dtemplates
+  xvcpu_ratio <- tryRead (owner ++ "/vcpu_ratio") vcpu_ratio
+  xspindle_ratio <- tryRead (owner ++ "/spindle_ratio") spindle_ratio
+  return $ (owner, IPolicy xstdspec xminspec xmaxspec xdts
+            xvcpu_ratio xspindle_ratio)
+loadIPolicy s = fail $ "Invalid ipolicy data: '" ++ show s ++ "'"
+
+loadOnePolicy :: (IPolicy, Group.List) -> String
+              -> Result (IPolicy, Group.List)
+loadOnePolicy (cpol, gl) line = do
+  (owner, ipol) <- loadIPolicy (sepSplit '|' line)
+  case owner of
+    "" -> return (ipol, gl) -- this is a cluster policy (no owner)
+    _ -> do
+      grp <- Container.findByName gl owner
+      let grp' = grp { Group.iPolicy = ipol }
+          gl' = Container.add (Group.idx grp') grp' gl
+      return (cpol, gl')
+
+-- | Loads all policies from the policy section
+loadAllIPolicies :: Group.List -> [String] -> Result (IPolicy, Group.List)
+loadAllIPolicies gl =
+  foldM loadOnePolicy (defIPolicy, gl)
+
 -- | Convert newline and delimiter-separated text.
 --
 -- This function converts a text in tabular format as generated by
@@ -209,11 +313,12 @@ parseData :: String -- ^ Text data
           -> Result ClusterData
 parseData fdata = do
   let flines = lines fdata
-  (glines, nlines, ilines, ctags) <-
+  (glines, nlines, ilines, ctags, pollines) <-
       case sepSplit "" flines of
-        [a, b, c, d] -> Ok (a, b, c, d)
+        [a, b, c, d, e] -> Ok (a, b, c, d, e)
+        [a, b, c, d] -> Ok (a, b, c, d, [])
         xs -> Bad $ printf "Invalid format of the input file: %d sections\
-                           \ instead of 4" (length xs)
+                           \ instead of 4 or 5" (length xs)
   {- group file: name uuid -}
   (ktg, gl) <- loadTabular glines loadGroup
   {- node file: name t_mem n_mem f_mem t_disk f_disk -}
@@ -221,7 +326,9 @@ parseData fdata = do
   {- instance file: name mem disk status pnode snode -}
   (_, il) <- loadTabular ilines (loadInst ktn)
   {- the tags are simply line-based, no processing needed -}
-  return (ClusterData gl nl il ctags)
+  {- process policies -}
+  (cpol, gl') <- loadAllIPolicies gl pollines
+  return (ClusterData gl' nl il ctags cpol)
 
 -- | Top level function for data loading.
 loadData :: String -- ^ Path to the text file