Parse node group networks
[ganeti-github.git] / src / Ganeti / HTools / Backend / Text.hs
1 {-| Parsing data from text-files.
2
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.
5
6 -}
7
8 {-
9
10 Copyright (C) 2009, 2010, 2011, 2012, 2013 Google Inc.
11
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.
16
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.
21
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
25 02110-1301, USA.
26
27 -}
28
29 module Ganeti.HTools.Backend.Text
30 ( loadData
31 , parseData
32 , loadInst
33 , loadNode
34 , loadISpec
35 , loadMultipleMinMaxISpecs
36 , loadIPolicy
37 , serializeInstances
38 , serializeNode
39 , serializeNodes
40 , serializeGroup
41 , serializeISpec
42 , serializeMultipleMinMaxISpecs
43 , serializeIPolicy
44 , serializeCluster
45 ) where
46
47 import Control.Monad
48 import Data.List
49
50 import Text.Printf (printf)
51
52 import Ganeti.BasicTypes
53 import Ganeti.Utils
54 import Ganeti.HTools.Loader
55 import Ganeti.HTools.Types
56 import qualified Ganeti.HTools.Container as Container
57 import qualified Ganeti.HTools.Group as Group
58 import qualified Ganeti.HTools.Node as Node
59 import qualified Ganeti.HTools.Instance as Instance
60
61 -- * Helper functions
62
63 -- | Simple wrapper over sepSplit
64 commaSplit :: String -> [String]
65 commaSplit = sepSplit ','
66
67 -- * Serialisation functions
68
69 -- | Serialize a single group.
70 serializeGroup :: Group.Group -> String
71 serializeGroup grp =
72 printf "%s|%s|%s|%s" (Group.name grp) (Group.uuid grp)
73 (allocPolicyToRaw (Group.allocPolicy grp))
74 (intercalate "," (Group.allTags grp))
75
76 -- | Generate group file data from a group list.
77 serializeGroups :: Group.List -> String
78 serializeGroups = unlines . map serializeGroup . Container.elems
79
80 -- | Serialize a single node.
81 serializeNode :: Group.List -- ^ The list of groups (needed for group uuid)
82 -> Node.Node -- ^ The node to be serialised
83 -> String
84 serializeNode gl node =
85 printf "%s|%.0f|%d|%d|%.0f|%d|%.0f|%c|%s|%d" (Node.name node)
86 (Node.tMem node) (Node.nMem node) (Node.fMem node)
87 (Node.tDsk node) (Node.fDsk node) (Node.tCpu node)
88 (if Node.offline node then 'Y' else
89 if Node.isMaster node then 'M' else 'N')
90 (Group.uuid grp)
91 (Node.spindleCount node)
92 where grp = Container.find (Node.group node) gl
93
94 -- | Generate node file data from node objects.
95 serializeNodes :: Group.List -> Node.List -> String
96 serializeNodes gl = unlines . map (serializeNode gl) . Container.elems
97
98 -- | Serialize a single instance.
99 serializeInstance :: Node.List -- ^ The node list (needed for
100 -- node names)
101 -> Instance.Instance -- ^ The instance to be serialised
102 -> String
103 serializeInstance nl inst =
104 let iname = Instance.name inst
105 pnode = Container.nameOf nl (Instance.pNode inst)
106 sidx = Instance.sNode inst
107 snode = (if sidx == Node.noSecondary
108 then ""
109 else Container.nameOf nl sidx)
110 in printf "%s|%d|%d|%d|%s|%s|%s|%s|%s|%s|%d"
111 iname (Instance.mem inst) (Instance.dsk inst)
112 (Instance.vcpus inst) (instanceStatusToRaw (Instance.runSt inst))
113 (if Instance.autoBalance inst then "Y" else "N")
114 pnode snode (diskTemplateToRaw (Instance.diskTemplate inst))
115 (intercalate "," (Instance.allTags inst)) (Instance.spindleUse inst)
116
117 -- | Generate instance file data from instance objects.
118 serializeInstances :: Node.List -> Instance.List -> String
119 serializeInstances nl =
120 unlines . map (serializeInstance nl) . Container.elems
121
122 -- | Separator between ISpecs (in MinMaxISpecs).
123 iSpecsSeparator :: Char
124 iSpecsSeparator = ';'
125
126 -- | Generate a spec data from a given ISpec object.
127 serializeISpec :: ISpec -> String
128 serializeISpec ispec =
129 -- this needs to be kept in sync with the object definition
130 let ISpec mem_s cpu_c disk_s disk_c nic_c su = ispec
131 strings = [show mem_s, show cpu_c, show disk_s, show disk_c, show nic_c,
132 show su]
133 in intercalate "," strings
134
135 -- | Generate disk template data.
136 serializeDiskTemplates :: [DiskTemplate] -> String
137 serializeDiskTemplates = intercalate "," . map diskTemplateToRaw
138
139 -- | Generate min/max instance specs data.
140 serializeMultipleMinMaxISpecs :: [MinMaxISpecs] -> String
141 serializeMultipleMinMaxISpecs minmaxes =
142 intercalate [iSpecsSeparator] $ foldr serialpair [] minmaxes
143 where serialpair (MinMaxISpecs minspec maxspec) acc =
144 serializeISpec minspec : serializeISpec maxspec : acc
145
146 -- | Generate policy data from a given policy object.
147 serializeIPolicy :: String -> IPolicy -> String
148 serializeIPolicy owner ipol =
149 let IPolicy minmax stdspec dts vcpu_ratio spindle_ratio = ipol
150 strings = [ owner
151 , serializeISpec stdspec
152 , serializeMultipleMinMaxISpecs minmax
153 , serializeDiskTemplates dts
154 , show vcpu_ratio
155 , show spindle_ratio
156 ]
157 in intercalate "|" strings
158
159 -- | Generates the entire ipolicy section from the cluster and group
160 -- objects.
161 serializeAllIPolicies :: IPolicy -> Group.List -> String
162 serializeAllIPolicies cpol gl =
163 let groups = Container.elems gl
164 allpolicies = ("", cpol) :
165 map (\g -> (Group.name g, Group.iPolicy g)) groups
166 strings = map (uncurry serializeIPolicy) allpolicies
167 in unlines strings
168
169 -- | Generate complete cluster data from node and instance lists.
170 serializeCluster :: ClusterData -> String
171 serializeCluster (ClusterData gl nl il ctags cpol) =
172 let gdata = serializeGroups gl
173 ndata = serializeNodes gl nl
174 idata = serializeInstances nl il
175 pdata = serializeAllIPolicies cpol gl
176 -- note: not using 'unlines' as that adds too many newlines
177 in intercalate "\n" [gdata, ndata, idata, unlines ctags, pdata]
178
179 -- * Parsing functions
180
181 -- | Load a group from a field list.
182 loadGroup :: (Monad m) => [String]
183 -> m (String, Group.Group) -- ^ The result, a tuple of group
184 -- UUID and group object
185 loadGroup [name, gid, apol, tags] = do
186 xapol <- allocPolicyFromRaw apol
187 let xtags = commaSplit tags
188 -- TODO: parse networks to which this group is connected
189 return (gid, Group.create name gid xapol [] defIPolicy xtags)
190
191 loadGroup s = fail $ "Invalid/incomplete group data: '" ++ show s ++ "'"
192
193 -- | Load a node from a field list.
194 loadNode :: (Monad m) =>
195 NameAssoc -- ^ Association list with current groups
196 -> [String] -- ^ Input data as a list of fields
197 -> m (String, Node.Node) -- ^ The result, a tuple o node name
198 -- and node object
199 loadNode ktg [name, tm, nm, fm, td, fd, tc, fo, gu, spindles] = do
200 gdx <- lookupGroup ktg name gu
201 new_node <-
202 if "?" `elem` [tm,nm,fm,td,fd,tc] || fo == "Y" then
203 return $ Node.create name 0 0 0 0 0 0 True 0 gdx
204 else do
205 vtm <- tryRead name tm
206 vnm <- tryRead name nm
207 vfm <- tryRead name fm
208 vtd <- tryRead name td
209 vfd <- tryRead name fd
210 vtc <- tryRead name tc
211 vspindles <- tryRead name spindles
212 return . flip Node.setMaster (fo == "M") $
213 Node.create name vtm vnm vfm vtd vfd vtc False vspindles gdx
214 return (name, new_node)
215
216 loadNode ktg [name, tm, nm, fm, td, fd, tc, fo, gu] =
217 loadNode ktg [name, tm, nm, fm, td, fd, tc, fo, gu, "1"]
218
219 loadNode _ s = fail $ "Invalid/incomplete node data: '" ++ show s ++ "'"
220
221 -- | Load an instance from a field list.
222 loadInst :: NameAssoc -- ^ Association list with the current nodes
223 -> [String] -- ^ Input data as a list of fields
224 -> Result (String, Instance.Instance) -- ^ A tuple of
225 -- instance name and
226 -- the instance object
227 loadInst ktn [ name, mem, dsk, vcpus, status, auto_bal, pnode, snode
228 , dt, tags, su ] = do
229 pidx <- lookupNode ktn name pnode
230 sidx <- if null snode
231 then return Node.noSecondary
232 else lookupNode ktn name snode
233 vmem <- tryRead name mem
234 vdsk <- tryRead name dsk
235 vvcpus <- tryRead name vcpus
236 vstatus <- instanceStatusFromRaw status
237 auto_balance <- case auto_bal of
238 "Y" -> return True
239 "N" -> return False
240 _ -> fail $ "Invalid auto_balance value '" ++ auto_bal ++
241 "' for instance " ++ name
242 disk_template <- annotateResult ("Instance " ++ name)
243 (diskTemplateFromRaw dt)
244 spindle_use <- tryRead name su
245 when (sidx == pidx) . fail $ "Instance " ++ name ++
246 " has same primary and secondary node - " ++ pnode
247 let vtags = commaSplit tags
248 newinst = Instance.create name vmem vdsk [vdsk] vvcpus vstatus vtags
249 auto_balance pidx sidx disk_template spindle_use
250 return (name, newinst)
251
252 loadInst ktn [ name, mem, dsk, vcpus, status, auto_bal, pnode, snode
253 , dt, tags ] = loadInst ktn [ name, mem, dsk, vcpus, status,
254 auto_bal, pnode, snode, dt, tags,
255 "1" ]
256 loadInst _ s = fail $ "Invalid/incomplete instance data: '" ++ show s ++ "'"
257
258 -- | Loads a spec from a field list.
259 loadISpec :: String -> [String] -> Result ISpec
260 loadISpec owner [mem_s, cpu_c, dsk_s, dsk_c, nic_c, su] = do
261 xmem_s <- tryRead (owner ++ "/memsize") mem_s
262 xcpu_c <- tryRead (owner ++ "/cpucount") cpu_c
263 xdsk_s <- tryRead (owner ++ "/disksize") dsk_s
264 xdsk_c <- tryRead (owner ++ "/diskcount") dsk_c
265 xnic_c <- tryRead (owner ++ "/niccount") nic_c
266 xsu <- tryRead (owner ++ "/spindleuse") su
267 return $ ISpec xmem_s xcpu_c xdsk_s xdsk_c xnic_c xsu
268 loadISpec owner s = fail $ "Invalid ispec data for " ++ owner ++ ": " ++ show s
269
270 -- | Load a single min/max ISpec pair
271 loadMinMaxISpecs :: String -> String -> String -> Result MinMaxISpecs
272 loadMinMaxISpecs owner minspec maxspec = do
273 xminspec <- loadISpec (owner ++ "/minspec") (commaSplit minspec)
274 xmaxspec <- loadISpec (owner ++ "/maxspec") (commaSplit maxspec)
275 return $ MinMaxISpecs xminspec xmaxspec
276
277 -- | Break a list of ispecs strings into a list of (min/max) ispecs pairs
278 breakISpecsPairs :: String -> [String] -> Result [(String, String)]
279 breakISpecsPairs _ [] =
280 return []
281 breakISpecsPairs owner (x:y:xs) = do
282 rest <- breakISpecsPairs owner xs
283 return $ (x, y) : rest
284 breakISpecsPairs owner _ =
285 fail $ "Odd number of min/max specs for " ++ owner
286
287 -- | Load a list of min/max ispecs pairs
288 loadMultipleMinMaxISpecs :: String -> [String] -> Result [MinMaxISpecs]
289 loadMultipleMinMaxISpecs owner ispecs = do
290 pairs <- breakISpecsPairs owner ispecs
291 mapM (uncurry $ loadMinMaxISpecs owner) pairs
292
293 -- | Loads an ipolicy from a field list.
294 loadIPolicy :: [String] -> Result (String, IPolicy)
295 loadIPolicy [owner, stdspec, minmaxspecs, dtemplates,
296 vcpu_ratio, spindle_ratio] = do
297 xstdspec <- loadISpec (owner ++ "/stdspec") (commaSplit stdspec)
298 xminmaxspecs <- loadMultipleMinMaxISpecs owner $
299 sepSplit iSpecsSeparator minmaxspecs
300 xdts <- mapM diskTemplateFromRaw $ commaSplit dtemplates
301 xvcpu_ratio <- tryRead (owner ++ "/vcpu_ratio") vcpu_ratio
302 xspindle_ratio <- tryRead (owner ++ "/spindle_ratio") spindle_ratio
303 return (owner,
304 IPolicy xminmaxspecs xstdspec
305 xdts xvcpu_ratio xspindle_ratio)
306 loadIPolicy s = fail $ "Invalid ipolicy data: '" ++ show s ++ "'"
307
308 loadOnePolicy :: (IPolicy, Group.List) -> String
309 -> Result (IPolicy, Group.List)
310 loadOnePolicy (cpol, gl) line = do
311 (owner, ipol) <- loadIPolicy (sepSplit '|' line)
312 case owner of
313 "" -> return (ipol, gl) -- this is a cluster policy (no owner)
314 _ -> do
315 grp <- Container.findByName gl owner
316 let grp' = grp { Group.iPolicy = ipol }
317 gl' = Container.add (Group.idx grp') grp' gl
318 return (cpol, gl')
319
320 -- | Loads all policies from the policy section
321 loadAllIPolicies :: Group.List -> [String] -> Result (IPolicy, Group.List)
322 loadAllIPolicies gl =
323 foldM loadOnePolicy (defIPolicy, gl)
324
325 -- | Convert newline and delimiter-separated text.
326 --
327 -- This function converts a text in tabular format as generated by
328 -- @gnt-instance list@ and @gnt-node list@ to a list of objects using
329 -- a supplied conversion function.
330 loadTabular :: (Monad m, Element a) =>
331 [String] -- ^ Input data, as a list of lines
332 -> ([String] -> m (String, a)) -- ^ Conversion function
333 -> m ( NameAssoc
334 , Container.Container a ) -- ^ A tuple of an
335 -- association list (name
336 -- to object) and a set as
337 -- used in
338 -- "Ganeti.HTools.Container"
339
340 loadTabular lines_data convert_fn = do
341 let rows = map (sepSplit '|') lines_data
342 kerows <- mapM convert_fn rows
343 return $ assignIndices kerows
344
345 -- | Load the cluser data from disk.
346 --
347 -- This is an alias to 'readFile' just for consistency with the other
348 -- modules.
349 readData :: String -- ^ Path to the text file
350 -> IO String -- ^ Contents of the file
351 readData = readFile
352
353 -- | Builds the cluster data from text input.
354 parseData :: String -- ^ Text data
355 -> Result ClusterData
356 parseData fdata = do
357 let flines = lines fdata
358 (glines, nlines, ilines, ctags, pollines) <-
359 case sepSplit "" flines of
360 [a, b, c, d, e] -> Ok (a, b, c, d, e)
361 [a, b, c, d] -> Ok (a, b, c, d, [])
362 xs -> Bad $ printf "Invalid format of the input file: %d sections\
363 \ instead of 4 or 5" (length xs)
364 {- group file: name uuid alloc_policy -}
365 (ktg, gl) <- loadTabular glines loadGroup
366 {- node file: name t_mem n_mem f_mem t_disk f_disk t_cpu offline grp_uuid
367 spindles -}
368 (ktn, nl) <- loadTabular nlines (loadNode ktg)
369 {- instance file: name mem disk vcpus status auto_bal pnode snode
370 disk_template tags spindle_use -}
371 (_, il) <- loadTabular ilines (loadInst ktn)
372 {- the tags are simply line-based, no processing needed -}
373 {- process policies -}
374 (cpol, gl') <- loadAllIPolicies gl pollines
375 return (ClusterData gl' nl il ctags cpol)
376
377 -- | Top level function for data loading.
378 loadData :: String -- ^ Path to the text file
379 -> IO (Result ClusterData)
380 loadData = fmap parseData . readData