Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / HTools / Backend / Text.hs @ c09359ee

History | View | Annotate | Download (15 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
  , serializeInstance
38
  , serializeInstances
39
  , serializeNode
40
  , serializeNodes
41
  , serializeGroup
42
  , serializeISpec
43
  , serializeMultipleMinMaxISpecs
44
  , serializeIPolicy
45
  , serializeCluster
46
  ) where
47

    
48
import Control.Monad
49
import Data.List
50

    
51
import Text.Printf (printf)
52

    
53
import Ganeti.BasicTypes
54
import Ganeti.Utils
55
import Ganeti.HTools.Loader
56
import Ganeti.HTools.Types
57
import qualified Ganeti.HTools.Container as Container
58
import qualified Ganeti.HTools.Group as Group
59
import qualified Ganeti.HTools.Node as Node
60
import qualified Ganeti.HTools.Instance as Instance
61

    
62
-- * Helper functions
63

    
64
-- | Simple wrapper over sepSplit
65
commaSplit :: String -> [String]
66
commaSplit = sepSplit ','
67

    
68
-- * Serialisation functions
69

    
70
-- | Serialize a single group.
71
serializeGroup :: Group.Group -> String
72
serializeGroup grp =
73
  printf "%s|%s|%s|%s|%s" (Group.name grp) (Group.uuid grp)
74
           (allocPolicyToRaw (Group.allocPolicy grp))
75
           (intercalate "," (Group.allTags grp))
76
           (intercalate "," (Group.networks grp))
77

    
78
-- | Generate group file data from a group list.
79
serializeGroups :: Group.List -> String
80
serializeGroups = unlines . map serializeGroup . Container.elems
81

    
82
-- | Serialize a single node.
83
serializeNode :: Group.List -- ^ The list of groups (needed for group uuid)
84
              -> Node.Node  -- ^ The node to be serialised
85
              -> String
86
serializeNode gl node =
87
  printf "%s|%.0f|%d|%d|%.0f|%d|%.0f|%c|%s|%d|%s" (Node.name node)
88
           (Node.tMem node) (Node.nMem node) (Node.fMem node)
89
           (Node.tDsk node) (Node.fDsk node) (Node.tCpu node)
90
           (if Node.offline node then 'Y' else
91
              if Node.isMaster node then 'M' else 'N')
92
           (Group.uuid grp)
93
           (Node.spindleCount node)
94
           (intercalate "," (Node.nTags node))
95
    where grp = Container.find (Node.group node) gl
96

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

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

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

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

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

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

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

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

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

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

    
182
-- * Parsing functions
183

    
184
-- | Load a group from a field list.
185
loadGroup :: (Monad m) => [String]
186
          -> m (String, Group.Group) -- ^ The result, a tuple of group
187
                                     -- UUID and group object
188
loadGroup [name, gid, apol, tags, nets] = do
189
  xapol <- allocPolicyFromRaw apol
190
  let xtags = commaSplit tags
191
  let xnets = commaSplit nets
192
  return (gid, Group.create name gid xapol xnets defIPolicy xtags)
193
loadGroup [name, gid, apol, tags] = loadGroup [name, gid, apol, tags, ""]
194
loadGroup s = fail $ "Invalid/incomplete group data: '" ++ show s ++ "'"
195

    
196
-- | Load a node from a field list.
197
loadNode :: (Monad m) =>
198
            NameAssoc             -- ^ Association list with current groups
199
         -> [String]              -- ^ Input data as a list of fields
200
         -> m (String, Node.Node) -- ^ The result, a tuple o node name
201
                                  -- and node object
202
loadNode ktg [name, tm, nm, fm, td, fd, tc, fo, gu, spindles, tags] = do
203
  gdx <- lookupGroup ktg name gu
204
  new_node <-
205
      if "?" `elem` [tm,nm,fm,td,fd,tc] || fo == "Y" then
206
          return $ Node.create name 0 0 0 0 0 0 True 0 gdx
207
      else do
208
        let vtags = commaSplit tags
209
        vtm <- tryRead name tm
210
        vnm <- tryRead name nm
211
        vfm <- tryRead name fm
212
        vtd <- tryRead name td
213
        vfd <- tryRead name fd
214
        vtc <- tryRead name tc
215
        vspindles <- tryRead name spindles
216
        return . flip Node.setMaster (fo == "M") . flip Node.setNodeTags vtags $
217
          Node.create name vtm vnm vfm vtd vfd vtc False vspindles gdx
218
  return (name, new_node)
219

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

    
223
loadNode ktg [name, tm, nm, fm, td, fd, tc, fo, gu, spindles] =
224
  loadNode ktg [name, tm, nm, fm, td, fd, tc, fo, gu, spindles, ""]
225

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

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

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

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

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

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

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

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

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

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

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

    
347
loadTabular lines_data convert_fn = do
348
  let rows = map (sepSplit '|') lines_data
349
  kerows <- mapM convert_fn rows
350
  return $ assignIndices kerows
351

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

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

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