{-
-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
-}
module Ganeti.HTools.Text
- (
- loadData
- , parseData
- , loadInst
- , loadNode
- , serializeInstances
- , serializeNode
- , serializeNodes
- , serializeCluster
- ) where
+ ( loadData
+ , parseData
+ , loadInst
+ , loadNode
+ , loadISpec
+ , loadIPolicy
+ , serializeInstances
+ , serializeNode
+ , serializeNodes
+ , serializeGroup
+ , serializeISpec
+ , serializeIPolicy
+ , serializeCluster
+ ) where
import Control.Monad
import Data.List
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.
serializeGroup :: Group.Group -> String
serializeGroup grp =
- printf "%s|%s|%s" (Group.name grp) (Group.uuid grp)
- (apolToString (Group.allocPolicy grp))
+ printf "%s|%s|%s" (Group.name grp) (Group.uuid grp)
+ (allocPolicyToRaw (Group.allocPolicy grp))
-- | Generate group file data from a group list.
serializeGroups :: Group.List -> String
-> Node.Node -- ^ The node to be serialised
-> String
serializeNode gl node =
- printf "%s|%.0f|%d|%d|%.0f|%d|%.0f|%c|%s" (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)
+ 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.
-> Instance.Instance -- ^ The instance to be serialised
-> String
serializeInstance nl inst =
- let
- iname = Instance.name inst
- pnode = Container.nameOf nl (Instance.pNode inst)
- sidx = Instance.sNode inst
- snode = (if sidx == Node.noSecondary
- then ""
- else Container.nameOf nl sidx)
- in
- printf "%s|%d|%d|%d|%s|%s|%s|%s|%s|%s"
- iname (Instance.mem inst) (Instance.dsk inst)
- (Instance.vcpus inst) (Instance.runSt inst)
- (if Instance.autoBalance inst then "Y" else "N")
- pnode snode (dtToString (Instance.diskTemplate inst))
- (intercalate "," (Instance.tags inst))
+ let iname = Instance.name inst
+ pnode = Container.nameOf nl (Instance.pNode inst)
+ sidx = Instance.sNode inst
+ snode = (if sidx == Node.noSecondary
+ then ""
+ else Container.nameOf nl sidx)
+ 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)) (Instance.spindleUse inst)
-- | Generate instance file data from instance objects.
serializeInstances :: Node.List -> Instance.List -> String
serializeInstances nl =
- unlines . map (serializeInstance nl) . Container.elems
+ 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
-> m (String, Group.Group) -- ^ The result, a tuple of group
-- UUID and group object
loadGroup [name, gid, apol] = do
- xapol <- apolFromString apol
- return (gid, Group.create name gid xapol)
+ xapol <- allocPolicyFromRaw apol
+ return (gid, Group.create name gid xapol defIPolicy)
loadGroup s = fail $ "Invalid/incomplete group data: '" ++ show s ++ "'"
-> [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
+ return $ Node.create name 0 0 0 0 0 0 True 0 gdx
else do
vtm <- tryRead name tm
vnm <- tryRead name nm
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.
-- 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
- else lookupNode ktn name snode)
+ sidx <- if null snode
+ then return Node.noSecondary
+ else lookupNode ktn name snode
vmem <- tryRead name mem
vdsk <- tryRead name dsk
vvcpus <- tryRead name vcpus
+ vstatus <- instanceStatusFromRaw status
auto_balance <- case auto_bal of
"Y" -> return True
"N" -> return False
_ -> fail $ "Invalid auto_balance value '" ++ auto_bal ++
"' for instance " ++ name
- disk_template <- annotateResult ("Instance " ++ name) (dtFromString dt)
+ disk_template <- annotateResult ("Instance " ++ name)
+ (diskTemplateFromRaw dt)
+ spindle_use <- tryRead name su
when (sidx == pidx) $ fail $ "Instance " ++ name ++
" has same primary and secondary node - " ++ pnode
- let vtags = sepSplit ',' tags
- newinst = Instance.create name vmem vdsk vvcpus status vtags
- auto_balance pidx sidx disk_template
+ let vtags = commaSplit tags
+ newinst = Instance.create name vmem vdsk vvcpus vstatus vtags
+ 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
-> 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 -}
{- 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
projects / ganeti-local / blobdiff