1 {-| Parsing data from text-files.
3 This module holds the code for loading the cluster state from text
4 files, as produced by @gnt-node@ and @gnt-instance@ @list@ command.
10 Copyright (C) 2009, 2010, 2011, 2012 Google Inc.
12 This program is free software; you can redistribute it and/or modify
13 it under the terms of the GNU General Public License as published by
14 the Free Software Foundation; either version 2 of the License, or
15 (at your option) any later version.
17 This program is distributed in the hope that it will be useful, but
18 WITHOUT ANY WARRANTY; without even the implied warranty of
19 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
20 General Public License for more details.
22 You should have received a copy of the GNU General Public License
23 along with this program; if not, write to the Free Software
24 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
29 module Ganeti.HTools.Text
48 import Text.Printf (printf)
50 import Ganeti.HTools.Utils
51 import Ganeti.HTools.Loader
52 import Ganeti.HTools.Types
53 import qualified Ganeti.HTools.Container as Container
54 import qualified Ganeti.HTools.Group as Group
55 import qualified Ganeti.HTools.Node as Node
56 import qualified Ganeti.HTools.Instance as Instance
60 -- | Simple wrapper over sepSplit
61 commaSplit :: String -> [String]
62 commaSplit = sepSplit ','
64 -- * Serialisation functions
66 -- | Serialize a single group.
67 serializeGroup :: Group.Group -> String
69 printf "%s|%s|%s" (Group.name grp) (Group.uuid grp)
70 (allocPolicyToRaw (Group.allocPolicy grp))
72 -- | Generate group file data from a group list.
73 serializeGroups :: Group.List -> String
74 serializeGroups = unlines . map serializeGroup . Container.elems
76 -- | Serialize a single node.
77 serializeNode :: Group.List -- ^ The list of groups (needed for group uuid)
78 -> Node.Node -- ^ The node to be serialised
80 serializeNode gl node =
81 printf "%s|%.0f|%d|%d|%.0f|%d|%.0f|%c|%s|%d" (Node.name node)
82 (Node.tMem node) (Node.nMem node) (Node.fMem node)
83 (Node.tDsk node) (Node.fDsk node) (Node.tCpu node)
84 (if Node.offline node then 'Y' else 'N')
86 (Node.spindleCount node)
87 where grp = Container.find (Node.group node) gl
89 -- | Generate node file data from node objects.
90 serializeNodes :: Group.List -> Node.List -> String
91 serializeNodes gl = unlines . map (serializeNode gl) . Container.elems
93 -- | Serialize a single instance.
94 serializeInstance :: Node.List -- ^ The node list (needed for
96 -> Instance.Instance -- ^ The instance to be serialised
98 serializeInstance nl inst =
99 let iname = Instance.name inst
100 pnode = Container.nameOf nl (Instance.pNode inst)
101 sidx = Instance.sNode inst
102 snode = (if sidx == Node.noSecondary
104 else Container.nameOf nl sidx)
105 in printf "%s|%d|%d|%d|%s|%s|%s|%s|%s|%s|%d"
106 iname (Instance.mem inst) (Instance.dsk inst)
107 (Instance.vcpus inst) (instanceStatusToRaw (Instance.runSt inst))
108 (if Instance.autoBalance inst then "Y" else "N")
109 pnode snode (diskTemplateToRaw (Instance.diskTemplate inst))
110 (intercalate "," (Instance.tags inst)) (Instance.spindleUse inst)
112 -- | Generate instance file data from instance objects.
113 serializeInstances :: Node.List -> Instance.List -> String
114 serializeInstances nl =
115 unlines . map (serializeInstance nl) . Container.elems
117 -- | Generate a spec data from a given ISpec object.
118 serializeISpec :: ISpec -> String
119 serializeISpec ispec =
120 -- this needs to be kept in sync with the object definition
121 let ISpec mem_s cpu_c disk_s disk_c nic_c su = ispec
122 strings = [show mem_s, show cpu_c, show disk_s, show disk_c, show nic_c,
124 in intercalate "," strings
126 -- | Generate disk template data.
127 serializeDiskTemplates :: [DiskTemplate] -> String
128 serializeDiskTemplates = intercalate "," . map diskTemplateToRaw
130 -- | Generate policy data from a given policy object.
131 serializeIPolicy :: String -> IPolicy -> String
132 serializeIPolicy owner ipol =
133 let IPolicy stdspec minspec maxspec dts vcpu_ratio spindle_ratio = ipol
135 , serializeISpec stdspec
136 , serializeISpec minspec
137 , serializeISpec maxspec
138 , serializeDiskTemplates dts
142 in intercalate "|" strings
144 -- | Generates the entire ipolicy section from the cluster and group
146 serializeAllIPolicies :: IPolicy -> Group.List -> String
147 serializeAllIPolicies cpol gl =
148 let groups = Container.elems gl
149 allpolicies = [("", cpol)] ++
150 map (\g -> (Group.name g, Group.iPolicy g)) groups
151 strings = map (uncurry serializeIPolicy) allpolicies
154 -- | Generate complete cluster data from node and instance lists.
155 serializeCluster :: ClusterData -> String
156 serializeCluster (ClusterData gl nl il ctags cpol) =
157 let gdata = serializeGroups gl
158 ndata = serializeNodes gl nl
159 idata = serializeInstances nl il
160 pdata = serializeAllIPolicies cpol gl
161 -- note: not using 'unlines' as that adds too many newlines
162 in intercalate "\n" [gdata, ndata, idata, unlines ctags, pdata]
164 -- * Parsing functions
166 -- | Load a group from a field list.
167 loadGroup :: (Monad m) => [String]
168 -> m (String, Group.Group) -- ^ The result, a tuple of group
169 -- UUID and group object
170 loadGroup [name, gid, apol] = do
171 xapol <- allocPolicyFromRaw apol
172 return (gid, Group.create name gid xapol defIPolicy)
174 loadGroup s = fail $ "Invalid/incomplete group data: '" ++ show s ++ "'"
176 -- | Load a node from a field list.
177 loadNode :: (Monad m) =>
178 NameAssoc -- ^ Association list with current groups
179 -> [String] -- ^ Input data as a list of fields
180 -> m (String, Node.Node) -- ^ The result, a tuple o node name
182 loadNode ktg [name, tm, nm, fm, td, fd, tc, fo, gu, spindles] = do
183 gdx <- lookupGroup ktg name gu
185 if any (== "?") [tm,nm,fm,td,fd,tc] || fo == "Y" then
186 return $ Node.create name 0 0 0 0 0 0 True 0 gdx
188 vtm <- tryRead name tm
189 vnm <- tryRead name nm
190 vfm <- tryRead name fm
191 vtd <- tryRead name td
192 vfd <- tryRead name fd
193 vtc <- tryRead name tc
194 vspindles <- tryRead name spindles
195 return $ Node.create name vtm vnm vfm vtd vfd vtc False vspindles gdx
196 return (name, new_node)
198 loadNode ktg [name, tm, nm, fm, td, fd, tc, fo, gu] =
199 loadNode ktg [name, tm, nm, fm, td, fd, tc, fo, gu, "1"]
201 loadNode _ s = fail $ "Invalid/incomplete node data: '" ++ show s ++ "'"
203 -- | Load an instance from a field list.
204 loadInst :: NameAssoc -- ^ Association list with the current nodes
205 -> [String] -- ^ Input data as a list of fields
206 -> Result (String, Instance.Instance) -- ^ A tuple of
208 -- the instance object
209 loadInst ktn [ name, mem, dsk, vcpus, status, auto_bal, pnode, snode
210 , dt, tags, su ] = do
211 pidx <- lookupNode ktn name pnode
212 sidx <- if null snode
213 then return Node.noSecondary
214 else lookupNode ktn name snode
215 vmem <- tryRead name mem
216 vdsk <- tryRead name dsk
217 vvcpus <- tryRead name vcpus
218 vstatus <- instanceStatusFromRaw status
219 auto_balance <- case auto_bal of
222 _ -> fail $ "Invalid auto_balance value '" ++ auto_bal ++
223 "' for instance " ++ name
224 disk_template <- annotateResult ("Instance " ++ name)
225 (diskTemplateFromRaw dt)
226 spindle_use <- tryRead name su
227 when (sidx == pidx) $ fail $ "Instance " ++ name ++
228 " has same primary and secondary node - " ++ pnode
229 let vtags = commaSplit tags
230 newinst = Instance.create name vmem vdsk vvcpus vstatus vtags
231 auto_balance pidx sidx disk_template spindle_use
232 return (name, newinst)
234 loadInst ktn [ name, mem, dsk, vcpus, status, auto_bal, pnode, snode
235 , dt, tags ] = loadInst ktn [ name, mem, dsk, vcpus, status,
236 auto_bal, pnode, snode, dt, tags,
238 loadInst _ s = fail $ "Invalid/incomplete instance data: '" ++ show s ++ "'"
240 -- | Loads a spec from a field list.
241 loadISpec :: String -> [String] -> Result ISpec
242 loadISpec owner [mem_s, cpu_c, dsk_s, dsk_c, nic_c, su] = do
243 xmem_s <- tryRead (owner ++ "/memsize") mem_s
244 xcpu_c <- tryRead (owner ++ "/cpucount") cpu_c
245 xdsk_s <- tryRead (owner ++ "/disksize") dsk_s
246 xdsk_c <- tryRead (owner ++ "/diskcount") dsk_c
247 xnic_c <- tryRead (owner ++ "/niccount") nic_c
248 xsu <- tryRead (owner ++ "/spindleuse") su
249 return $ ISpec xmem_s xcpu_c xdsk_s xdsk_c xnic_c xsu
250 loadISpec owner s = fail $ "Invalid ispec data for " ++ owner ++ ": " ++ show s
252 -- | Loads an ipolicy from a field list.
253 loadIPolicy :: [String] -> Result (String, IPolicy)
254 loadIPolicy [owner, stdspec, minspec, maxspec, dtemplates,
255 vcpu_ratio, spindle_ratio] = do
256 xstdspec <- loadISpec (owner ++ "/stdspec") (commaSplit stdspec)
257 xminspec <- loadISpec (owner ++ "/minspec") (commaSplit minspec)
258 xmaxspec <- loadISpec (owner ++ "/maxspec") (commaSplit maxspec)
259 xdts <- mapM diskTemplateFromRaw $ commaSplit dtemplates
260 xvcpu_ratio <- tryRead (owner ++ "/vcpu_ratio") vcpu_ratio
261 xspindle_ratio <- tryRead (owner ++ "/spindle_ratio") spindle_ratio
262 return $ (owner, IPolicy xstdspec xminspec xmaxspec xdts
263 xvcpu_ratio xspindle_ratio)
264 loadIPolicy s = fail $ "Invalid ipolicy data: '" ++ show s ++ "'"
266 loadOnePolicy :: (IPolicy, Group.List) -> String
267 -> Result (IPolicy, Group.List)
268 loadOnePolicy (cpol, gl) line = do
269 (owner, ipol) <- loadIPolicy (sepSplit '|' line)
271 "" -> return (ipol, gl) -- this is a cluster policy (no owner)
273 grp <- Container.findByName gl owner
274 let grp' = grp { Group.iPolicy = ipol }
275 gl' = Container.add (Group.idx grp') grp' gl
278 -- | Loads all policies from the policy section
279 loadAllIPolicies :: Group.List -> [String] -> Result (IPolicy, Group.List)
280 loadAllIPolicies gl =
281 foldM loadOnePolicy (defIPolicy, gl)
283 -- | Convert newline and delimiter-separated text.
285 -- This function converts a text in tabular format as generated by
286 -- @gnt-instance list@ and @gnt-node list@ to a list of objects using
287 -- a supplied conversion function.
288 loadTabular :: (Monad m, Element a) =>
289 [String] -- ^ Input data, as a list of lines
290 -> ([String] -> m (String, a)) -- ^ Conversion function
292 , Container.Container a ) -- ^ A tuple of an
293 -- association list (name
294 -- to object) and a set as
296 -- "Ganeti.HTools.Container"
298 loadTabular lines_data convert_fn = do
299 let rows = map (sepSplit '|') lines_data
300 kerows <- mapM convert_fn rows
301 return $ assignIndices kerows
303 -- | Load the cluser data from disk.
305 -- This is an alias to 'readFile' just for consistency with the other
307 readData :: String -- ^ Path to the text file
308 -> IO String -- ^ Contents of the file
311 -- | Builds the cluster data from text input.
312 parseData :: String -- ^ Text data
313 -> Result ClusterData
315 let flines = lines fdata
316 (glines, nlines, ilines, ctags, pollines) <-
317 case sepSplit "" flines of
318 [a, b, c, d, e] -> Ok (a, b, c, d, e)
319 [a, b, c, d] -> Ok (a, b, c, d, [])
320 xs -> Bad $ printf "Invalid format of the input file: %d sections\
321 \ instead of 4 or 5" (length xs)
322 {- group file: name uuid -}
323 (ktg, gl) <- loadTabular glines loadGroup
324 {- node file: name t_mem n_mem f_mem t_disk f_disk -}
325 (ktn, nl) <- loadTabular nlines (loadNode ktg)
326 {- instance file: name mem disk status pnode snode -}
327 (_, il) <- loadTabular ilines (loadInst ktn)
328 {- the tags are simply line-based, no processing needed -}
329 {- process policies -}
330 (cpol, gl') <- loadAllIPolicies gl pollines
331 return (ClusterData gl' nl il ctags cpol)
333 -- | Top level function for data loading.
334 loadData :: String -- ^ Path to the text file
335 -> IO (Result ClusterData)
336 loadData = fmap parseData . readData