Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / HTools / Backend / Text.hs @ 4b542ebc

History | View | Annotate | Download (14.8 kB)

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|%s" (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
           (intercalate "," (Node.nTags node))
93
    where grp = Container.find (Node.group node) gl
94

    
95
-- | Generate node file data from node objects.
96
serializeNodes :: Group.List -> Node.List -> String
97
serializeNodes gl = unlines . map (serializeNode gl) . Container.elems
98

    
99
-- | Serialize a single instance.
100
serializeInstance :: Node.List         -- ^ The node list (needed for
101
                                       -- node names)
102
                  -> Instance.Instance -- ^ The instance to be serialised
103
                  -> String
104
serializeInstance nl inst =
105
  let iname = Instance.name inst
106
      pnode = Container.nameOf nl (Instance.pNode inst)
107
      sidx = Instance.sNode inst
108
      snode = (if sidx == Node.noSecondary
109
                 then ""
110
                 else Container.nameOf nl sidx)
111
  in printf "%s|%d|%d|%d|%s|%s|%s|%s|%s|%s|%d"
112
       iname (Instance.mem inst) (Instance.dsk inst)
113
       (Instance.vcpus inst) (instanceStatusToRaw (Instance.runSt inst))
114
       (if Instance.autoBalance inst then "Y" else "N")
115
       pnode snode (diskTemplateToRaw (Instance.diskTemplate inst))
116
       (intercalate "," (Instance.allTags inst)) (Instance.spindleUse inst)
117

    
118
-- | Generate instance file data from instance objects.
119
serializeInstances :: Node.List -> Instance.List -> String
120
serializeInstances nl =
121
  unlines . map (serializeInstance nl) . Container.elems
122

    
123
-- | Separator between ISpecs (in MinMaxISpecs).
124
iSpecsSeparator :: Char
125
iSpecsSeparator = ';'
126

    
127
-- | Generate a spec data from a given ISpec object.
128
serializeISpec :: ISpec -> String
129
serializeISpec ispec =
130
  -- this needs to be kept in sync with the object definition
131
  let ISpec mem_s cpu_c disk_s disk_c nic_c su = ispec
132
      strings = [show mem_s, show cpu_c, show disk_s, show disk_c, show nic_c,
133
                 show su]
134
  in intercalate "," strings
135

    
136
-- | Generate disk template data.
137
serializeDiskTemplates :: [DiskTemplate] -> String
138
serializeDiskTemplates = intercalate "," . map diskTemplateToRaw
139

    
140
-- | Generate min/max instance specs data.
141
serializeMultipleMinMaxISpecs :: [MinMaxISpecs] -> String
142
serializeMultipleMinMaxISpecs minmaxes =
143
  intercalate [iSpecsSeparator] $ foldr serialpair [] minmaxes
144
  where serialpair (MinMaxISpecs minspec maxspec) acc =
145
          serializeISpec minspec : serializeISpec maxspec : acc
146

    
147
-- | Generate policy data from a given policy object.
148
serializeIPolicy :: String -> IPolicy -> String
149
serializeIPolicy owner ipol =
150
  let IPolicy minmax stdspec dts vcpu_ratio spindle_ratio = ipol
151
      strings = [ owner
152
                , serializeISpec stdspec
153
                , serializeMultipleMinMaxISpecs minmax
154
                , serializeDiskTemplates dts
155
                , show vcpu_ratio
156
                , show spindle_ratio
157
                ]
158
  in intercalate "|" strings
159

    
160
-- | Generates the entire ipolicy section from the cluster and group
161
-- objects.
162
serializeAllIPolicies :: IPolicy -> Group.List -> String
163
serializeAllIPolicies cpol gl =
164
  let groups = Container.elems gl
165
      allpolicies = ("", cpol) :
166
                    map (\g -> (Group.name g, Group.iPolicy g)) groups
167
      strings = map (uncurry serializeIPolicy) allpolicies
168
  in unlines strings
169

    
170
-- | Generate complete cluster data from node and instance lists.
171
serializeCluster :: ClusterData -> String
172
serializeCluster (ClusterData gl nl il ctags cpol) =
173
  let gdata = serializeGroups gl
174
      ndata = serializeNodes gl nl
175
      idata = serializeInstances nl il
176
      pdata = serializeAllIPolicies cpol gl
177
  -- note: not using 'unlines' as that adds too many newlines
178
  in intercalate "\n" [gdata, ndata, idata, unlines ctags, pdata]
179

    
180
-- * Parsing functions
181

    
182
-- | Load a group from a field list.
183
loadGroup :: (Monad m) => [String]
184
          -> m (String, Group.Group) -- ^ The result, a tuple of group
185
                                     -- UUID and group object
186
loadGroup [name, gid, apol, tags] = do
187
  xapol <- allocPolicyFromRaw apol
188
  let xtags = commaSplit tags
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, tags] = 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
        let vtags = commaSplit tags
206
        vtm <- tryRead name tm
207
        vnm <- tryRead name nm
208
        vfm <- tryRead name fm
209
        vtd <- tryRead name td
210
        vfd <- tryRead name fd
211
        vtc <- tryRead name tc
212
        vspindles <- tryRead name spindles
213
        return . flip Node.setMaster (fo == "M") . flip Node.setNodeTags vtags $
214
          Node.create name vtm vnm vfm vtd vfd vtc False vspindles gdx
215
  return (name, new_node)
216

    
217
loadNode ktg [name, tm, nm, fm, td, fd, tc, fo, gu] =
218
  loadNode ktg [name, tm, nm, fm, td, fd, tc, fo, gu, "1"]
219

    
220
loadNode ktg [name, tm, nm, fm, td, fd, tc, fo, gu, spindles] =
221
  loadNode ktg [name, tm, nm, fm, td, fd, tc, fo, gu, spindles, ""]
222

    
223
loadNode _ s = fail $ "Invalid/incomplete node data: '" ++ show s ++ "'"
224

    
225
-- | Load an instance from a field list.
226
loadInst :: NameAssoc -- ^ Association list with the current nodes
227
         -> [String]  -- ^ Input data as a list of fields
228
         -> Result (String, Instance.Instance) -- ^ A tuple of
229
                                               -- instance name and
230
                                               -- the instance object
231
loadInst ktn [ name, mem, dsk, vcpus, status, auto_bal, pnode, snode
232
             , dt, tags, su ] = do
233
  pidx <- lookupNode ktn name pnode
234
  sidx <- if null snode
235
            then return Node.noSecondary
236
            else lookupNode ktn name snode
237
  vmem <- tryRead name mem
238
  vdsk <- tryRead name dsk
239
  vvcpus <- tryRead name vcpus
240
  vstatus <- instanceStatusFromRaw status
241
  auto_balance <- case auto_bal of
242
                    "Y" -> return True
243
                    "N" -> return False
244
                    _ -> fail $ "Invalid auto_balance value '" ++ auto_bal ++
245
                         "' for instance " ++ name
246
  disk_template <- annotateResult ("Instance " ++ name)
247
                   (diskTemplateFromRaw dt)
248
  spindle_use <- tryRead name su
249
  when (sidx == pidx) . fail $ "Instance " ++ name ++
250
           " has same primary and secondary node - " ++ pnode
251
  let vtags = commaSplit tags
252
      newinst = Instance.create name vmem vdsk [vdsk] vvcpus vstatus vtags
253
                auto_balance pidx sidx disk_template spindle_use
254
  return (name, newinst)
255

    
256
loadInst ktn [ name, mem, dsk, vcpus, status, auto_bal, pnode, snode
257
             , dt, tags ] = loadInst ktn [ name, mem, dsk, vcpus, status,
258
                                           auto_bal, pnode, snode, dt, tags,
259
                                           "1" ]
260
loadInst _ s = fail $ "Invalid/incomplete instance data: '" ++ show s ++ "'"
261

    
262
-- | Loads a spec from a field list.
263
loadISpec :: String -> [String] -> Result ISpec
264
loadISpec owner [mem_s, cpu_c, dsk_s, dsk_c, nic_c, su] = do
265
  xmem_s <- tryRead (owner ++ "/memsize") mem_s
266
  xcpu_c <- tryRead (owner ++ "/cpucount") cpu_c
267
  xdsk_s <- tryRead (owner ++ "/disksize") dsk_s
268
  xdsk_c <- tryRead (owner ++ "/diskcount") dsk_c
269
  xnic_c <- tryRead (owner ++ "/niccount") nic_c
270
  xsu    <- tryRead (owner ++ "/spindleuse") su
271
  return $ ISpec xmem_s xcpu_c xdsk_s xdsk_c xnic_c xsu
272
loadISpec owner s = fail $ "Invalid ispec data for " ++ owner ++ ": " ++ show s
273

    
274
-- | Load a single min/max ISpec pair
275
loadMinMaxISpecs :: String -> String -> String -> Result MinMaxISpecs
276
loadMinMaxISpecs owner minspec maxspec = do
277
  xminspec <- loadISpec (owner ++ "/minspec") (commaSplit minspec)
278
  xmaxspec <- loadISpec (owner ++ "/maxspec") (commaSplit maxspec)
279
  return $ MinMaxISpecs xminspec xmaxspec
280

    
281
-- | Break a list of ispecs strings into a list of (min/max) ispecs pairs
282
breakISpecsPairs :: String -> [String] -> Result [(String, String)]
283
breakISpecsPairs _ [] =
284
  return []
285
breakISpecsPairs owner (x:y:xs) = do
286
  rest <- breakISpecsPairs owner xs
287
  return $ (x, y) : rest
288
breakISpecsPairs owner _ =
289
  fail $ "Odd number of min/max specs for " ++ owner
290

    
291
-- | Load a list of min/max ispecs pairs
292
loadMultipleMinMaxISpecs :: String -> [String] -> Result [MinMaxISpecs]
293
loadMultipleMinMaxISpecs owner ispecs = do
294
  pairs <- breakISpecsPairs owner ispecs
295
  mapM (uncurry $ loadMinMaxISpecs owner) pairs
296

    
297
-- | Loads an ipolicy from a field list.
298
loadIPolicy :: [String] -> Result (String, IPolicy)
299
loadIPolicy [owner, stdspec, minmaxspecs, dtemplates,
300
             vcpu_ratio, spindle_ratio] = do
301
  xstdspec <- loadISpec (owner ++ "/stdspec") (commaSplit stdspec)
302
  xminmaxspecs <- loadMultipleMinMaxISpecs owner $
303
                  sepSplit iSpecsSeparator minmaxspecs
304
  xdts <- mapM diskTemplateFromRaw $ commaSplit dtemplates
305
  xvcpu_ratio <- tryRead (owner ++ "/vcpu_ratio") vcpu_ratio
306
  xspindle_ratio <- tryRead (owner ++ "/spindle_ratio") spindle_ratio
307
  return (owner,
308
          IPolicy xminmaxspecs xstdspec
309
                xdts xvcpu_ratio xspindle_ratio)
310
loadIPolicy s = fail $ "Invalid ipolicy data: '" ++ show s ++ "'"
311

    
312
loadOnePolicy :: (IPolicy, Group.List) -> String
313
              -> Result (IPolicy, Group.List)
314
loadOnePolicy (cpol, gl) line = do
315
  (owner, ipol) <- loadIPolicy (sepSplit '|' line)
316
  case owner of
317
    "" -> return (ipol, gl) -- this is a cluster policy (no owner)
318
    _ -> do
319
      grp <- Container.findByName gl owner
320
      let grp' = grp { Group.iPolicy = ipol }
321
          gl' = Container.add (Group.idx grp') grp' gl
322
      return (cpol, gl')
323

    
324
-- | Loads all policies from the policy section
325
loadAllIPolicies :: Group.List -> [String] -> Result (IPolicy, Group.List)
326
loadAllIPolicies gl =
327
  foldM loadOnePolicy (defIPolicy, gl)
328

    
329
-- | Convert newline and delimiter-separated text.
330
--
331
-- This function converts a text in tabular format as generated by
332
-- @gnt-instance list@ and @gnt-node list@ to a list of objects using
333
-- a supplied conversion function.
334
loadTabular :: (Monad m, Element a) =>
335
               [String] -- ^ Input data, as a list of lines
336
            -> ([String] -> m (String, a)) -- ^ Conversion function
337
            -> m ( NameAssoc
338
                 , Container.Container a ) -- ^ A tuple of an
339
                                           -- association list (name
340
                                           -- to object) and a set as
341
                                           -- used in
342
                                           -- "Ganeti.HTools.Container"
343

    
344
loadTabular lines_data convert_fn = do
345
  let rows = map (sepSplit '|') lines_data
346
  kerows <- mapM convert_fn rows
347
  return $ assignIndices kerows
348

    
349
-- | Load the cluser data from disk.
350
--
351
-- This is an alias to 'readFile' just for consistency with the other
352
-- modules.
353
readData :: String    -- ^ Path to the text file
354
         -> IO String -- ^ Contents of the file
355
readData = readFile
356

    
357
-- | Builds the cluster data from text input.
358
parseData :: String -- ^ Text data
359
          -> Result ClusterData
360
parseData fdata = do
361
  let flines = lines fdata
362
  (glines, nlines, ilines, ctags, pollines) <-
363
      case sepSplit "" flines of
364
        [a, b, c, d, e] -> Ok (a, b, c, d, e)
365
        [a, b, c, d] -> Ok (a, b, c, d, [])
366
        xs -> Bad $ printf "Invalid format of the input file: %d sections\
367
                           \ instead of 4 or 5" (length xs)
368
  {- group file: name uuid alloc_policy -}
369
  (ktg, gl) <- loadTabular glines loadGroup
370
  {- node file: name t_mem n_mem f_mem t_disk f_disk t_cpu offline grp_uuid
371
                spindles tags -}
372
  (ktn, nl) <- loadTabular nlines (loadNode ktg)
373
  {- instance file: name mem disk vcpus status auto_bal pnode snode
374
                    disk_template tags spindle_use -}
375
  (_, il) <- loadTabular ilines (loadInst ktn)
376
  {- the tags are simply line-based, no processing needed -}
377
  {- process policies -}
378
  (cpol, gl') <- loadAllIPolicies gl pollines
379
  return (ClusterData gl' nl il ctags cpol)
380

    
381
-- | Top level function for data loading.
382
loadData :: String -- ^ Path to the text file
383
         -> IO (Result ClusterData)
384
loadData = fmap parseData . readData